From 05f94e6ac8257a5f48a1c4f27fca6b7131eee44c Mon Sep 17 00:00:00 2001 From: Bastien Date: Tue, 27 Nov 2012 23:06:48 -0800 Subject: [PATCH 001/166] Deleted 2012-11-28-your-filename.md From bdbf80aacbc613a5c66783220dfce216a52b7b8f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 27 Oct 2013 09:54:27 +0100 Subject: [PATCH 002/166] ob-tangle: Silence byte-compiler --- lisp/ob-tangle.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 29415c47c..0b22467d1 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -38,6 +38,7 @@ (declare-function org-back-to-heading "org" (invisible-ok)) (declare-function org-fill-template "org" (template alist)) (declare-function org-babel-update-block-body "org" (new-body)) +(declare-function org-up-heading-safe "org" ()) (declare-function make-directory "files" (dir &optional parents)) (defcustom org-babel-tangle-lang-exts @@ -355,6 +356,7 @@ that the appropriate major-mode is set. SPEC has the form: insert-comment (org-fill-template org-babel-tangle-comment-format-end link-data))))) +(defvar org-comment-string) ;; Defined in org.el (defun org-babel-under-commented-heading-p () "Return t if currently under a commented heading." (if (string-match (concat "^" org-comment-string) @@ -364,7 +366,6 @@ that the appropriate major-mode is set. SPEC has the form: (and (org-up-heading-safe) (org-babel-under-commented-heading-p))))) -(defvar org-comment-string) ;; Defined in org.el (defun org-babel-tangle-collect-blocks (&optional language tangle-file) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of From 73f2ef866d059d8d05a9d68d7de5588b590ed6f6 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 27 Oct 2013 11:03:05 +0100 Subject: [PATCH 003/166] org-element: Small change to src block indentation * lisp/org-element.el (org-element-remove-indentation): Renamed from `org-element--remove-indentation'. (org-element-example-block-interpreter, org-element-src-block-parser): Do not depend on `org-src-preserve-indentation'. (org-element-src-block-interpreter, org-element-example-block-parser): Check `org-src-preserve-indentation'. * lisp/ox.el (org-export-unravel-code): Handle `org-src-preserve-indentation'. * testing/lisp/test-org-element.el: Update tests. --- lisp/org-element.el | 103 ++++++++++++++++--------------- lisp/ox.el | 12 ++-- testing/lisp/test-org-element.el | 24 ++----- 3 files changed, 66 insertions(+), 73 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 329d00a4d..254af3c69 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1711,35 +1711,6 @@ CONTENTS is nil." ;;;; Example Block -(defun org-element--remove-indentation (s &optional n) - "Remove maximum common indentation in string S and return it. -When optional argument N is a positive integer, remove exactly -that much characters from indentation, if possible, or return -S as-is otherwise. Unlike to `org-remove-indentation', this -function doesn't call `untabify' on S." - (catch 'exit - (with-temp-buffer - (insert s) - (goto-char (point-min)) - ;; Find maximum common indentation, if not specified. - (setq n (or n - (let ((min-ind (point-max))) - (save-excursion - (while (re-search-forward "^[ \t]*\\S-" nil t) - (let ((ind (1- (current-column)))) - (if (zerop ind) (throw 'exit s) - (setq min-ind (min min-ind ind)))))) - min-ind))) - (if (zerop n) s - ;; Remove exactly N indentation, but give up if not possible. - (while (not (eobp)) - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (cond ((eolp) (delete-region (line-beginning-position) (point))) - ((< ind n) (throw 'exit s)) - (t (org-indent-line-to (- ind n)))) - (forward-line))) - (buffer-string))))) - (defun org-element-example-block-parser (limit affiliated) "Parse an example block. @@ -1769,8 +1740,7 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', ((string-match "-n\\>" switches) 'new) ((string-match "+n\\>" switches) 'continued))) (preserve-indent - (or org-src-preserve-indentation - (and switches (string-match "-i\\>" switches)))) + (and switches (string-match "-i\\>" switches))) ;; Should labels be retained in (or stripped from) example ;; blocks? (retain-labels @@ -1792,11 +1762,11 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (post-affiliated (point)) (block-ind (progn (skip-chars-forward " \t") (current-column))) (contents-begin (progn (forward-line) (point))) - (value (org-element--remove-indentation + (value (org-element-remove-indentation (org-unescape-code-in-string (buffer-substring-no-properties contents-begin contents-end)) - (and preserve-indent block-ind))) + block-ind)) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -1821,10 +1791,14 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent', (defun org-element-example-block-interpreter (example-block contents) "Interpret EXAMPLE-BLOCK element as Org syntax. CONTENTS is nil." - (let ((switches (org-element-property :switches example-block))) + (let ((switches (org-element-property :switches example-block)) + (value (org-element-property :value example-block))) (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" (org-escape-code-in-string - (org-element-property :value example-block)) + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent example-block)) + value + (org-element-remove-indentation value))) "#+END_EXAMPLE"))) @@ -2324,9 +2298,8 @@ Assume point is at the beginning of the block." (cond ((not switches) nil) ((string-match "-n\\>" switches) 'new) ((string-match "+n\\>" switches) 'continued))) - (preserve-indent (or org-src-preserve-indentation - (and switches - (string-match "-i\\>" switches)))) + (preserve-indent (and switches + (string-match "-i\\>" switches))) (label-fmt (and switches (string-match "-l +\"\\([^\"\n]+\\)\"" switches) @@ -2346,11 +2319,11 @@ Assume point is at the beginning of the block." ;; Indentation. (block-ind (progn (skip-chars-forward " \t") (current-column))) ;; Retrieve code. - (value (org-element--remove-indentation + (value (org-element-remove-indentation (org-unescape-code-in-string (buffer-substring-no-properties (progn (forward-line) (point)) contents-end)) - (and preserve-indent block-ind))) + block-ind)) (pos-before-blank (progn (goto-char contents-end) (forward-line) (point))) @@ -2383,15 +2356,17 @@ CONTENTS is nil." (let ((lang (org-element-property :language src-block)) (switches (org-element-property :switches src-block)) (params (org-element-property :parameters src-block)) - (value (let ((val (org-element-property :value src-block))) - (cond - ((org-element-property :preserve-indent src-block) val) - ((zerop org-edit-src-content-indentation) val) - (t - (let ((ind (make-string - org-edit-src-content-indentation 32))) - (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind val nil nil 1))))))) + (value + (let ((val (org-element-property :value src-block))) + (cond + ((or org-src-preserve-indentation + (org-element-property :preserve-indent src-block)) + val) + ((zerop org-edit-src-content-indentation) val) + (t + (let ((ind (make-string org-edit-src-content-indentation ?\s))) + (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind val nil nil 1))))))) (concat (format "#+BEGIN_SRC%s\n" (concat (and lang (concat " " lang)) (and switches (concat " " switches)) @@ -4972,6 +4947,36 @@ end of ELEM-A." (cdr overlays))) (goto-char (org-element-property :end elem-B))))) +(defun org-element-remove-indentation (s &optional n) + "Remove maximum common indentation in string S and return it. +When optional argument N is a positive integer, remove exactly +that much characters from indentation, if possible, or return +S as-is otherwise. Unlike to `org-remove-indentation', this +function doesn't call `untabify' on S." + (catch 'exit + (with-temp-buffer + (insert s) + (goto-char (point-min)) + ;; Find maximum common indentation, if not specified. + (setq n (or n + (let ((min-ind (point-max))) + (save-excursion + (while (re-search-forward "^[ \t]*\\S-" nil t) + (let ((ind (1- (current-column)))) + (if (zerop ind) (throw 'exit s) + (setq min-ind (min min-ind ind)))))) + min-ind))) + (if (zerop n) s + ;; Remove exactly N indentation, but give up if not possible. + (while (not (eobp)) + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (cond ((eolp) (delete-region (line-beginning-position) (point))) + ((< ind n) (throw 'exit s)) + (t (org-indent-line-to (- ind n)))) + (forward-line))) + (buffer-string))))) + + (provide 'org-element) ;; Local variables: diff --git a/lisp/ox.el b/lisp/ox.el index d00bb17eb..d8b10e8c6 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -4192,17 +4192,21 @@ ELEMENT is excluded from count." ELEMENT has either a `src-block' an `example-block' type. Return a cons cell whose CAR is the source code, cleaned from any -reference and protective comma and CDR is an alist between -relative line number (integer) and name of code reference on that -line (string)." +reference, protective commas and spurious indentation, and CDR is +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. (code (replace-regexp-in-string "\\`\\([ \t]*\n\\)+" "" (replace-regexp-in-string "\\([ \t]*\n\\)*[ \t]*\\'" "\n" - (org-element-property :value element)))) + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent element)) + value + (org-element-remove-indentation value))))) ;; Get format used for references. (label-fmt (regexp-quote (or (org-element-property :label-fmt element) diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 103ba99a3..4f08e3e7a 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -504,16 +504,8 @@ Some other text (org-test-with-temp-text "#+BEGIN_EXAMPLE\n,* Headline\n ,#+keyword\nText\n#+END_EXAMPLE" (org-element-property :value (org-element-at-point))))) - ;; Nil `org-src-preserve-indentation': Remove maximum common - ;; indentation. - (should - (equal " L1\nL2\n" - (org-test-with-temp-text "#+BEGIN_EXAMPLE\n L1\n L2\n#+END_EXAMPLE" - (let ((org-src-preserve-indentation nil)) - (org-element-property :value (org-element-at-point)))))) - ;; Non-nil `org-src-preserve-indentation': Remove block indentation - ;; only, unless block contents are less indented than block - ;; boundaries. + ;; Remove block indentation according to block boundaries, unless + ;; block contents are less indented than block boundaries. (should (equal " L1\nL2\n" (org-test-with-temp-text " #+BEGIN_EXAMPLE\n L1\n L2\n #+END_EXAMPLE" @@ -1645,16 +1637,8 @@ Outside list" (org-test-with-temp-text "#+BEGIN_SRC org\n,* Headline\n ,#+keyword\nText\n#+END_SRC" (org-element-property :value (org-element-at-point))))) - ;; Nil `org-src-preserve-indentation': Remove maximum common - ;; indentation. - (should - (equal " L1\nL2\n" - (org-test-with-temp-text "#+BEGIN_SRC org\n L1\n L2\n#+END_SRC" - (let ((org-src-preserve-indentation nil)) - (org-element-property :value (org-element-at-point)))))) - ;; Non-nil `org-src-preserve-indentation': Remove block indentation - ;; only, unless block contents are less indented than block - ;; boundaries. + ;; Remove block indentation according to block boundaries, unless + ;; block contents are less indented than block boundaries. (should (equal " L1\nL2\n" (org-test-with-temp-text " #+BEGIN_SRC org\n L1\n L2\n #+END_SRC" From 3a65174f145ad54b08f001791531af8c38780407 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Sun, 27 Oct 2013 18:20:46 +0100 Subject: [PATCH 004/166] ox-confluence: Handle lists * contrib/lisp/ox-confluence.el (org-confluence-item, org-confluence--li-depth): New functions. Patch proposed by . --- contrib/lisp/ox-confluence.el | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el index f5bf2474a..0cef1d7b9 100644 --- a/contrib/lisp/ox-confluence.el +++ b/contrib/lisp/ox-confluence.el @@ -45,6 +45,7 @@ (footnote-reference . org-confluence-empty) (headline . org-confluence-headline) (italic . org-confluence-italic) + (item . org-confluence-item) (link . org-confluence-link) (property-drawer . org-confluence-property-drawer) (section . org-confluence-section) @@ -71,6 +72,11 @@ (defun org-confluence-italic (italic contents info) (format "_%s_" contents)) +(defun org-confluence-item (item contents info) + (concat (make-string (1+ (org-confluence--li-depth item)) ?\-) + " " + (org-trim contents))) + (defun org-confluence-fixed-width (fixed-width contents info) (format "\{\{%s\}\}" contents)) @@ -144,6 +150,22 @@ contents "\{code\}\n")) +(defun org-confluence--li-depth (item) + "Return depth of a list item; -1 means not a list item" + ;; FIXME check whether it's worth it to cache depth + ;; (it gets recalculated quite a few times while + ;; traversing a list) + (let ((depth -1) + (tag)) + (while (and item + (setq tag (car item)) + (or (eq tag 'item) ; list items interleave with plain-list + (eq tag 'plain-list))) + (when (eq tag 'item) + (incf depth)) + (setq item (org-export-get-parent item))) + depth)) + ;; main interactive entrypoint (defun org-confluence-export-as-confluence (&optional async subtreep visible-only body-only ext-plist) From ac1c88294efbee5b8cb1408ce33defb4f6603875 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?S=C3=A9bastien=20Delafond?= Date: Sun, 27 Oct 2013 18:34:57 +0100 Subject: [PATCH 005/166] ox-confluence: update maintainer's email address * contrib/lisp/ox-confluence.el: current email address for maintainer TINYCHANGE --- contrib/lisp/ox-confluence.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el index 0cef1d7b9..c87c23ede 100644 --- a/contrib/lisp/ox-confluence.el +++ b/contrib/lisp/ox-confluence.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2012 Sébastien Delafond -;; Author: Sébastien Delafond +;; Author: Sébastien Delafond ;; Keywords: outlines, confluence, wiki ;; This file is not part of GNU Emacs. From da232c9711f4edfc5425b0fc4bdfe91d9b6ef395 Mon Sep 17 00:00:00 2001 From: Joost Diepenmaat Date: Fri, 25 Oct 2013 11:08:46 +0200 Subject: [PATCH 006/166] Correctly indent BEGIN_SRC and END_SRC lines * lisp/org.el (org-indent-region): BEGIN_SRC and END_SRC lines should not be considered part of the source block for the purposes of indentation. TINYCHANGE --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index d795c78ef..bb6b54315 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -22155,7 +22155,7 @@ hierarchy of headlines by UP levels before marking the subtree." (let ((line-end (org-current-line end))) (goto-char start) (while (< (org-current-line) line-end) - (cond ((org-in-src-block-p) (org-src-native-tab-command-maybe)) + (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe)) (t (call-interactively 'org-indent-line))) (move-beginning-of-line 2))))) From 8b264d505ee74b3b215fdc1baf4daf2167e9e2e4 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Wed, 28 Aug 2013 11:50:53 -0400 Subject: [PATCH 007/166] Fix org-src-edit interaction with undo. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * org-src.el (org-edit-src-exit): Place an undo boundary before writing changes back to parent buffer. The previous code attempted to preserve the undo information in the indirect buffer editing the source code, but this interacts poorly with the undo system, and can lead to undo operations scrambling the buffer. The new approach means that edits made in the indirect buffer cannot be undone piece-by-piece (instead, all changes made in the indirect buffer constitute one “change” from the point of view of undo), but the misbehavior of undo is (hopefully) now avoided. --- lisp/org-src.el | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 6ec3adc47..f490be775 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -753,14 +753,14 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (kill-buffer buffer)) (goto-char beg) (when allow-write-back-p - (let ((buffer-undo-list t)) - (delete-region beg (max beg end)) - (unless (string-match "\\`[ \t]*\\'" code) - (insert code)) - ;; Make sure the overlay stays in place + (undo-boundary) + (delete-region beg (max beg end)) + (unless (string-match "\\`[ \t]*\\'" code) + (insert code)) + ;; Make sure the overlay stays in place (when (eq context 'save) (move-overlay ovl beg (point))) - (goto-char beg) - (if single (just-one-space)))) + (goto-char beg) + (if single (just-one-space))) (if (memq t (mapcar (lambda (overlay) (eq (overlay-get overlay 'invisible) 'org-hide-block)) From 8eadca98a638c00114898da6306a3d9699121f4e Mon Sep 17 00:00:00 2001 From: Ingo Lohmar Date: Sun, 27 Oct 2013 17:34:22 +0100 Subject: [PATCH 008/166] Fix org-insert-todo-heading-respect-content in plain list item * lisp/org.el (org-insert-todo-heading-respect-content): Pass correct prefix arg to always insert heading. TINYCHANGE This function used a second argument t, which is eventually passed to org-insert-heading, adding a list item when inside a plain list. Use the proper argument '(4) now, to always create a heading, just like the function's name and documentation imply. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index bb6b54315..ddf8354d5 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7769,7 +7769,7 @@ This is a list with the following elements: "Insert TODO heading with `org-insert-heading-respect-content' set to t." (interactive "P") (let ((org-insert-heading-respect-content t)) - (org-insert-todo-heading force-state t))) + (org-insert-todo-heading force-state '(4)))) (defun org-insert-todo-heading (arg &optional force-heading) "Insert a new heading with the same level and TODO state as current heading. From a7e5a74e2ce41819a342a282f62541d6e9d61c47 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 29 Oct 2013 09:55:01 +0100 Subject: [PATCH 009/166] Fix `org-insert-heading' at buffer boundaries * lisp/org.el (org-insert-heading): Do not error out when inserting is to be done at one of the buffer's boundaries. * testing/lisp/test-org.el: Add tests. --- lisp/org.el | 7 ++++--- testing/lisp/test-org.el | 22 ++++++++++++++++++++++ 2 files changed, 26 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index ddf8354d5..8da6f7d68 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7569,7 +7569,8 @@ This is important for non-interactive uses of the command." (and (ignore-errors (org-back-to-heading invisible-ok)) (org-at-heading-p)))) (or arg (not itemp)))) - ;; At beginning of buffer or so hight up that only a heading makes sense. + ;; At beginning of buffer or so high up that only a heading + ;; makes sense. (insert (if (or (bobp) (org-previous-line-empty-p)) "" "\n") (if (org-in-src-block-p) ",* " "* ")) @@ -7631,9 +7632,9 @@ This is important for non-interactive uses of the command." (org-end-of-subtree nil t) (skip-chars-backward " \r\n") (and (looking-at "[ \t]+") (replace-match "")) - (forward-char 1) + (unless (eobp) (forward-char 1)) (when (looking-at "^\\*") - (backward-char 1) + (unless (bobp) (backward-char 1)) (insert "\n"))) ;; If we are splitting, grab the text that should be moved to the new headline diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index b6c5558a8..1540b8ec2 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -407,6 +407,28 @@ (beginning-of-line) (looking-at "- $"))))) +(ert-deftest test-org/insert-todo-heading-respect-content () + "Test `org-insert-todo-heading-respect-content' specifications." + ;; Create a TODO heading. + (should + (org-test-with-temp-text "* H1\n Body" + (org-insert-todo-heading-respect-content) + (nth 2 (org-heading-components)))) + ;; Add headline after body of current subtree. + (should + (org-test-with-temp-text "* H1\nBody" + (org-insert-todo-heading-respect-content) + (eobp))) + (should + (org-test-with-temp-text "* H1\n** H2\nBody" + (org-insert-todo-heading-respect-content) + (eobp))) + ;; In a list, do not create a new item. + (should + (org-test-with-temp-text "* H\n- an item\n- another one" + (search-forward "an ") + (org-insert-todo-heading-respect-content) + (and (eobp) (org-at-heading-p))))) From dc00c4afe6e610dd07aade515cc3956532517738 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 29 Oct 2013 15:18:24 +0100 Subject: [PATCH 010/166] ob-ebnf: Fix copyright and style * lisp/ob-ebnf.el (org-babel-execute:ebnf): Fix style. --- lisp/ob-ebnf.el | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/lisp/ob-ebnf.el b/lisp/ob-ebnf.el index 10ec1b2cd..8c98d305d 100644 --- a/lisp/ob-ebnf.el +++ b/lisp/ob-ebnf.el @@ -1,6 +1,6 @@ ;;; ob-ebnf.el --- org-babel functions for ebnf evaluation -;; Copyright (C) your name here +;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Author: Michael Gauland ;; Keywords: literate programming, reproducible research @@ -36,7 +36,7 @@ ;;; ;;; :style specifies a value in ebnf-style-database. This provides the ;;; ability to customise the output. The style can also specify the -;;; gramnmar syntax (by setting ebnf-syntax); note that only ebnf, +;;; grammar syntax (by setting ebnf-syntax); note that only ebnf, ;;; iso-ebnf, and yacc are supported by this file. ;;; Requirements: @@ -64,14 +64,13 @@ called by `org-babel-execute-src-block'" (result nil)) (with-temp-buffer (when style (ebnf-push-style style)) - (let - ((comment-format - (cond ((string= ebnf-syntax 'yacc) "/*%s*/") - ((string= ebnf-syntax 'ebnf) ";%s") - ((string= ebnf-syntax 'iso-ebnf) "(*%s*)") - (t (setq result - (format "EBNF error: format %s not supported." - ebnf-syntax)))))) + (let ((comment-format + (cond ((string= ebnf-syntax 'yacc) "/*%s*/") + ((string= ebnf-syntax 'ebnf) ";%s") + ((string= ebnf-syntax 'iso-ebnf) "(*%s*)") + (t (setq result + (format "EBNF error: format %s not supported." + ebnf-syntax)))))) (setq ebnf-eps-prefix dest-dir) (insert (format comment-format (format "[%s" dest-root))) (newline) @@ -80,8 +79,7 @@ called by `org-babel-execute-src-block'" (insert (format comment-format (format "]%s" dest-root))) (ebnf-eps-buffer) (when style (ebnf-pop-style)))) - result - ))) + result))) (provide 'ob-ebnf) ;;; ob-ebnf.el ends here From af92fa3b6c44f8e8f1425783e270e0528260a4ef Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 29 Oct 2013 15:31:22 +0100 Subject: [PATCH 011/166] ox-latex: Change to longtable strings * lisp/ox-latex.el (org-latex--translate): New function. (org-latex-longtable-continued-on) org-latex-longtable-continued-from): Remove variables. (org-latex-table-row): Use new function. * lisp/ox.el (org-export-dictionary): Add entries relative to longtables. Fix some other entries. --- lisp/ox-latex.el | 23 +++++++---------------- lisp/ox.el | 10 +++++++--- 2 files changed, 14 insertions(+), 19 deletions(-) diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index b0cc4bb91..2af5de68b 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -525,20 +525,6 @@ When nil, no transformation is made." (string :tag "Format string") (const :tag "No formatting"))) -(defcustom org-latex-longtable-continued-on "Continued on next page" - "String to indicate table continued on next page." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-latex-longtable-continued-from "Continued from previous page" - "String to indicate table continued from previous page." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - ;;;; Text markup (defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}") @@ -1077,6 +1063,11 @@ just outside of it." (funcall search-refs element)) "")) +(defun org-latex--translate (s info) + "Translate string S according to specified language. +INFO is a plist used as a communication channel." + (org-export-translate s :latex info)) + ;;; Template @@ -2649,7 +2640,7 @@ a communication channel." (if booktabsp "\\midrule" "\\hline") (cdr (org-export-table-dimensions (org-export-get-parent-table table-row) info)) - org-latex-longtable-continued-from + (org-latex--translate "Continued from previous page" info) (cond ((and booktabsp (memq 'top borders)) "\\toprule\n") ((and (memq 'top borders) (memq 'above borders)) "\\hline\n") @@ -2660,7 +2651,7 @@ a communication channel." ;; Number of columns. (cdr (org-export-table-dimensions (org-export-get-parent-table table-row) info)) - org-latex-longtable-continued-on)) + (org-latex--translate "Continued on next page" info))) ;; When BOOKTABS are activated enforce bottom rule even when ;; no hline was specifically marked. ((and booktabsp (memq 'bottom borders)) "\\bottomrule") diff --git a/lisp/ox.el b/lisp/ox.el index d8b10e8c6..141abc441 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -5276,6 +5276,10 @@ them." ("uk" :html "Автор" :utf-8 "Автор") ("zh-CN" :html "作者" :utf-8 "作者") ("zh-TW" :html "作者" :utf-8 "作者")) + ("Continued from previous page" + ("fr" :default "Suite de la page précédente")) + ("Continued on next page" + ("fr" :default "Suite page suivante")) ("Date" ("ca" :default "Data") ("cs" :default "Datum") @@ -5384,8 +5388,8 @@ them." ("es" :default "Listado de programa %d") ("et" :default "Loend %d") ("fr" :default "Programme %d :" :html "Programme %d :") - ("no" :default "Dataprogram") - ("nb" :default "Dataprogram") + ("no" :default "Dataprogram %d") + ("nb" :default "Dataprogram %d") ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) ("See section %s" ("da" :default "jævnfør afsnit %s") @@ -5393,7 +5397,7 @@ them." ("es" :default "vea seccion %s") ("et" :html "Vaata peatükki %s" :utf-8 "Vaata peatükki %s") ("fr" :default "cf. section %s") - ("zh-CN" :html "参见第%d节" :utf-8 "参见第%s节")) + ("zh-CN" :html "参见第%s节" :utf-8 "参见第%s节")) ("Table" ("de" :default "Tabelle") ("es" :default "Tabla") From 0b7f74bcd1d2d7934d150bfc138e180c183f7722 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=BCdiger=20Sonderfeld?= Date: Tue, 29 Oct 2013 17:20:20 +0100 Subject: [PATCH 012/166] ox-latex: Don't quote const in defcustom MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ox-latex.el (org-latex-listings): Don't quote const value. Quoting it would set `org-export-latex' not to `minted' but `(quote minted)' and thus breaking the export. Signed-off-by: Rüdiger Sonderfeld --- lisp/ox-latex.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index ea253a1b5..339f5a3fd 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -655,7 +655,7 @@ into previewing problems, please consult :group 'org-export-latex :type '(choice (const :tag "Use listings" t) - (const :tag "Use minted" 'minted) + (const :tag "Use minted" minted) (const :tag "Export verbatim" nil))) (defcustom org-latex-listings-langs From d80bdb7431548cbb37cb72cd18fdff52c4ccf49f Mon Sep 17 00:00:00 2001 From: Jonas Hoersch Date: Tue, 29 Oct 2013 17:07:49 +0100 Subject: [PATCH 013/166] org-inlinetask: fix inlinetask unfolding * lisp/org-inlinetask.el (org-inlinetask-toggle-visibility): Don't use `org-show-entry` as it cannot unfold an inlinetask properly. TINYCHANGE --- lisp/org-inlinetask.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 112d3df20..ca7572bcc 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -315,7 +315,8 @@ If the task has an end part, also demote it." ((= end start)) ;; Inlinetask was folded: expand it. ((get-char-property (1+ start) 'invisible) - (org-show-entry)) + (outline-flag-region start end nil) + (org-cycle-hide-drawers 'children)) (t (outline-flag-region start end t))))) (defun org-inlinetask-remove-END-maybe () From 24fe50671e1150a3915a42b75d0c1aa5765fcd2f Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Mon, 28 Oct 2013 18:58:44 -0400 Subject: [PATCH 014/166] clean up two macros in ob-comint MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-comint.el (org-babel-comint-with-output, org-babel-comint-in-buffer): clean up code. This patch replaces some deeply nested ca/dr calls with ‘nth’, and replaces a setq/unwind-protect/setq incantation with a simple let binding. Finally, it also restructures ’org-babel-comint-in-buffer’ to not needlessly save/restore match and excursion data if the buffer process is not live, and to use with-current-buffer instead of save-excursion+set-buffer (info "(elisp) Excursions") --- lisp/ob-comint.el | 84 ++++++++++++++++++++++------------------------- 1 file changed, 40 insertions(+), 44 deletions(-) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 8b03e2dcc..4e2b352c2 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -48,12 +48,12 @@ BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is executed inside the protection of `save-excursion' and `save-match-data'." (declare (indent 1)) - `(save-excursion + `(progn + (unless (org-babel-comint-buffer-livep ,buffer) + (error "Buffer %s does not exist or has no process" ,buffer)) (save-match-data - (unless (org-babel-comint-buffer-livep ,buffer) - (error "Buffer %s does not exist or has no process" ,buffer)) - (set-buffer ,buffer) - ,@body))) + (with-current-buffer ,buffer + ,@body)))) (def-edebug-spec org-babel-comint-in-buffer (form body)) (defmacro org-babel-comint-with-output (meta &rest body) @@ -69,46 +69,42 @@ elements are optional. This macro ensures that the filter is removed in case of an error or user `keyboard-quit' during execution of body." (declare (indent 1)) - (let ((buffer (car meta)) - (eoe-indicator (cadr meta)) - (remove-echo (cadr (cdr meta))) - (full-body (cadr (cdr (cdr meta))))) + (let ((buffer (nth 0 meta)) + (eoe-indicator (nth 1 meta)) + (remove-echo (nth 2 meta)) + (full-body (nth 3 meta))) `(org-babel-comint-in-buffer ,buffer - (let ((string-buffer "") dangling-text raw) - ;; setup filter - (setq comint-output-filter-functions - (cons (lambda (text) (setq string-buffer (concat string-buffer text))) - comint-output-filter-functions)) - (unwind-protect - (progn - ;; got located, and save dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (let ((start (point)) - (end (point-max))) - (setq dangling-text (buffer-substring start end)) - (delete-region start end)) - ;; pass FULL-BODY to process - ,@body - ;; wait for end-of-evaluation indicator - (while (progn - (goto-char comint-last-input-end) - (not (save-excursion - (and (re-search-forward - (regexp-quote ,eoe-indicator) nil t) - (re-search-forward - comint-prompt-regexp nil t))))) - (accept-process-output (get-buffer-process (current-buffer))) - ;; thought the following this would allow async - ;; background running, but I was wrong... - ;; (run-with-timer .5 .5 'accept-process-output - ;; (get-buffer-process (current-buffer))) - ) - ;; replace cut dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert dangling-text)) - ;; remove filter - (setq comint-output-filter-functions - (cdr comint-output-filter-functions))) + (let ((string-buffer "") + (comint-output-filter-functions + (cons (lambda (text) (setq string-buffer (concat string-buffer text))) + comint-output-filter-functions)) + dangling-text raw) + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + (regexp-quote ,eoe-indicator) nil t) + (re-search-forward + comint-prompt-regexp nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text) + ;; remove echo'd FULL-BODY from input (if (and ,remove-echo ,full-body (string-match From 1d305d4aba715be99d16990f239d3b208fc7906d Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Mon, 28 Oct 2013 18:58:52 -0400 Subject: [PATCH 015/166] =?UTF-8?q?babel:=20don=E2=80=99t=20add=20babel=20?= =?UTF-8?q?eval=20to=20the=20session=E2=80=99s=20comint=20input=20ring?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-comint.el (org-babel-comint-in-buffer): don’t add to comint-input-ring Previously, babel code would be added to the comint input ring of a babel session, making interactive use of the session difficult: one had to page through the babel generated commands when browsing the comint history with M-p/M-n. The session repl’s history should just contain commands the user has specifically entered in the repl buffer, and not those which are fed in from org mode. So, we bind ‘comint-input-filter’ to a function that always returns nil in the ‘org-babel-comint-in-buffer’ macro, to avoid any additions to the input ring while executing code from babel. --- lisp/ob-comint.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 4e2b352c2..1f28a2c1f 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -53,7 +53,8 @@ executed inside the protection of `save-excursion' and (error "Buffer %s does not exist or has no process" ,buffer)) (save-match-data (with-current-buffer ,buffer - ,@body)))) + (let ((comint-input-filter (lambda (input) nil))) + ,@body))))) (def-edebug-spec org-babel-comint-in-buffer (form body)) (defmacro org-babel-comint-with-output (meta &rest body) From fe44d55aa0d981b56b246e071a788ab9320355eb Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Mon, 28 Oct 2013 16:19:01 -0400 Subject: [PATCH 016/166] ox-latex: Mark some variables safe locals * lisp/ox-latex.el (org-latex-with-hyperref, org-latex-default-table-mode, org-latex-tables-booktabs, org-latex-tables-centered, org-latex-table-caption-above, org-latex-listings): add safe local variable properties --- lisp/ox-latex.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 87c503c62..f14a1f9c3 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -343,7 +343,8 @@ the toc:nil option, not to those generated with #+TOC keyword." (defcustom org-latex-with-hyperref t "Toggle insertion of \\hypersetup{...} in the preamble." :group 'org-export-latex - :type 'boolean) + :type 'boolean + :safe #'booleanp) ;;;; Headline @@ -488,12 +489,14 @@ When modifying this variable, it may be useful to change :type '(choice (const :tag "Table" table) (const :tag "Matrix" math) (const :tag "Inline matrix" inline-math) - (const :tag "Verbatim" verbatim))) + (const :tag "Verbatim" verbatim)) + :safe (lambda (s) (memq s '(table math inline-math verbatim)))) (defcustom org-latex-tables-centered t "When non-nil, tables are exported in a center environment." :group 'org-export-latex - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-latex-tables-booktabs nil "When non-nil, display tables in a formal \"booktabs\" style. @@ -504,13 +507,15 @@ attributes." :group 'org-export-latex :version "24.4" :package-version '(Org . "8.0") - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-latex-table-caption-above t "When non-nil, place caption string at the beginning of the table. Otherwise, place it near the end." :group 'org-export-latex - :type 'boolean) + :type 'boolean + :safe #'booleanp) (defcustom org-latex-table-scientific-notation "%s\\,(%s)" "Format string to display numbers in scientific notation. @@ -656,7 +661,8 @@ into previewing problems, please consult :type '(choice (const :tag "Use listings" t) (const :tag "Use minted" minted) - (const :tag "Export verbatim" nil))) + (const :tag "Export verbatim" nil)) + :safe (lambda (s) (memq s '(t nil minted)))) (defcustom org-latex-listings-langs '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") From fb06221534554d2f968ed101cdfa1d8eccf040c6 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 30 Oct 2013 09:40:40 +0100 Subject: [PATCH 017/166] ob-comint: Silence byte compiler * lisp/ob-comint.el (org-babel-comint-with-output): Fix code typo. --- lisp/ob-comint.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 1f28a2c1f..496c38087 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -75,11 +75,11 @@ or user `keyboard-quit' during execution of body." (remove-echo (nth 2 meta)) (full-body (nth 3 meta))) `(org-babel-comint-in-buffer ,buffer - (let ((string-buffer "") - (comint-output-filter-functions - (cons (lambda (text) (setq string-buffer (concat string-buffer text))) - comint-output-filter-functions)) - dangling-text raw) + (let* ((string-buffer "") + (comint-output-filter-functions + (cons (lambda (text) (setq string-buffer (concat string-buffer text))) + comint-output-filter-functions)) + dangling-text raw) ;; got located, and save dangling text (goto-char (process-mark (get-buffer-process (current-buffer)))) (let ((start (point)) From d645d51fe08ca9ca60cccbb316816841b88fd57b Mon Sep 17 00:00:00 2001 From: Thomas Dye Date: Tue, 29 Oct 2013 14:39:48 -1000 Subject: [PATCH 018/166] ox: Table continuation strings for some languages * lisp/ox.el (org-export-dictionary): Add table continuation strings for some languages. --- lisp/ox.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 141abc441..11a7510a6 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -5277,9 +5277,21 @@ them." ("zh-CN" :html "作者" :utf-8 "作者") ("zh-TW" :html "作者" :utf-8 "作者")) ("Continued from previous page" - ("fr" :default "Suite de la page précédente")) + ("de" :default "Fortsetzung von vorheriger Seite") + ("es" :default "Continúa de la página anterior") + ("fr" :default "Suite de la page précédente") + ("it" :default "Continua da pagina precedente") + ("ja" :utf-8 "前ページから続く") + ("nl" :default "Vervolg van vorige pagina") + ("pt" :default "Continuação da página anterior")) ("Continued on next page" - ("fr" :default "Suite page suivante")) + ("de" :default "Fortsetzung nächste Seite") + ("es" :default "Continúa en la siguiente página") + ("fr" :default "Suite page suivante") + ("it" :default "Continua alla pagina successiva") + ("ja" :utf-8 "次ページに続く") + ("nl" :default "Vervolg op volgende pagina") + ("pt" :default "Continua na página seguinte")) ("Date" ("ca" :default "Data") ("cs" :default "Datum") From cba8718eaca07b2afb2735d1ae67d417f1f6efb3 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Mon, 28 Oct 2013 15:39:31 -0400 Subject: [PATCH 019/166] Mark some org-babel variables as safe locals under proper conditions * lisp/ob-core.el (org-babel-inline-result-wrap, org-babel-default-header-args, org-babel-default-inline-header-args): mark as safe local variables --- lisp/ob-core.el | 63 +++++++++++++++++++++++++++++++++++++++++ testing/lisp/test-ob.el | 21 ++++++++++++++ 2 files changed, 84 insertions(+) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 8fafd4bb6..b1a687128 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -158,6 +158,11 @@ See also `org-babel-noweb-wrap-start'." This string must include a \"%s\" which will be replaced by the results." :group 'org-babel :type 'string) +(put 'org-babel-inline-result-wrap + 'safe-local-variable + (lambda (value) + (and (stringp value) + (string-match-p "%s" value)))) (defun org-babel-noweb-wrap (&optional regexp) (concat org-babel-noweb-wrap-start @@ -484,10 +489,14 @@ specific header arguments as well.") '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) "Default arguments to use when evaluating a source block.") +(put 'org-babel-default-header-args 'safe-local-variable + (org-babel-header-args-safe-fn org-babel-safe-header-args)) (defvar org-babel-default-inline-header-args '((:session . "none") (:results . "replace") (:exports . "results")) "Default arguments to use when evaluating an inline source block.") +(put 'org-babel-default-inline-header-args 'safe-local-variable + (org-babel-header-args-safe-fn org-babel-safe-header-args)) (defvar org-babel-data-names '("tblname" "results" "name")) @@ -2785,6 +2794,60 @@ of `org-babel-temporary-directory'." (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +(defconst org-babel-safe-header-args + '(:cache :colnames :comments :exports :epilogue :hlines :noeval + :noweb :noweb-ref :noweb-sep :padline :prologue :rownames + :sep :session :tangle :wrap + (:eval . ("never" "query")) + (:results . (lambda (str) (not (string-match "file" str))))) + "A list of safe header arguments for babel source blocks. + +The list can have entries of the following forms: +- :ARG -> :ARG is always a safe header arg +- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is + `equal' to one of the VALs. +- (:ARG . FN) -> :ARG is safe as a header arg if the function FN + returns non-nil. FN is passed one + argument, the value of the header arg + (as a string).") + +(defun org-babel-one-header-arg-safe-p (pair safe-list) + "Determine if the PAIR is a safe babel header arg according to SAFE-LIST. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + (and (consp pair) + (keywordp (car pair)) + (stringp (cdr pair)) + (or + (memq (car pair) safe-list) + (let ((entry (assq (car pair) safe-list))) + (and entry + (consp entry) + (cond ((functionp (cdr entry)) + (funcall (cdr entry) (cdr pair))) + ((listp (cdr entry)) + (member (cdr pair) (cdr entry))) + (t nil))))))) + +(defmacro org-babel-header-args-safe-fn (safe-list) + "Return a function that determines whether a list of header args are safe. + +Intended usage is: +\(put 'org-babel-default-header-args 'safe-local-variable + (org-babel-header-args-safe-p org-babel-safe-header-args) + +This allows org-babel languages to extend the list of safe values for +their `org-babel-default-header-args:foo' variable. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + `(lambda (value) + (and (listp value) + (org-every + (lambda (pair) + (and (consp pair) + (org-babel-one-header-arg-safe-p pair ,safe-list))) + value)))) + (provide 'ob-core) ;; Local variables: diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 93c026b9a..e7f06455b 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -1181,6 +1181,27 @@ echo \"$data\" (list (org-get-indentation) (progn (forward-line) (org-get-indentation))))))) +(ert-deftest test-ob/safe-header-args () + "Detect safe and unsafe header args." + (let ((safe-args '((:cache . "foo") + (:results . "output") + (:eval . "never") + (:eval . "query"))) + (unsafe-args '((:eval . "yes") + (:results . "output file") + (:foo . "bar"))) + (malformed-args '((bar . "foo") + ("foo" . "bar") + :foo)) + (safe-p (org-babel-header-args-safe-fn org-babel-safe-header-args))) + (dolist (arg safe-args) + (should (org-babel-one-header-arg-safe-p arg org-babel-safe-header-args))) + (dolist (arg unsafe-args) + (should (not (org-babel-one-header-arg-safe-p arg org-babel-safe-header-args)))) + (dolist (arg malformed-args) + (should (not (org-babel-one-header-arg-safe-p arg org-babel-safe-header-args)))) + (should (not (funcall safe-p (append safe-args unsafe-args)))))) + (provide 'test-ob) ;;; test-ob ends here From 49bee6052c9fb2c943e078e98641db693c9cdd0f Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Mon, 28 Oct 2013 15:40:32 -0400 Subject: [PATCH 020/166] mark o-b-default-header-args:R as a safe local under proper conditions * lisp/ob-R.el (org-babel-default-header-args:R): mark as a safe local variable --- lisp/ob-R.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 74d7513df..2321f6470 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -65,7 +65,20 @@ (output value graphics)))) "R-specific header arguments.") +(defconst ob-R-safe-header-args + (append org-babel-safe-header-args + '(:width :height :bg :units :pointsize :antialias :quality + :compression :res :type :family :title :fonts + :version :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + "Header args which are safe for R babel blocks. + +See `org-babel-safe-header-args' for documentation of the format of +this variable.") + (defvar org-babel-default-header-args:R '()) +(put 'org-babel-default-header-args:R 'safe-local-variable + (org-babel-header-args-safe-fn ob-R-safe-header-args)) (defcustom org-babel-R-command "R --slave --no-save" "Name of command to use for executing R code." From ac9d8012a4d7b79ec0acbc40a8c1f7782e6f8833 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Wed, 30 Oct 2013 11:58:50 -0600 Subject: [PATCH 021/166] fix compiler issues w/safe-header-args * lisp/ob-core.el (org-every): Declared function for compiler. (org-babel-safe-header-args): Moved before first use. (org-babel-header-args-safe-fn): Moved before first use. --- lisp/ob-core.el | 73 +++++++++++++++++++++++++------------------------ 1 file changed, 37 insertions(+), 36 deletions(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index b1a687128..9dcc5e6d0 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -96,6 +96,7 @@ (declare-function org-table-to-lisp "org-table" (&optional txt)) (declare-function org-reverse-string "org" (string)) (declare-function org-element-context "org-element" (&optional ELEMENT)) +(declare-function org-every "org" (pred seq)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -485,6 +486,42 @@ then run `org-babel-switch-to-session'." Note that individual languages may define their own language specific header arguments as well.") +(defconst org-babel-safe-header-args + '(:cache :colnames :comments :exports :epilogue :hlines :noeval + :noweb :noweb-ref :noweb-sep :padline :prologue :rownames + :sep :session :tangle :wrap + (:eval . ("never" "query")) + (:results . (lambda (str) (not (string-match "file" str))))) + "A list of safe header arguments for babel source blocks. + +The list can have entries of the following forms: +- :ARG -> :ARG is always a safe header arg +- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is + `equal' to one of the VALs. +- (:ARG . FN) -> :ARG is safe as a header arg if the function FN + returns non-nil. FN is passed one + argument, the value of the header arg + (as a string).") + +(defmacro org-babel-header-args-safe-fn (safe-list) + "Return a function that determines whether a list of header args are safe. + +Intended usage is: +\(put 'org-babel-default-header-args 'safe-local-variable + (org-babel-header-args-safe-p org-babel-safe-header-args) + +This allows org-babel languages to extend the list of safe values for +their `org-babel-default-header-args:foo' variable. + +For the format of SAFE-LIST, see `org-babel-safe-header-args'." + `(lambda (value) + (and (listp value) + (org-every + (lambda (pair) + (and (consp pair) + (org-babel-one-header-arg-safe-p pair ,safe-list))) + value)))) + (defvar org-babel-default-header-args '((:session . "none") (:results . "replace") (:exports . "code") (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) @@ -2794,23 +2831,6 @@ of `org-babel-temporary-directory'." (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) -(defconst org-babel-safe-header-args - '(:cache :colnames :comments :exports :epilogue :hlines :noeval - :noweb :noweb-ref :noweb-sep :padline :prologue :rownames - :sep :session :tangle :wrap - (:eval . ("never" "query")) - (:results . (lambda (str) (not (string-match "file" str))))) - "A list of safe header arguments for babel source blocks. - -The list can have entries of the following forms: -- :ARG -> :ARG is always a safe header arg -- (:ARG . (VAL1 VAL2 ...)) -> :ARG is safe as a header arg if it is - `equal' to one of the VALs. -- (:ARG . FN) -> :ARG is safe as a header arg if the function FN - returns non-nil. FN is passed one - argument, the value of the header arg - (as a string).") - (defun org-babel-one-header-arg-safe-p (pair safe-list) "Determine if the PAIR is a safe babel header arg according to SAFE-LIST. @@ -2829,25 +2849,6 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'." (member (cdr pair) (cdr entry))) (t nil))))))) -(defmacro org-babel-header-args-safe-fn (safe-list) - "Return a function that determines whether a list of header args are safe. - -Intended usage is: -\(put 'org-babel-default-header-args 'safe-local-variable - (org-babel-header-args-safe-p org-babel-safe-header-args) - -This allows org-babel languages to extend the list of safe values for -their `org-babel-default-header-args:foo' variable. - -For the format of SAFE-LIST, see `org-babel-safe-header-args'." - `(lambda (value) - (and (listp value) - (org-every - (lambda (pair) - (and (consp pair) - (org-babel-one-header-arg-safe-p pair ,safe-list))) - value)))) - (provide 'ob-core) ;; Local variables: From 29b6e207da437fdd658a9b6bc9a45b3e364f86b6 Mon Sep 17 00:00:00 2001 From: Oleh Krehel Date: Wed, 30 Oct 2013 08:50:33 +0100 Subject: [PATCH 022/166] lisp/ob-C.el (org-babel-C-execute): turn on inhibit-lisp eval --- lisp/ob-C.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index e9eec934d..c35b3d098 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -106,7 +106,7 @@ or `org-babel-execute:C++'." ((lambda (results) (org-babel-reassemble-table (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) + (org-babel-read results t) (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) From 327aff7a141a6df513c9358d39ec7632590b9949 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Wed, 30 Oct 2013 23:03:10 -0400 Subject: [PATCH 023/166] ox: fix some docstrings * lisp/ox.el (org-export-table-cell-starts-colgroup-p, org-export-table-cell-ends-colgroup-p, org-export-table-row-starts-rowgroup-p, org-export-table-row-ends-rowgroup-p): fix swapage of "row" and "column" in the docstrings for these functions --- lisp/ox.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 11a7510a6..bc0997aa3 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -4650,7 +4650,7 @@ Returned borders ignore special rows." borders)) (defun org-export-table-cell-starts-colgroup-p (table-cell info) - "Non-nil when TABLE-CELL is at the beginning of a row group. + "Non-nil when TABLE-CELL is at the beginning of a column group. INFO is a plist used as a communication channel." ;; A cell starts a column group either when it is at the beginning ;; of a row (or after the special column, if any) or when it has @@ -4661,7 +4661,7 @@ INFO is a plist used as a communication channel." (memq 'left (org-export-table-cell-borders table-cell info)))) (defun org-export-table-cell-ends-colgroup-p (table-cell info) - "Non-nil when TABLE-CELL is at the end of a row group. + "Non-nil when TABLE-CELL is at the end of a column group. INFO is a plist used as a communication channel." ;; A cell ends a column group either when it is at the end of a row ;; or when it has a right border. @@ -4671,7 +4671,7 @@ INFO is a plist used as a communication channel." (memq 'right (org-export-table-cell-borders table-cell info)))) (defun org-export-table-row-starts-rowgroup-p (table-row info) - "Non-nil when TABLE-ROW is at the beginning of a column group. + "Non-nil when TABLE-ROW is at the beginning of a row group. INFO is a plist used as a communication channel." (unless (or (eq (org-element-property :type table-row) 'rule) (org-export-table-row-is-special-p table-row info)) @@ -4680,7 +4680,7 @@ INFO is a plist used as a communication channel." (or (memq 'top borders) (memq 'above borders))))) (defun org-export-table-row-ends-rowgroup-p (table-row info) - "Non-nil when TABLE-ROW is at the end of a column group. + "Non-nil when TABLE-ROW is at the end of a row group. INFO is a plist used as a communication channel." (unless (or (eq (org-element-property :type table-row) 'rule) (org-export-table-row-is-special-p table-row info)) From a94501a13205cc72911266a2172b938393b56ca9 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Thu, 31 Oct 2013 01:47:44 -0400 Subject: [PATCH 024/166] =?UTF-8?q?babel:=20don=E2=80=99t=20move=20point?= =?UTF-8?q?=20when=20tangling=20a=20single=20block?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-tangle.el: (org-babel-tangle): don’t move point when called with single prefix arg Previously, C-u C-x C-v C-t would move point to the head of the source block. --- lisp/ob-tangle.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 0b22467d1..7a27c7b62 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -180,12 +180,12 @@ used to limit the exported source code blocks by language." (run-hooks 'org-babel-pre-tangle-hook) ;; Possibly Restrict the buffer to the current code block (save-restriction - (when (equal arg '(4)) - (let ((head (org-babel-where-is-src-block-head))) + (save-excursion + (when (equal arg '(4)) + (let ((head (org-babel-where-is-src-block-head))) (if head (goto-char head) (user-error "Point is not in a source code block")))) - (save-excursion (let ((block-counter 0) (org-babel-default-header-args (if target-file From 0930a88f049a73300c6177677cb88f357552192e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 28 Oct 2013 18:56:04 +0100 Subject: [PATCH 025/166] ox: Change default asynchronous export setup * lisp/ox.el (org-export-async-init-file): Change default value and allowed values. (org-export-async-start): Apply change to the variable. --- lisp/ox.el | 37 +++++++++++++++++++++++++------------ 1 file changed, 25 insertions(+), 12 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index bc0997aa3..abc301207 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -839,15 +839,23 @@ automatically. But you can retrieve them with \\[org-export-stack]." :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-export-async-init-file user-init-file +(defcustom org-export-async-init-file nil "File used to initialize external export process. -Value must be an absolute file name. It defaults to user's -initialization file. Though, a specific configuration makes the -process faster and the export more portable." + +Value must be either nil or an absolute file name. When nil, the +external process is launched like a regular Emacs session, +loading user's initialization file and any site specific +configuration. If a file is provided, it, and only it, is loaded +at start-up. + +Therefore, using a specific configuration makes the process to +load faster and the export more portable." :group 'org-export-general :version "24.4" - :package-version '(Org . "8.0") - :type '(file :must-match t)) + :package-version '(Org . "8.3") + :type '(choice + (const :tag "Regular startup" nil) + (file :tag "Specific start-up file" :must-match t))) (defcustom org-export-dispatch-use-expert-ui nil "Non-nil means using a non-intrusive `org-export-dispatch'. @@ -5564,12 +5572,17 @@ and `org-export-to-file' for more specialized functions." (let* ((process-connection-type nil) (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) (,process - (start-process - "org-export-process" ,proc-buffer - (expand-file-name invocation-name invocation-directory) - "-Q" "--batch" - "-l" org-export-async-init-file - "-l" ,temp-file))) + (apply + #'start-process + (append + (list "org-export-process" + ,proc-buffer + (expand-file-name invocation-name invocation-directory) + "--batch") + (if org-export-async-init-file + (list "-Q" "-l" org-export-async-init-file) + (list "-l" user-init-file)) + (list "-l" ,temp-file))))) ;; Register running process in stack. (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) ;; Set-up sentinel in order to catch results. From 6202ec7b3b160040a30b759a30334e976b612ad9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 20 Oct 2013 14:40:09 +0200 Subject: [PATCH 026/166] Remove need to declare drawers before using them * lisp/org-agenda.el (org-agenda-prepare): Remove reference to `org-drawers-for-agenda'. (org-agenda-show-1): Remove reference to `org-drawers'. * lisp/org-clock.el (org-clock-remove-empty-clock-drawer, org-clock-cancel): Apply signature change to `org-remove-empty-drawer-at'. * lisp/org-element.el (org-element--list-struct): Use `org-drawer-regexp' instead of `org-drawers'. * lisp/org-feed.el (org-feed-drawer): Update docstring according to change. * lisp/org-list.el (org-in-item-p, org-list-context): Use `org-drawer-regexp' instead of `org-drawers'. * lisp/org-mobile.el (org-mobile-create-index-file): Remove reference to `org-drawers-for-agenda'. * lisp/org-pcomplete.el (pcomplete/org-mode/drawer): Remove function. * lisp/org.el (org-drawer-regexp): Make variable global. (org-drawers): Remove variable. (org-set-regexps-and-options): Ignore DRAWER keyword. (org-cycle): Use `org-drawer-regexp' instead of `org-drawers'. (org-cycle-hide-drawers): Add an optional argument to ignore some drawers. (org-remove-empty-drawer-at): Remove second argument. Rewrite function. (org-clone-subtree-with-time-shift): Apply signature change to `org-remove-empty-drawer-at'. (org-toggle-ordered-property): Apply `org-delete-property' signature change. (org-map-entries): Remove reference to `org-drawers-for-agenda'. (org-entry-delete): Remove optional argument. Small refactoring. (org-insert-drawer): Remove reference to `org-drawers'. (org-delete-property): Apply `org-entry-delete' signature change. (org-in-drawer-p): Rewrite function. * testing/lisp/test-org-element.el: Update tests. * testing/lisp/test-org.el: Update tests. * testing/lisp/test-ox.el: Update tests. --- lisp/org-agenda.el | 15 +--- lisp/org-clock.el | 6 +- lisp/org-element.el | 5 +- lisp/org-feed.el | 5 +- lisp/org-list.el | 25 ++---- lisp/org-mobile.el | 4 +- lisp/org-pcomplete.el | 19 ----- lisp/org.el | 141 +++++++++++-------------------- testing/lisp/test-org-element.el | 57 +++++-------- testing/lisp/test-org.el | 22 +++-- testing/lisp/test-ox.el | 28 +++--- 11 files changed, 109 insertions(+), 218 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 0bfba27f0..fe4c2d49c 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -3642,7 +3642,6 @@ generating a new one." (or org-agenda-multi (org-agenda-fit-window-to-buffer)) (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) (setq org-todo-keywords-for-agenda nil) - (setq org-drawers-for-agenda nil) (unless org-agenda-persistent-filter (setq org-agenda-tag-filter nil org-agenda-category-filter nil @@ -3682,7 +3681,6 @@ generating a new one." (org-uniquify org-todo-keywords-for-agenda)) (setq org-done-keywords-for-agenda (org-uniquify org-done-keywords-for-agenda)) - (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) (setq org-agenda-last-prefix-arg current-prefix-arg) (setq org-agenda-this-buffer-name org-agenda-buffer-name) (and name (not org-agenda-name) @@ -8627,15 +8625,10 @@ if it was hidden in the outline." (run-hook-with-args 'org-cycle-hook 'subtree)) (message "Remote: SUBTREE")) ((= more 4) - (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) - (org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) - (show-subtree) - (save-excursion - (org-back-to-heading) - (org-cycle-hide-drawers 'subtree))) + (show-subtree) + (save-excursion + (org-back-to-heading) + (org-cycle-hide-drawers 'subtree '("LOGBOOK"))) (message "Remote: SUBTREE AND LOGBOOK")) ((> more 4) (show-subtree) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 3195dc178..1cdbdc1ac 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1589,7 +1589,7 @@ to, overriding the existing value of `org-clock-out-switch-to-state'." (while (and (< (point) end) (search-forward clock-drawer end t)) (goto-char (match-beginning 0)) - (org-remove-empty-drawer-at clock-drawer (point)) + (org-remove-empty-drawer-at (point)) (forward-line 1)))))) (defun org-clock-timestamps-up (&optional n) @@ -1653,12 +1653,12 @@ Optional argument N tells to change by that many units." (setq frame-title-format org-frame-title-format-backup) (force-mode-line-update) (error "No active clock")) - (save-excursion ; Do not replace this with `with-current-buffer'. + (save-excursion ; Do not replace this with `with-current-buffer'. (org-no-warnings (set-buffer (org-clocking-buffer))) (goto-char org-clock-marker) (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) (progn (delete-region (1- (point-at-bol)) (point-at-eol)) - (org-remove-empty-drawer-at "LOGBOOK" (point))) + (org-remove-empty-drawer-at (point))) (message "Clock gone, cancel the timer anyway") (sit-for 2))) (move-marker org-clock-marker nil) diff --git a/lisp/org-element.el b/lisp/org-element.el index 254af3c69..95b775060 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1146,9 +1146,6 @@ CONTENTS is the contents of the element." (let ((case-fold-search t) (top-ind limit) (item-re (org-item-re)) - (drawers-re (concat ":\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) items struct) (save-excursion @@ -1221,7 +1218,7 @@ CONTENTS is the contents of the element." (format "^[ \t]*#\\+END%s[ \t]*$" (org-match-string-no-properties 1)) limit t))) - ((and (looking-at drawers-re) + ((and (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) (forward-line)))))))) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index 05ead8f02..5a54f7067 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -215,10 +215,7 @@ Here are the keyword-value pair allows in `org-feed-alist'. (defcustom org-feed-drawer "FEEDSTATUS" "The name of the drawer for feed status information. Each feed may also specify its own drawer name using the `:drawer' -parameter in `org-feed-alist'. -Note that in order to make these drawers behave like drawers, they must -be added to the variable `org-drawers' or configured with a #+DRAWERS -line." +parameter in `org-feed-alist'." :group 'org-feed :type '(string :tag "Drawer Name")) diff --git a/lisp/org-list.el b/lisp/org-list.el index 4a3d471f0..3cb9b325e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -88,7 +88,6 @@ (defvar org-closed-string) (defvar org-deadline-string) (defvar org-description-max-indent) -(defvar org-drawers) (defvar org-odd-levels-only) (defvar org-scheduled-string) (defvar org-ts-regexp) @@ -430,9 +429,6 @@ group 4: description tag") (let* ((case-fold-search t) (context (org-list-context)) (lim-up (car context)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (item-re (org-item-re)) @@ -476,7 +472,7 @@ group 4: description tag") ((and (looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) + (re-search-backward org-drawer-regexp lim-up t)) (beginning-of-line)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) @@ -547,11 +543,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) ;; Is point inside a drawer? (let ((end-re "^[ \t]*:END:") - ;; Can't use org-drawers-regexp as this function might - ;; be called in buffers not in Org mode. - (beg-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) + (beg-re org-drawer-regexp)) (when (save-excursion (and (not (looking-at beg-re)) (not (looking-at end-re)) @@ -635,9 +627,6 @@ Assume point is at an item." (lim-down (nth 1 context)) (text-min-ind 10000) (item-re (org-item-re)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (beg-cell (cons (point) (org-get-indentation))) @@ -700,7 +689,7 @@ Assume point is at an item." ((and (looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) + (re-search-backward org-drawer-regexp lim-up t)) (beginning-of-line)) ((and inlinetask-re (looking-at inlinetask-re)) (org-inlinetask-goto-beginning) @@ -766,7 +755,7 @@ Assume point is at an item." (cond ((and (looking-at "^[ \t]*#\\+begin_") (re-search-forward "^[ \t]*#\\+end_" lim-down t))) - ((and (looking-at drawers-re) + ((and (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:" lim-down t)))) (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) @@ -2326,9 +2315,6 @@ in subtree, ignoring drawers." block-item lim-up lim-down - (drawer-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string "\\|" org-deadline-string "\\|" org-closed-string @@ -2350,7 +2336,8 @@ in subtree, ignoring drawers." ;; time-stamps (scheduled, etc.). (let ((limit (save-excursion (outline-next-heading) (point)))) (forward-line 1) - (while (or (looking-at drawer-re) (looking-at keyword-re)) + (while (or (looking-at org-drawer-regexp) + (looking-at keyword-re)) (if (looking-at keyword-re) (forward-line 1) (re-search-forward "^[ \t]*:END:" limit nil))) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index a43896bdd..54b6e037e 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -425,7 +425,7 @@ agenda view showing the flagged items." (def-tags (default-value 'org-tag-alist)) (target-file (expand-file-name org-mobile-index-file org-mobile-directory)) - file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) + file link-name todo-kwds done-kwds tags entry kwds dwds twds) (when (stringp (car def-todo)) (setq def-todo (list (cons 'sequence def-todo)))) (org-agenda-prepare-buffers (mapcar 'car files-alist)) @@ -433,7 +433,6 @@ agenda view showing the flagged items." (setq todo-kwds (org-delete-all done-kwds (org-uniquify org-todo-keywords-for-agenda))) - (setq drawers (org-uniquify org-drawers-for-agenda)) (setq tags (mapcar 'car (org-global-tags-completion-table (mapcar 'car files-alist)))) (with-temp-file @@ -468,7 +467,6 @@ agenda view showing the flagged items." (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b))))) (setq tags (append def-tags tags nil)) (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") - (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n") (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") (when (file-exists-p (expand-file-name org-mobile-directory "agendas.org")) diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index 77f68f4d8..1eee779b9 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -363,25 +363,6 @@ This needs more work, to handle headings with lots of spaces in them." lst)) (substring pcomplete-stub 1))) -(defvar org-drawers) - -(defun pcomplete/org-mode/drawer () - "Complete a drawer name." - (let ((spc (save-excursion - (move-beginning-of-line 1) - (looking-at "^\\([ \t]*\\):") - (match-string 1))) - (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) - (pcomplete-here cpllist - (substring pcomplete-stub 1) - (unless (or (not (delq - nil - (mapcar (lambda(x) - (string-match (substring pcomplete-stub 1) x)) - cpllist))) - (looking-at "[ \t]*\n.*:END:")) - (save-excursion (insert "\n" spc ":END:")))))) - (defun pcomplete/org-mode/block-option/src () "Complete the arguments of a begin_src block. Complete a language in the first field, the header arguments and switches." diff --git a/lisp/org.el b/lisp/org.el index 4f3bf4b4a..6cdbd4491 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -884,6 +884,10 @@ An entry can be toggled between QUOTE and normal with :group 'org-keywords :type 'string) +(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" + "Matches first line of a hidden block. +Group 1 contains drawer's name.") + (defconst org-repeat-re "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" "Regular expression for specifying repeated events. @@ -1072,23 +1076,6 @@ than its value." (const :tag "No limit" nil) (integer :tag "Maximum level"))) -(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS") - "Names of drawers. Drawers are not opened by cycling on the headline above. -Drawers only open with a TAB on the drawer line itself. A drawer looks like -this: - :DRAWERNAME: - ..... - :END: -The drawer \"PROPERTIES\" is special for capturing properties through -the property API. - -Drawers can be defined on the per-file basis with a line like: - -#+DRAWERS: HIDDEN STATE PROPERTIES" - :group 'org-structure - :group 'org-cycle - :type '(repeat (string :tag "Drawer Name"))) - (defcustom org-hide-block-startup nil "Non-nil means entering Org-mode will fold all blocks. This can also be set in on a per-file basis with @@ -2346,7 +2333,6 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." (make-variable-buffer-local 'org-todo-keywords-1) (defvar org-todo-keywords-for-agenda nil) (defvar org-done-keywords-for-agenda nil) -(defvar org-drawers-for-agenda nil) (defvar org-todo-keyword-alist-for-agenda nil) (defvar org-tag-alist-for-agenda nil "Alist of all tags from all agenda files.") @@ -4596,9 +4582,6 @@ Otherwise, these types are allowed: ;;; Variables for pre-computed regular expressions, all buffer local -(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$" - "Matches first line of a hidden block.") -(make-variable-buffer-local 'org-drawer-regexp) (defvar org-todo-regexp nil "Matches any of the TODO state keywords.") (make-variable-buffer-local 'org-todo-regexp) @@ -4977,8 +4960,6 @@ Support for group tags is controlled by the option (setq props (org-update-property-plist (match-string 1 value) (match-string 2 value) props)))) - ((equal key "DRAWERS") - (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) ((equal key "CONSTANTS") (org-table-set-constants)) ((equal key "STARTUP") @@ -5034,7 +5015,6 @@ Support for group tags is controlled by the option (org-set-local 'org-lowest-priority (nth 1 prio)) (org-set-local 'org-default-priority (nth 2 prio))) (and props (org-set-local 'org-file-properties (nreverse props))) - (and drawers (org-set-local 'org-drawers drawers)) (and arch (org-set-local 'org-archive-location arch)) (and links (setq org-link-abbrev-alist-local (nreverse links))) ;; Process the TODO keywords @@ -5094,10 +5074,6 @@ Support for group tags is controlled by the option (length org-scheduled-string) (length org-clock-string) (length org-closed-string))) - org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$") org-not-done-keywords (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) org-todo-regexp @@ -6624,11 +6600,10 @@ in special contexts. ((eq arg t) (org-cycle-internal-global)) ;; Drawers: delegate to `org-flag-drawer'. - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - (org-flag-drawer ; toggle block visibility + ((save-excursion + (beginning-of-line 1) + (looking-at org-drawer-regexp)) + (org-flag-drawer ; toggle block visibility (not (get-char-property (match-end 0) 'invisible)))) ;; Show-subtree, ARG levels up from here. @@ -7058,8 +7033,10 @@ open and agenda-wise Org files." "Return the end position of the current entry." (save-excursion (outline-next-heading) (point))) -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change." +(defun org-cycle-hide-drawers (state &optional exceptions) + "Re-hide all drawers after a visibility state change. +When non-nil, optional argument EXCEPTIONS is a list of strings +specifying which drawers should not be hidden." (when (and (derived-mode-p 'org-mode) (not (memq state '(overview folded contents)))) (save-excursion @@ -7071,7 +7048,8 @@ open and agenda-wise Org files." (org-end-of-subtree t))))) (goto-char beg) (while (re-search-forward org-drawer-regexp end t) - (org-flag-drawer t)))))) + (unless (member-ignore-case (match-string 1) exceptions) + (org-flag-drawer t))))))) (defun org-cycle-hide-inline-tasks (state) "Re-hide inline task when switching to 'contents visibility state." @@ -8523,8 +8501,7 @@ and still retain the repeater to cover future instances of the task." (kill-whole-line)) (goto-char (point-min)) (while (re-search-forward drawer-re nil t) - (mapc (lambda (d) - (org-remove-empty-drawer-at d (point))) org-drawers))) + (org-remove-empty-drawer-at (point)))) (goto-char (point-min)) (when doshift (while (re-search-forward org-ts-regexp-both nil t) @@ -12454,7 +12431,7 @@ See variable `org-track-ordered-property-with-tag'." (org-back-to-heading) (if (org-entry-get nil "ORDERED") (progn - (org-delete-property "ORDERED" "PROPERTIES") + (org-delete-property "ORDERED") (and tag (org-toggle-tag tag 'off)) (message "Subtasks can be completed in arbitrary order")) (org-entry-put nil "ORDERED" "t") @@ -13371,9 +13348,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (push note lines)) (when (or current-prefix-arg org-note-abort) (when org-log-into-drawer - (org-remove-empty-drawer-at - (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK") - org-log-note-marker)) + (org-remove-empty-drawer-at org-log-note-marker)) (setq lines nil)) (when lines (with-current-buffer (marker-buffer org-log-note-marker) @@ -13418,17 +13393,20 @@ EXTRA is additional text that will be inserted into the notes buffer." (move-marker org-log-note-return-to nil) (and org-log-post-message (message "%s" org-log-post-message)))) -(defun org-remove-empty-drawer-at (drawer pos) - "Remove an empty drawer DRAWER at position POS. +(defun org-remove-empty-drawer-at (pos) + "Remove an empty drawer at position POS. POS may also be a marker." (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (if (org-in-regexp - (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) - (replace-match "")))))) + (org-with-wide-buffer + (goto-char pos) + (let ((drawer (org-element-at-point))) + (when (and (memq (org-element-type drawer) '(drawer property-drawer)) + (not (org-element-property :contents-begin drawer))) + (delete-region (org-element-property :begin drawer) + (progn (goto-char (org-element-property :end drawer)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point)))))))) (defvar org-ts-type nil) (defun org-sparse-tree (&optional arg type) @@ -14954,7 +14932,6 @@ a *different* entry, you cannot use these techniques." org-todo-keywords-for-agenda org-done-keywords-for-agenda org-todo-keyword-alist-for-agenda - org-drawers-for-agenda org-tag-alist-for-agenda todo-only) @@ -15336,13 +15313,10 @@ If yes, return this value. If not, return the current value of the variable." (read prop) (symbol-value var)))) -(defun org-entry-delete (pom property &optional delete-empty-drawer) - "Delete the property PROPERTY from entry at point-or-marker POM. -When optional argument DELETE-EMPTY-DRAWER is a string, it defines -an empty drawer to delete." - (org-with-point-at pom - (if (member property org-special-properties) - nil ; cannot delete these properties. +(defun org-entry-delete (pom property) + "Delete the property PROPERTY from entry at point-or-marker POM." + (unless (member property org-special-properties) + (org-with-point-at pom (let ((range (org-get-property-block))) (if (and range (goto-char (car range)) @@ -15351,9 +15325,7 @@ an empty drawer to delete." (cdr range) t)) (progn (delete-region (match-beginning 0) (1+ (point-at-eol))) - (and delete-empty-drawer - (org-remove-empty-drawer-at - delete-empty-drawer (car range))) + (org-remove-empty-drawer-at (car range)) t) nil))))) @@ -15632,23 +15604,14 @@ instead. Point is left between drawer's boundaries." (interactive "P") - (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer - "LOGBOOK")) - ;; SYSTEM-DRAWERS is a list of drawer names that are used - ;; internally by Org. They are meant to be inserted - ;; automatically. - (system-drawers `("CLOCK" ,logbook "PROPERTIES")) - ;; Remove system drawers from list. Note: For some reason, - ;; `org-completing-read' ignores the predicate while - ;; `completing-read' handles it fine. - (drawer (if arg "PROPERTIES" - (or drawer - (completing-read - "Drawer: " org-drawers - (lambda (d) (not (member d system-drawers)))))))) + (let* ((drawer (if arg "PROPERTIES" + (or drawer (read-from-minibuffer "Drawer: "))))) (cond ;; With C-u, fall back on `org-insert-property-drawer' (arg (org-insert-property-drawer)) + ;; + ((not (org-string-match-p org-drawer-regexp (format ":%s:" drawer))) + (user-error "Invalid drawer name")) ;; With an active region, insert a drawer at point. ((not (org-region-active-p)) (progn @@ -15784,17 +15747,15 @@ in the current file." (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value)))) -(defun org-delete-property (property &optional delete-empty-drawer) - "In the current entry, delete PROPERTY. -When optional argument DELETE-EMPTY-DRAWER is a string, it defines -an empty drawer to delete." +(defun org-delete-property (property) + "In the current entry, delete PROPERTY." (interactive (let* ((completion-ignore-case t) (prop (org-icompleting-read "Property: " (org-entry-properties nil 'standard)))) (list prop))) (message "Property %s %s" property - (if (org-entry-delete nil property delete-empty-drawer) + (if (org-entry-delete nil property) "deleted" "was not present in the entry"))) @@ -18081,8 +18042,6 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (append org-done-keywords-for-agenda org-done-keywords)) (setq org-todo-keyword-alist-for-agenda (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) - (setq org-drawers-for-agenda - (append org-drawers-for-agenda org-drawers)) (setq org-tag-alist-for-agenda (org-uniquify (append org-tag-alist-for-agenda @@ -21679,15 +21638,13 @@ block from point." nil))) (defun org-in-drawer-p () - "Is point within a drawer?" - (save-match-data - (let ((case-fold-search t) - (lim-up (save-excursion (outline-previous-heading))) - (lim-down (save-excursion (outline-next-heading)))) - (org-between-regexps-p - (concat "^[ \t]*:" (regexp-opt org-drawers) ":") - "^[ \t]*:end:.*$" - lim-up lim-down)))) + "Non-nil if point is within a drawer. +If point is within a drawer, return it, as parsed data." + (let ((element (save-match-data (org-element-at-point)))) + (while (and element (not (memq (org-element-type element) + '(drawer property-drawer)))) + (setq element (org-element-property :parent element))) + element)) (defun org-occur-in-agenda-files (regexp &optional nlines) "Call `multi-occur' with buffers for all agenda files." diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 4f08e3e7a..3d31ef474 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -415,21 +415,18 @@ Some other text "Test `drawer' parser." ;; Standard test. (should - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\nText\n:END:" - (org-element-map (org-element-parse-buffer) 'drawer 'identity)))) + (org-test-with-temp-text ":TEST:\nText\n:END:" + (org-element-map (org-element-parse-buffer) 'drawer 'identity))) ;; Do not mix regular drawers and property drawers. (should-not - (let ((org-drawers '("PROPERTIES"))) - (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'drawer 'identity nil t)))) + (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" + (org-element-map + (org-element-parse-buffer) 'drawer 'identity nil t))) ;; Ignore incomplete drawer. (should-not - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:" - (org-element-map - (org-element-parse-buffer) 'drawer 'identity nil t))))) + (org-test-with-temp-text ":TEST:" + (org-element-map + (org-element-parse-buffer) 'drawer 'identity nil t)))) ;;;; Dynamic Block @@ -1403,16 +1400,10 @@ e^{i\\pi}+1=0 (org-element-map (org-element-parse-buffer) 'paragraph 'identity))) ;; Include incomplete-drawers. (should - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\nParagraph" - (let ((elem (org-element-at-point))) - (and (eq (org-element-type elem) 'paragraph) - (= (point-max) (org-element-property :end elem))))))) - ;; Include non-existent drawers. - (should - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":NONAME:" - (org-element-map (org-element-parse-buffer) 'paragraph 'identity)))) + (org-test-with-temp-text ":TEST:\nParagraph" + (let ((elem (org-element-at-point))) + (and (eq (org-element-type elem) 'paragraph) + (= (point-max) (org-element-property :end elem)))))) ;; Include incomplete blocks. (should (org-test-with-temp-text "#+BEGIN_CENTER\nParagraph" @@ -1505,22 +1496,19 @@ Outside list" "Test `property-drawer' parser." ;; Standard test. (should - (let ((org-drawers '("PROPERTIES"))) - (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t)))) + (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" + (org-element-map + (org-element-parse-buffer) 'property-drawer 'identity nil t))) ;; Do not mix property drawers and regular drawers. (should-not - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t)))) + (org-test-with-temp-text ":TEST:\n:prop: value\n:END:" + (org-element-map + (org-element-parse-buffer) 'property-drawer 'identity nil t))) ;; Ignore incomplete drawer. (should-not - (let ((org-drawers '("PROPERTIES"))) - (org-test-with-temp-text ":PROPERTIES:\n:prop: value" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t))))) + (org-test-with-temp-text ":PROPERTIES:\n:prop: value" + (org-element-map + (org-element-parse-buffer) 'property-drawer 'identity nil t)))) ;;;; Quote Block @@ -1965,8 +1953,7 @@ Outside list" (ert-deftest test-org-element/drawer-interpreter () "Test drawer interpreter." (should - (equal (let ((org-drawers '("TEST"))) - (org-test-parse-and-interpret ":TEST:\nTest\n:END:")) + (equal (org-test-parse-and-interpret ":TEST:\nTest\n:END:") ":TEST:\nTest\n:END:\n"))) (ert-deftest test-org-element/dynamic-block-interpreter () diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index e3a8e674c..d60397188 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -392,20 +392,18 @@ (looking-at "- $"))) ;; In a drawer and paragraph insert an empty line, in this case above. (should - (let ((org-drawers '("MYDRAWER"))) - (org-test-with-temp-text ":MYDRAWER:\na\n:END:" - (forward-line) - (org-meta-return) - (forward-line -1) - (looking-at "$")))) + (org-test-with-temp-text ":MYDRAWER:\na\n:END:" + (forward-line) + (org-meta-return) + (forward-line -1) + (looking-at "$"))) ;; In a drawer and item insert an item, in this case above. (should - (let ((org-drawers '("MYDRAWER"))) - (org-test-with-temp-text ":MYDRAWER:\n- a\n:END:" - (forward-line) - (org-meta-return) - (beginning-of-line) - (looking-at "- $"))))) + (org-test-with-temp-text ":MYDRAWER:\n- a\n:END:" + (forward-line) + (org-meta-return) + (beginning-of-line) + (looking-at "- $")))) (ert-deftest test-org/insert-todo-heading-respect-content () "Test `org-insert-todo-heading-respect-content' specifications." diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 5a066a56c..1aba00da9 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -414,28 +414,24 @@ Paragraph" ;; Drawers. (should (equal "" - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\ncontents\n:END:" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-drawers nil)))))) + (org-test-with-temp-text ":TEST:\ncontents\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers nil))))) (should (equal ":TEST:\ncontents\n:END:\n" - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\ncontents\n:END:" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-drawers t)))))) + (org-test-with-temp-text ":TEST:\ncontents\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers t))))) (should (equal ":FOO:\nkeep\n:END:\n" - (let ((org-drawers '("FOO" "BAR"))) - (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-drawers ("FOO"))))))) + (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers ("FOO")))))) (should (equal ":FOO:\nkeep\n:END:\n" - (let ((org-drawers '("FOO" "BAR"))) - (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-drawers (not "BAR"))))))) + (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-drawers (not "BAR")))))) ;; Footnotes. (should (equal "Footnote?" From e0011113b3e9211f3708a043da25a7307ae1cc54 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 31 Oct 2013 21:27:18 +0100 Subject: [PATCH 027/166] org.texi: Remove references to DRAWERS keyword * doc/org.texi (Drawers, RSS feeds, In-buffer settings): Remove references to DRAWERS keyword, which is unused now. --- doc/org.texi | 21 ++++----------------- 1 file changed, 4 insertions(+), 17 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index d1e9c8238..3d328e096 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -1831,18 +1831,14 @@ or by a custom function. @node Drawers @section Drawers @cindex drawers -@cindex #+DRAWERS @cindex visibility cycling, drawers -@vindex org-drawers @cindex org-insert-drawer @kindex C-c C-x d Sometimes you want to keep information associated with an entry, but you -normally don't want to see it. For this, Org mode has @emph{drawers}. -Drawers need to be configured with the option @code{org-drawers}@footnote{You -can define additional drawers on a per-file basis with a line like -@code{#+DRAWERS: HIDDEN STATE}}. They can contain anything but a headline -and another drawer. Drawers look like this: +normally don't want to see it. For this, Org mode has @emph{drawers}. They +can contain anything but a headline and another drawer. Drawers look like +this: @example ** This is a headline @@ -7330,12 +7326,7 @@ Prompt for a feed name and go to the inbox configured for this feed. Under the same headline, Org will create a drawer @samp{FEEDSTATUS} in which it will store information about the status of items in the feed, to avoid -adding the same item several times. You should add @samp{FEEDSTATUS} to the -list of drawers in that file: - -@example -#+DRAWERS: LOGBOOK PROPERTIES FEEDSTATUS -@end example +adding the same item several times. For more information, including how to read atom feeds, see @file{org-feed.el} and the docstring of @code{org-feed-alist}. @@ -15851,10 +15842,6 @@ The global version of this variable is @item #+FILETAGS: :tag1:tag2:tag3: Set tags that can be inherited by any entry in the file, including the top-level entries. -@item #+DRAWERS: NAME1 ..... -@vindex org-drawers -Set the file-local set of additional drawers. The corresponding global -variable is @code{org-drawers}. @item #+LINK: linkword replace @vindex org-link-abbrev-alist These lines (several are allowed) specify link abbreviations. From cebf7d012dd17f58650f9867dd41ee99735c7fb5 Mon Sep 17 00:00:00 2001 From: Rick Frankel Date: Thu, 31 Oct 2013 17:06:49 -0400 Subject: [PATCH 028/166] org.el: Display images in link descriptions. * lisp/org.el (org-display-inline-images): Modify link regular expression to match images in description part. Update doc string to explain link behavior. --- lisp/org.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 6cdbd4491..c42b9ebb2 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18794,11 +18794,16 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (defun org-display-inline-images (&optional include-linked refresh beg end) "Display inline images. -Normally only links without a description part are inlined, because this -is how it will work for export. When INCLUDE-LINKED is set, also links -with a description part will be inlined. This can be nice for a quick -look at those images, but it does not reflect what exported files will look -like. +Normally only links without a description part, or with an image +file name in the description, are inlined, because this is how it +will work for export. When INCLUDE-LINKED is set, also links +with a text description part will be inlined. This can be nice +for a quick look at those images, but it does not reflect what +exported files will look like. Note that in latex and html +exports, images specified in the description will only be treated +as graphic if they begin with the 'file:' protocol. Images +specified in the description without a protocol will be displayed +inline in the buffer, but shown as text in the export. When REFRESH is set, refresh existing images between BEG and END. This will create new image displays only if necessary. BEG and END default to the buffer boundaries." @@ -18812,7 +18817,7 @@ BEG and END default to the buffer boundaries." (widen) (setq beg (or beg (point-min)) end (or end (point-max))) (goto-char beg) - (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" + (let ((re (concat "\\[.*\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" (substring (org-image-file-name-regexp) 0 -2) "\\)\\]" (if include-linked "" "\\]"))) (case-fold-search t) From cab0d40593d75227aa47f80d3de7b9c3a74c3bb4 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 2 Nov 2013 14:23:41 +0100 Subject: [PATCH 029/166] Fix inline images display * lisp/org.el (org-display-inline-images): Rewrite function. --- lisp/org.el | 161 +++++++++++++++++++++++++++++++++------------------- 1 file changed, 103 insertions(+), 58 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index c42b9ebb2..a4328066a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18794,68 +18794,113 @@ INCLUDE-LINKED is passed to `org-display-inline-images'." (defun org-display-inline-images (&optional include-linked refresh beg end) "Display inline images. -Normally only links without a description part, or with an image -file name in the description, are inlined, because this is how it -will work for export. When INCLUDE-LINKED is set, also links -with a text description part will be inlined. This can be nice -for a quick look at those images, but it does not reflect what -exported files will look like. Note that in latex and html -exports, images specified in the description will only be treated -as graphic if they begin with the 'file:' protocol. Images -specified in the description without a protocol will be displayed -inline in the buffer, but shown as text in the export. -When REFRESH is set, refresh existing images between BEG and END. -This will create new image displays only if necessary. -BEG and END default to the buffer boundaries." + +An inline image is a link which follows either of these +conventions: + + 1. Its path is a file with an extension matching return value + from `image-file-name-regexp' and it has no contents. + + 2. Its description consists in a single link of the previous + type. + +When optional argument INCLUDE-LINKED is non-nil, also links with +a text description part will be inlined. This can be nice for +a quick look at those images, but it does not reflect what +exported files will look like. + +When optional argument REFRESH is non-nil, refresh existing +images between BEG and END. This will create new image displays +only if necessary. BEG and END default to the buffer +boundaries." (interactive "P") (when (display-graphic-p) (unless refresh (org-remove-inline-images) - (if (fboundp 'clear-image-cache) (clear-image-cache))) - (save-excursion - (save-restriction - (widen) - (setq beg (or beg (point-min)) end (or end (point-max))) - (goto-char beg) - (let ((re (concat "\\[.*\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) - "\\)\\]" (if include-linked "" "\\]"))) - (case-fold-search t) - old file ov img type attrwidth width) - (while (re-search-forward re end t) - (setq old (get-char-property-and-overlay (match-beginning 1) - 'org-image-overlay) - file (expand-file-name - (concat (or (match-string 3) "") (match-string 4)))) - (when (image-type-available-p 'imagemagick) - (setq attrwidth (if (or (listp org-image-actual-width) - (null org-image-actual-width)) - (save-excursion - (save-match-data - (when (re-search-backward - "#\\+attr.*:width[ \t]+\\([^ ]+\\)" - (save-excursion - (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) - (string-to-number (match-string 1)))))) - width (cond ((eq org-image-actual-width t) nil) - ((null org-image-actual-width) attrwidth) - ((numberp org-image-actual-width) - org-image-actual-width) - ((listp org-image-actual-width) - (or attrwidth (car org-image-actual-width)))) - type (if width 'imagemagick))) - (when (file-exists-p file) - (if (and (car-safe old) refresh) - (image-refresh (overlay-get (cdr old) 'display)) - (setq img (save-match-data (create-image file type nil :width width))) - (when img - (setq ov (make-overlay (match-beginning 0) (match-end 0))) - (overlay-put ov 'display img) - (overlay-put ov 'face 'default) - (overlay-put ov 'org-image-overlay t) - (overlay-put ov 'modification-hooks - (list 'org-display-inline-remove-overlay)) - (push ov org-inline-image-overlays)))))))))) + (when (fboundp 'clear-image-cache) (clear-image-cache))) + (org-with-wide-buffer + (goto-char (or beg (point-min))) + (let ((case-fold-search t) + (file-extension-re (org-image-file-name-regexp))) + (while (re-search-forward "[][]\\[\\(?:file\\|[./~]\\)" end t) + (let ((link (save-match-data (org-element-context)))) + ;; Check if we're at an inline image. + (when (and (equal (org-element-property :type link) "file") + (or include-linked + (not (org-element-property :contents-begin link))) + (let ((parent (org-element-property :parent link))) + (or (not (eq (org-element-type parent) 'link)) + (not (cdr (org-element-contents parent))))) + (org-string-match-p file-extension-re + (org-element-property :path link))) + (let ((file (expand-file-name (org-element-property :path link)))) + (when (file-exists-p file) + (let ((width + ;; Apply `org-image-actual-width' specifications. + (cond + ((not (image-type-available-p 'imagemagick)) nil) + ((eq org-image-actual-width t) nil) + ((listp org-image-actual-width) + (or + ;; First try to find a width among + ;; attributes associated to the paragraph + ;; containing link. + (let ((paragraph + (let ((e link)) + (while (and (setq e (org-element-property + :parent e)) + (eq (org-element-type e) + 'paragraph))) + e))) + (when paragraph + (save-excursion + (goto-char (org-element-property :begin paragraph)) + (when (save-match-data + (re-search-forward + "^[ \t]*#\\+attr_.*?: +.*?:width +\\(\\S-+\\)" + (org-element-property + :post-affiliated paragraph) + t)) + (string-to-number (match-string 1)))))) + ;; Otherwise, fall-back to provided number. + (car org-image-actual-width))) + ((numberp org-image-actual-width) + org-image-actual-width))) + (old (get-char-property-and-overlay + (org-element-property :begin link) + 'org-image-overlay))) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (let ((image (save-match-data + (create-image file + (and width 'imagemagick) + nil + :width width)))) + (when image + (let* ((link + ;; If inline image is the description + ;; of another link, be sure to + ;; consider the latter as the one to + ;; apply the overlay on. + (let ((parent + (org-element-property :parent link))) + (if (eq (org-element-type parent) 'link) + parent + link))) + (ov (make-overlay + (org-element-property :begin link) + (progn + (goto-char + (org-element-property :end link)) + (skip-chars-backward " \t") + (point))))) + (overlay-put ov 'display image) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put + ov 'modification-hooks + (list 'org-display-inline-remove-overlay)) + (push ov org-inline-image-overlays))))))))))))))) (define-obsolete-function-alias 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") From baf84575054e9fc7e96c2b11552c04d98a3224ba Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 2 Nov 2013 14:32:07 +0100 Subject: [PATCH 030/166] ox: Fix comment --- lisp/ox.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ox.el b/lisp/ox.el index abc301207..a731cdf49 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -1250,7 +1250,7 @@ The back-end could then be called with, for example: ;; ;; + `:back-end' :: Current back-end used for transcoding. ;; - category :: tree -;; - type :: symbol +;; - type :: structure ;; ;; + `:creator' :: String to write as creation information. ;; - category :: option From 205e586dd1e65fdab549c0021129f803160b2232 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 2 Nov 2013 14:33:24 +0100 Subject: [PATCH 031/166] ox: Add :input-buffer to communication channel * lisp/ox.el (org-export--get-buffer-attributes): Add :input-buffer property. --- lisp/ox.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ox.el b/lisp/ox.el index a731cdf49..00772033a 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -1333,6 +1333,10 @@ The back-end could then be called with, for example: ;; - category :: tree ;; - type :: list of elements and objects ;; +;; + `:input-buffer' :: Original buffer name. +;; - category :: option +;; - type :: string +;; ;; + `:input-file' :: Full path to input file, if any. ;; - category :: option ;; - type :: string or nil @@ -1787,7 +1791,8 @@ Assume buffer is in Org mode. Narrowing, if any, is ignored." "Return properties related to buffer attributes, as a plist." ;; Store full path of input file name, or nil. For internal use. (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (list :input-file visited-file + (list :input-buffer (buffer-name (buffer-base-buffer)) + :input-file visited-file :title (if (not visited-file) (buffer-name (buffer-base-buffer)) (file-name-sans-extension (file-name-nondirectory visited-file)))))) From b3927501081b1dab15540591d55f016ed4f9f948 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 2 Nov 2013 15:48:36 +0100 Subject: [PATCH 032/166] Prevent flagging drawers in example blocks * lisp/org.el (org-flag-drawer): Rewrite function using Elements. Also prevents flagging drawers within example blocks. * testing/lisp/test-org.el (test-org/flag-drawer): Add test. --- lisp/org.el | 27 ++++++++++++++----------- testing/lisp/test-org.el | 43 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+), 12 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index a4328066a..7016d5a4c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7058,18 +7058,21 @@ specifying which drawers should not be hidden." org-inlinetask-min-level) (hide-sublevels (1- org-inlinetask-min-level)))) -(defun org-flag-drawer (flag) - "When FLAG is non-nil, hide the drawer we are within. -Otherwise make it visible." - (save-excursion - (beginning-of-line 1) - (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) - (if (re-search-forward - "^[ \t]*:END:" - (save-excursion (outline-next-heading) (point)) t) - (outline-flag-region b (point-at-eol) flag) - (user-error ":END: line missing at position %s" b)))))) +(defun org-flag-drawer (flag &optional element) + "When FLAG is non-nil, hide the drawer we are at. +Otherwise make it visible. When optional argument ELEMENT is +a parsed drawer, as returned by `org-element-at-point', hide or +show that drawer instead." + (let ((drawer (or element (org-element-at-point)))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (save-excursion + (goto-char (org-element-property :post-affiliated drawer)) + (outline-flag-region + (line-end-position) + (progn (goto-char (org-element-property :end drawer)) + (skip-chars-backward " \r\t\n") + (line-end-position)) + flag))))) (defun org-subtree-end-visible-p () "Is the end of the current subtree visible?" diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index d60397188..0e068dd10 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -1294,6 +1294,49 @@ Text. (org-test-with-temp-text "<> <<>>" (org-all-targets t))))) + +;;; Visibility + +(ert-deftest test-org/flag-drawer () + "Test `org-flag-drawer' specifications." + ;; Hide drawer. + (should + (org-test-with-temp-text ":DRAWER:\ncontents\n:END:" + (org-flag-drawer t) + (get-char-property (line-end-position) 'invisible))) + ;; Show drawer. + (should-not + (org-test-with-temp-text ":DRAWER:\ncontents\n:END:" + (org-flag-drawer t) + (org-flag-drawer nil) + (get-char-property (line-end-position) 'invisible))) + ;; Test optional argument. + (should + (org-test-with-temp-text ":D1:\nc1\n:END:\n\n:D2:\nc2\n:END:" + (let ((drawer (save-excursion (search-forward ":D2") + (org-element-at-point)))) + (org-flag-drawer t drawer) + (get-char-property (progn (search-forward ":D2") (line-end-position)) + 'invisible)))) + (should-not + (org-test-with-temp-text ":D1:\nc1\n:END:\n\n:D2:\nc2\n:END:" + (let ((drawer (save-excursion (search-forward ":D2") + (org-element-at-point)))) + (org-flag-drawer t drawer) + (get-char-property (line-end-position) 'invisible)))) + ;; Do not hide fake drawers. + (should-not + (org-test-with-temp-text "#+begin_example\n:D:\nc\n:END:\n#+end_example" + (forward-line 1) + (org-flag-drawer t) + (get-char-property (line-end-position) 'invisible))) + ;; Do not hide incomplete drawers. + (should-not + (org-test-with-temp-text ":D:\nparagraph" + (forward-line 1) + (org-flag-drawer t) + (get-char-property (line-end-position) 'invisible)))) + (provide 'test-org) From e7397d3d97977d1ce777c331c28fd51b8b5354af Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 2 Nov 2013 17:41:30 +0100 Subject: [PATCH 033/166] Fix small bug * lisp/org.el (org-display-inline-images): Fix bug introduced in cab0d40593d75227aa47f80d3de7b9c3a74c3bb4. --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 7016d5a4c..3a676309e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18852,8 +18852,8 @@ boundaries." (let ((e link)) (while (and (setq e (org-element-property :parent e)) - (eq (org-element-type e) - 'paragraph))) + (not (eq (org-element-type e) + 'paragraph)))) e))) (when paragraph (save-excursion From d7379053c0ad41e151f5403d1e5f051b9cc7ce70 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 3 Nov 2013 11:35:31 +0100 Subject: [PATCH 034/166] ox: Fix OPTIONS in default template * lisp/ox.el (org-export-insert-default-template): Make sure strings are properly quoted when inserting a template. Specifically, default value for drawers should be d:(not "LOGBOOK"), not d:(not LOGBOOK). --- lisp/ox.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 26bcb1944..72a7a056c 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -3163,8 +3163,7 @@ locally for the subtree through node properties." (when options (let ((items (mapcar - (lambda (opt) - (format "%s:%s" (car opt) (format "%s" (cdr opt)))) + #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt))) (sort options (lambda (k1 k2) (string< (car k1) (car k2))))))) (if subtreep (org-entry-put From e186cc804b9302e3c85a149cf2a08ed124634b6b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 3 Nov 2013 13:06:14 +0100 Subject: [PATCH 035/166] Fix wrong-type-argument error when opening id link * lisp/org.el (org-open-at-point): Check if link is non-nil before matching it. Reported-by: Daniel Clemente --- lisp/org.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 8da6f7d68..5e1f19508 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -10543,7 +10543,8 @@ application the system uses for this file type." ((and (string= type "thisfile") (or (run-hook-with-args-until-success 'org-open-link-functions path) - (and (string-match "^id:" link) + (and link + (string-match "^id:" link) (or (featurep 'org-id) (require 'org-id)) (progn (funcall (nth 1 (assoc "id" org-link-protocols)) From 0cecf32a0ae559266555b96668dc305710366c96 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 27 Oct 2013 11:09:17 +0100 Subject: [PATCH 036/166] org-element: Implement caching for dynamic parser * lisp/org-element.el (org-element-use-cache, org-element--cache, org-element--cache-sync-idle-time, org-element--cache-merge-changes-threshold, org-element--cache-status, org-element--cache-opening-line, org-element--cache-closing-line): New variables. (org-element-cache-reset, org-element--cache-pending-changes-p, org-element--cache-push-change, org-element--cache-cancel-changes, org-element--cache-get-key, org-element-cache-get, org-element-cache-put, org-element--shift-positions, org-element--cache-before-change, org-element--cache-record-change, org-element--cache-sync): New functions. (org-element-at-point, org-element-context): Use cache when possible. * lisp/org.el (org-mode, org-set-modules): Reset cache. * lisp/org-footnote.el (org-footnote-section): Reset cache. * testing/lisp/test-org-element.el: Update tests. This patch gives a boost to `org-element-at-point' and, to a lesser extent, to `org-element-context'. --- lisp/org-element.el | 750 +++++++++++++++++++++++++------ lisp/org-footnote.el | 9 +- lisp/org.el | 6 +- testing/lisp/test-org-element.el | 18 +- 4 files changed, 641 insertions(+), 142 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 95b775060..1c617c99a 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -111,7 +111,8 @@ ;; ;; The library ends by furnishing `org-element-at-point' function, and ;; a way to give information about document structure around point -;; with `org-element-context'. +;; with `org-element-context'. A simple cache mechanism is also +;; provided for these functions. ;;; Code: @@ -4618,7 +4619,7 @@ indentation is not done with TAB characters." ;; The first move is to implement a way to obtain the smallest element ;; containing point. This is the job of `org-element-at-point'. It ;; basically jumps back to the beginning of section containing point -;; and moves, element after element, with +;; and proceed, one element after the other, with ;; `org-element--current-element' until the container is found. Note: ;; When using `org-element-at-point', secondary values are never ;; parsed since the function focuses on elements, not on objects. @@ -4626,8 +4627,417 @@ indentation is not done with TAB characters." ;; At a deeper level, `org-element-context' lists all elements and ;; objects containing point. ;; -;; `org-element-nested-p' and `org-element-swap-A-B' may be used -;; internally by navigation and manipulation tools. +;; Both functions benefit from a simple caching mechanism. It is +;; enabled by default, but can be disabled globally with +;; `org-element-use-cache'. Also `org-element-cache-reset' clears or +;; initializes cache for current buffer. Values are retrieved and put +;; into cache with respectively, `org-element-cache-get' and +;; `org-element-cache-put'. `org-element--cache-sync-idle-time' and +;; `org-element--cache-merge-changes-threshold' are used internally to +;; control caching behaviour. +;; +;; Eventually `org-element-nested-p' and `org-element-swap-A-B' may be +;; used internally by navigation and manipulation tools. + +(defvar org-element-use-cache t + "Non nil when Org parser should cache its results.") + +(defvar org-element--cache nil + "Hash table used as a cache for parser. +Key is a buffer position and value is a cons cell with the +pattern: + + \(ELEMENT . OBJECTS-DATA) + +where ELEMENT is the element starting at the key and OBJECTS-DATA +is an alist where each association is: + + \(POS CANDIDATES . OBJECTS) + +where POS is a buffer position, CANDIDATES is the last know list +of successors (see `org-element--get-next-object-candidates') in +container starting at POS and OBJECTS is a list of objects known +to live within that container, from farthest to closest. + +In the following example, \\alpha, bold object and \\beta start +at, respectively, positions 1, 7 and 8, + + \\alpha *\\beta* + +If the paragraph is completely parsed, OBJECTS-DATA will be + + \((1 nil BOLD-OBJECT ENTITY-OBJECT) + \(8 nil ENTITY-OBJECT)) + +whereas in a partially parsed paragraph, it could be + + \((1 ((entity . 1) (bold . 7)) ENTITY-OBJECT)) + +This cache is used in both `org-element-at-point' and +`org-element-context'. The former uses ELEMENT only and the +latter OBJECTS-DATA only.") + +(defvar org-element--cache-sync-idle-time 0.5 + "Number of seconds of idle time wait before syncing buffer cache. +Syncing also happens when current modification is too distant +from the stored one (for more information, see +`org-element--cache-merge-changes-threshold').") + +(defvar org-element--cache-merge-changes-threshold 200 + "Number of characters triggering cache syncing. + +The cache mechanism only stores one buffer modification at any +given time. When another change happens, it replaces it with +a change containing both the stored modification and the current +one. This is a trade-off, as merging them prevents another +syncing, but every element between them is then lost. + +This variable determines the maximum size, in characters, we +accept to lose in order to avoid syncing the cache.") + +(defvar org-element--cache-status nil + "Contains data about cache validity for current buffer. + +Value is a vector of seven elements, + + [ACTIVEP BEGIN END OFFSET TIMER PREVIOUS-STATE] + +ACTIVEP is a boolean non-nil when changes described in the other +slots are valid for current buffer. + +BEGIN and END are the beginning and ending position of the area +for which cache cannot be trusted. + +OFFSET it an integer specifying the number to add to position of +elements after that area. + +TIMER is a timer used to apply these changes to cache when Emacs +is idle. + +PREVIOUS-STATE is a symbol referring to the state of the buffer +before a change happens. It is used to know if sensitive +areas (block boundaries, headlines) were modified. It can be set +to nil, `headline' or `other'.") + +;;;###autoload +(defun org-element-cache-reset (&optional all) + "Reset cache in current buffer. +When optional argument ALL is non-nil, reset cache in all Org +buffers. This function will do nothing if +`org-element-use-cache' is nil." + (interactive "P") + (when org-element-use-cache + (dolist (buffer (if all (buffer-list) (list (current-buffer)))) + (with-current-buffer buffer + (when (derived-mode-p 'org-mode) + (if (org-bound-and-true-p org-element--cache) + (clrhash org-element--cache) + (org-set-local 'org-element--cache + (make-hash-table :size 5003 :test 'eq))) + (org-set-local 'org-element--cache-status (make-vector 6 nil)) + (add-hook 'before-change-functions + 'org-element--cache-before-change nil t) + (add-hook 'after-change-functions + 'org-element--cache-record-change nil t)))))) + +(defsubst org-element--cache-pending-changes-p () + "Non-nil when changes are not integrated in cache yet." + (and org-element--cache-status + (aref org-element--cache-status 0))) + +(defsubst org-element--cache-push-change (beg end offset) + "Push change to current buffer staging area. +BEG and END and the beginning and ending position of the +modification area. OFFSET is the size of the change, as an +integer." + (aset org-element--cache-status 1 beg) + (aset org-element--cache-status 2 end) + (aset org-element--cache-status 3 offset) + (let ((timer (aref org-element--cache-status 4))) + (if timer (timer-activate-when-idle timer t) + (aset org-element--cache-status 4 + (run-with-idle-timer org-element--cache-sync-idle-time + nil + #'org-element--cache-sync + (current-buffer))))) + (aset org-element--cache-status 0 t)) + +(defsubst org-element--cache-cancel-changes () + "Remove any cache change set for current buffer." + (let ((timer (aref org-element--cache-status 4))) + (and timer (cancel-timer timer))) + (aset org-element--cache-status 0 nil)) + +(defsubst org-element--cache-get-key (element) + "Return expected key for ELEMENT in cache." + (let ((begin (org-element-property :begin element))) + (if (and (memq (org-element-type element) '(item table-row)) + (= (org-element-property :contents-begin + (org-element-property :parent element)) + begin)) + ;; Special key for first item (resp. table-row) in a plain + ;; list (resp. table). + (1+ begin) + begin))) + +(defsubst org-element-cache-get (pos &optional type) + "Return data stored at key POS in current buffer cache. +When optional argument TYPE is `element', retrieve the element +starting at POS. When it is `objects', return the list of object +types along with their beginning position within that element. +Otherwise, return the full data. In any case, return nil if no +data is found, or if caching is not allowed." + (when (and org-element-use-cache org-element--cache) + ;; If there are pending changes, first sync them. + (when (org-element--cache-pending-changes-p) + (org-element--cache-sync (current-buffer))) + (let ((data (gethash pos org-element--cache))) + (case type + (element (car data)) + (objects (cdr data)) + (otherwise data))))) + +(defsubst org-element-cache-put (pos data) + "Store data in current buffer's cache, if allowed. +POS is a buffer position, which will be used as a key. DATA is +the value to store. Nothing will be stored if +`org-element-use-cache' is nil. Return DATA in any case." + (if (not org-element-use-cache) data + (unless org-element--cache (org-element-cache-reset)) + (puthash pos data org-element--cache))) + +(defsubst org-element--shift-positions (element offset) + "Shift ELEMENT properties relative to buffer positions by OFFSET. +Properties containing buffer positions are `:begin', `:end', +`:contents-begin', `:contents-end' and `:structure'. They are +modified by side-effect. Return modified element." + (let ((properties (nth 1 element))) + ;; Shift :structure property for the first plain list only: it is + ;; the only one that really matters and it prevents from shifting + ;; it more than once. + (when (eq (car element) 'plain-list) + (let ((structure (plist-get properties :structure))) + (when (<= (plist-get properties :begin) (caar structure)) + (dolist (item structure) + (incf (car item) offset) + (incf (nth 6 item) offset))))) + (plist-put properties :begin (+ (plist-get properties :begin) offset)) + (plist-put properties :end (+ (plist-get properties :end) offset)) + (dolist (key '(:contents-begin :contents-end :post-affiliated)) + (let ((value (plist-get properties key))) + (and value (plist-put properties key (+ offset value)))))) + element) + +(defconst org-element--cache-opening-line + (concat "^[ \t]*\\(?:" + "#\\+BEGIN[:_]" "\\|" + "\\\\begin{[A-Za-z0-9]+\\*?}" "\\|" + ":\\S-+:[ \t]*$" + "\\)") + "Regexp matching an element opening line. +When such a line is modified, modifications may propagate after +modified area. In that situation, every element between that +area and next section is removed from cache.") + +(defconst org-element--cache-closing-line + (concat "^[ \t]*\\(?:" + "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|" + "\\\\end{[A-Za-z0-9]+\\*?}[ \t]*$" "\\|" + ":END:[ \t]*$" + "\\)") + "Regexp matching an element closing line. +When such a line is modified, modifications may propagate before +modified area. In that situation, every element between that +area and previous section is removed from cache.") + +(defun org-element--cache-before-change (beg end) + "Request extension of area going to be modified if needed. +BEG and END are the beginning and end of the range of changed +text. See `before-change-functions' for more information." + (let ((inhibit-quit t)) + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + (let ((top (point)) + (bottom (save-excursion (goto-char end) (line-end-position))) + (sensitive-re + ;; A sensitive line is a headline or a block (or drawer, + ;; or latex-environment) boundary. Inserting one can + ;; modify buffer drastically both above and below that + ;; line, possibly making cache invalid. Therefore, we + ;; need to pay special attention to changes happening to + ;; them. + (concat + "\\(" (org-with-limited-levels org-outline-regexp-bol) "\\)" "\\|" + org-element--cache-closing-line "\\|" + org-element--cache-opening-line))) + (save-match-data + (aset org-element--cache-status 5 + (cond ((not (re-search-forward sensitive-re bottom t)) nil) + ((and (match-beginning 1) + (progn (goto-char bottom) + (or (not (re-search-backward sensitive-re + (match-end 1) t)) + (match-beginning 1)))) + 'headline) + (t 'other)))))))) + +(defun org-element--cache-record-change (beg end pre) + "Update buffer modifications for current buffer. + +BEG and END are the beginning and end of the range of changed +text, and the length in bytes of the pre-change text replaced by +that range. See `after-change-functions' for more information. + +If there are already pending changes, try to merge them into +a bigger change record. If that's not possible, the function +will first synchronize cache with previous change and store the +new one." + (let ((inhibit-quit t)) + (when (and org-element-use-cache org-element--cache) + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + (let ((top (point)) + (bottom (save-excursion (goto-char end) (line-end-position)))) + (org-with-limited-levels + (save-match-data + ;; Determine if modified area needs to be extended, + ;; according to both previous and current state. We make + ;; a special case for headline editing: if a headline is + ;; modified but not removed, do not extend. + (when (let ((previous-state (aref org-element--cache-status 5)) + (sensitive-re + (concat "\\(" org-outline-regexp-bol "\\)" "\\|" + org-element--cache-closing-line "\\|" + org-element--cache-opening-line))) + (cond ((eq previous-state 'other)) + ((not (re-search-forward sensitive-re bottom t)) + (eq previous-state 'headline)) + ((match-beginning 1) + (or (not (eq previous-state 'headline)) + (and (progn (goto-char bottom) + (re-search-backward + sensitive-re (match-end 1) t)) + (not (match-beginning 1))))) + (t))) + ;; Effectively extend modified area. + (setq top (progn (goto-char top) + (outline-previous-heading) + ;; Headline above is inclusive. + (point))) + (setq bottom (progn (goto-char bottom) + (outline-next-heading) + ;; Headline below is exclusive. + (if (eobp) (point) (1- (point)))))))) + ;; Store changes. + (let ((offset (- end beg pre))) + (if (not (org-element--cache-pending-changes-p)) + ;; No pending changes. Store the new ones. + (org-element--cache-push-change top (- bottom offset) offset) + (let* ((current-start (aref org-element--cache-status 1)) + (current-end (+ (aref org-element--cache-status 2) + (aref org-element--cache-status 3))) + (gap (max (- beg current-end) (- current-start end)))) + (if (> gap org-element--cache-merge-changes-threshold) + ;; If we cannot merge two change sets (i.e. they + ;; modify distinct buffer parts) first apply current + ;; change set and store new one. This way, there is + ;; never more than one pending change set, which + ;; avoids handling costly merges. + (progn (org-element--cache-sync (current-buffer)) + (org-element--cache-push-change + top (- bottom offset) offset)) + ;; Change sets can be merged. We can expand the area + ;; that requires an update, and postpone the sync. + (timer-activate-when-idle (aref org-element--cache-status 4) t) + (aset org-element--cache-status 0 t) + (aset org-element--cache-status 1 (min top current-start)) + (aset org-element--cache-status 2 + (- (max current-end bottom) offset)) + (incf (aref org-element--cache-status 3) offset)))))))))) + +(defun org-element--cache-sync (buffer) + "Synchronize cache with recent modification in BUFFER. +Elements ending before modification area are kept in cache. +Elements starting after modification area have their position +shifted by the size of the modification. Every other element is +removed from the cache." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (org-element--cache-pending-changes-p) + (let ((inhibit-quit t) + (beg (aref org-element--cache-status 1)) + (end (aref org-element--cache-status 2)) + (offset (aref org-element--cache-status 3)) + new-keys) + (maphash + #'(lambda (key value) + (cond + ((memq key new-keys)) + ((> key end) + ;; Shift every element starting after END by OFFSET. + ;; We also need to shift keys, since they refer to + ;; buffer positions. + ;; + ;; Upon shifting a key a conflict can occur if the + ;; shifted key also refers to some element in the + ;; cache. In this case, we temporarily associate + ;; both elements, as a cons cell, to the shifted key, + ;; following the pattern (SHIFTED . CURRENT). + ;; + ;; Such a conflict can only occur if shifted key hash + ;; hasn't been processed by `maphash' yet. + (unless (zerop offset) + (let* ((conflictp (consp (caar value))) + (value-to-shift (if conflictp (cdr value) value))) + ;; Shift element part. + (org-element--shift-positions (car value-to-shift) offset) + ;; Shift objects part. + (dolist (object-data (cdr value-to-shift)) + (incf (car object-data) offset) + (dolist (successor (nth 1 object-data)) + (incf (cdr successor) offset)) + (dolist (object (cddr object-data)) + (org-element--shift-positions object offset))) + ;; Shift key-value pair. + (let* ((new-key (+ key offset)) + (new-value (gethash new-key org-element--cache))) + ;; Put new value to shifted key. + ;; + ;; If one already exists, do not overwrite it: + ;; store it as the car of a cons cell instead, + ;; and handle it when `maphash' reaches + ;; NEW-KEY. + ;; + ;; If there is no element stored at NEW-KEY or + ;; if NEW-KEY is going to be removed anyway + ;; (i.e., it is before END), just store new + ;; value there and make sure it will not be + ;; processed again by storing NEW-KEY in + ;; NEW-KEYS. + (puthash new-key + (if (and new-value (> new-key end)) + (cons value-to-shift new-value) + (push new-key new-keys) + value-to-shift) + org-element--cache) + ;; If current value contains two elements, car + ;; should be the new value, since cdr has been + ;; shifted already. + (if conflictp + (puthash key (car value) org-element--cache) + (remhash key org-element--cache)))))) + ;; Remove every element between BEG and END, since + ;; this is where changes happened. + ((>= key beg) (remhash key org-element--cache)) + ;; Preserve any element ending before BEG. If it + ;; overlaps the BEG-END area, remove it. + (t (or (< (org-element-property :end (car value)) beg) + (remhash key org-element--cache))))) + org-element--cache) + ;; Signal cache as up-to-date. + (org-element--cache-cancel-changes)))))) ;;;###autoload (defun org-element-at-point (&optional keep-trail) @@ -4659,96 +5069,124 @@ first element of current section." (if (org-with-limited-levels (org-at-heading-p)) (progn (beginning-of-line) - (if (not keep-trail) (org-element-headline-parser (point-max) t) - (list (org-element-headline-parser (point-max) t)))) + (let ((headline + (or (org-element-cache-get (point) 'element) + (car (org-element-cache-put + (point) + (list (org-element-headline-parser + (point-max) t))))))) + (if keep-trail (list headline) headline))) ;; Otherwise move at the beginning of the section containing ;; point. (catch 'exit - (let ((origin (point)) - (end (save-excursion - (org-with-limited-levels (outline-next-heading)) (point))) - element type special-flag trail struct prevs parent) - (org-with-limited-levels - (if (org-before-first-heading-p) - ;; In empty lines at buffer's beginning, return nil. - (progn (goto-char (point-min)) - (org-skip-whitespace) - (when (or (eobp) (> (line-beginning-position) origin)) - (throw 'exit nil))) - (org-back-to-heading) - (forward-line) - (org-skip-whitespace) - (when (or (eobp) (> (line-beginning-position) origin)) - ;; In blank lines just after the headline, point still - ;; belongs to the headline. - (throw 'exit - (progn (skip-chars-backward " \r\t\n") - (beginning-of-line) - (if (not keep-trail) - (org-element-headline-parser (point-max) t) - (list (org-element-headline-parser - (point-max) t)))))))) + (let ((origin (point))) + (if (not (org-with-limited-levels (outline-previous-heading))) + ;; In empty lines at buffer's beginning, return nil. + (progn (goto-char (point-min)) + (org-skip-whitespace) + (when (or (eobp) (> (line-beginning-position) origin)) + (throw 'exit nil))) + (forward-line) + (org-skip-whitespace) + (when (or (eobp) (> (line-beginning-position) origin)) + ;; In blank lines just after the headline, point still + ;; belongs to the headline. + (throw 'exit + (progn + (skip-chars-backward " \r\t\n") + (beginning-of-line) + (let ((headline + (or (org-element-cache-get (point) 'element) + (car (org-element-cache-put + (point) + (list (org-element-headline-parser + (point-max) t))))))) + (if keep-trail (list headline) headline)))))) (beginning-of-line) - ;; Parse successively each element, skipping those ending - ;; before original position. - (while t - (setq element - (org-element--current-element end 'element special-flag struct) - type (car element)) - (org-element-put-property element :parent parent) - (when keep-trail (push element trail)) - (cond - ;; 1. Skip any element ending before point. Also skip - ;; element ending at point when we're sure that another - ;; element has started. - ((let ((elem-end (org-element-property :end element))) - (when (or (< elem-end origin) - (and (= elem-end origin) (/= elem-end end))) - (goto-char elem-end)))) - ;; 2. An element containing point is always the element at - ;; point. - ((not (memq type org-element-greater-elements)) - (throw 'exit (if keep-trail trail element))) - ;; 3. At any other greater element type, if point is - ;; within contents, move into it. - (t - (let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) - ;; Create an anchor for tables and plain lists: - ;; when point is at the very beginning of these - ;; elements, ignoring affiliated keywords, - ;; target them instead of their contents. - (and (= cbeg origin) (memq type '(plain-list table))) - ;; When point is at contents end, do not move - ;; into elements with an explicit ending, but - ;; return that element instead. - (and (= cend origin) - (or (memq type - '(center-block - drawer dynamic-block inlinetask - property-drawer quote-block - special-block)) - ;; Corner case: if a list ends at the - ;; end of a buffer without a final new - ;; line, return last element in last - ;; item instead. - (and (memq type '(item plain-list)) - (progn (goto-char cend) - (or (bolp) (not (eobp)))))))) - (throw 'exit (if keep-trail trail element)) - (setq parent element) - (case type - (plain-list - (setq special-flag 'item - struct (org-element-property :structure element))) - (item (setq special-flag nil)) - (property-drawer - (setq special-flag 'node-property struct nil)) - (table (setq special-flag 'table-row struct nil)) - (otherwise (setq special-flag nil struct nil))) - (setq end cend) - (goto-char cbeg))))))))))) + (let ((end (save-excursion + (org-with-limited-levels (outline-next-heading)) (point))) + element type special-flag trail struct parent) + ;; Parse successively each element, skipping those ending + ;; before original position. + (while t + (setq element + (let* ((pos (if (and (memq special-flag '(item table-row)) + (memq type '(plain-list table))) + ;; First item (resp. row) in plain + ;; list (resp. table) gets + ;; a special key in cache. + (1+ (point)) + (point))) + (cached (org-element-cache-get pos 'element))) + (cond + ((not cached) + (let ((element (org-element--current-element + end 'element special-flag struct))) + (when (derived-mode-p 'org-mode) + (org-element-cache-put pos (cons element nil))) + element)) + ;; When changes happened in the middle of a list, + ;; its structure ends up being invalid. + ;; Therefore, we make sure to use a valid one. + ((and struct (memq (car cached) '(item plain-list))) + (org-element-put-property cached :structure struct)) + (t cached)))) + (setq type (org-element-type element)) + (org-element-put-property element :parent parent) + (when keep-trail (push element trail)) + (cond + ;; 1. Skip any element ending before point. Also skip + ;; element ending at point when we're sure that + ;; another element has started. + ((let ((elem-end (org-element-property :end element))) + (when (or (< elem-end origin) + (and (= elem-end origin) (/= elem-end end))) + (goto-char elem-end)))) + ;; 2. An element containing point is always the element at + ;; point. + ((not (memq type org-element-greater-elements)) + (throw 'exit (if keep-trail trail element))) + ;; 3. At any other greater element type, if point is + ;; within contents, move into it. + (t + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) + ;; Create an anchor for tables and plain + ;; lists: when point is at the very beginning + ;; of these elements, ignoring affiliated + ;; keywords, target them instead of their + ;; contents. + (and (= cbeg origin) (memq type '(plain-list table))) + ;; When point is at contents end, do not move + ;; into elements with an explicit ending, but + ;; return that element instead. + (and (= cend origin) + (or (memq type + '(center-block + drawer dynamic-block inlinetask + property-drawer quote-block + special-block)) + ;; Corner case: if a list ends at + ;; the end of a buffer without + ;; a final new line, return last + ;; element in last item instead. + (and (memq type '(item plain-list)) + (progn (goto-char cend) + (or (bolp) (not (eobp)))))))) + (throw 'exit (if keep-trail trail element)) + (setq parent element) + (case type + (plain-list + (setq special-flag 'item + struct (org-element-property :structure element))) + (item (setq special-flag nil)) + (property-drawer + (setq special-flag 'node-property struct nil)) + (table (setq special-flag 'table-row struct nil)) + (otherwise (setq special-flag nil struct nil))) + (setq end cend) + (goto-char cbeg)))))))))))) ;;;###autoload (defun org-element-context (&optional element) @@ -4770,11 +5208,10 @@ Providing it allows for quicker computation." (org-with-wide-buffer (let* ((origin (point)) (element (or element (org-element-at-point))) - (type (org-element-type element)) - context) - ;; Check if point is inside an element containing objects or at - ;; a secondary string. In that case, narrow buffer to the - ;; containing area. Otherwise, return ELEMENT. + (type (org-element-type element))) + ;; If point is inside an element containing objects or + ;; a secondary string, narrow buffer to the container and + ;; proceed with parsing. Otherwise, return ELEMENT. (cond ;; At a parsed affiliated keyword, check if we're inside main ;; or dual value. @@ -4804,8 +5241,7 @@ Providing it allows for quicker computation." (if (and (>= origin (point)) (< origin (match-end 0))) (narrow-to-region (point) (match-end 0)) (throw 'objects-forbidden element))))) - ;; At an headline or inlinetask, objects are located within - ;; their title. + ;; At an headline or inlinetask, objects are in title. ((memq type '(headline inlinetask)) (goto-char (org-element-property :begin element)) (skip-chars-forward "* ") @@ -4831,44 +5267,92 @@ Providing it allows for quicker computation." (if (and (>= origin (point)) (< origin (line-end-position))) (narrow-to-region (point) (line-end-position)) (throw 'objects-forbidden element)))) + ;; All other locations cannot contain objects: bail out. (t (throw 'objects-forbidden element))) (goto-char (point-min)) - (let ((restriction (org-element-restriction type)) - (parent element) - (candidates 'initial)) - (catch 'exit - (while (setq candidates - (org-element--get-next-object-candidates - restriction candidates)) - (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) - candidates))) - ;; If ORIGIN is before next object in element, there's - ;; no point in looking further. - (if (> (cdr closest-cand) origin) (throw 'exit parent) - (let* ((object - (progn (goto-char (cdr closest-cand)) - (funcall (intern (format "org-element-%s-parser" - (car closest-cand)))))) - (cbeg (org-element-property :contents-begin object)) - (cend (org-element-property :contents-end object)) - (obj-end (org-element-property :end object))) - (cond - ;; ORIGIN is after OBJECT, so skip it. - ((<= obj-end origin) (goto-char obj-end)) - ;; ORIGIN is within a non-recursive object or at - ;; an object boundaries: Return that object. - ((or (not cbeg) (< origin cbeg) (>= origin cend)) - (throw 'exit - (org-element-put-property object :parent parent))) - ;; Otherwise, move within current object and - ;; restrict search to the end of its contents. - (t (goto-char cbeg) - (narrow-to-region (point) cend) - (org-element-put-property object :parent parent) - (setq parent object - restriction (org-element-restriction object) - candidates 'initial))))))) - parent)))))) + (let* ((restriction (org-element-restriction type)) + (parent element) + (candidates 'initial) + (cache-key (org-element--cache-get-key element)) + (cache (org-element-cache-get cache-key 'objects)) + objects-data next update-cache-flag) + (prog1 + (catch 'exit + (while t + ;; Get list of next object candidates in CANDIDATES. + ;; When entering for the first time PARENT, grab it + ;; from cache, if available, or compute it. Then, + ;; for each subsequent iteration in PARENT, always + ;; compute it since we're beyond cache anyway. + (when (and (not next) org-element-use-cache) + (let ((data (assq (point) cache))) + (if data (setq candidates (nth 1 (setq objects-data data))) + (push (setq objects-data (list (point) 'initial)) + cache)))) + (when (or next (eq 'initial candidates)) + (setq candidates + (org-element--get-next-object-candidates + restriction candidates)) + (when org-element-use-cache + (setcar (cdr objects-data) candidates) + (or update-cache-flag (setq update-cache-flag t)))) + ;; Compare ORIGIN with next object starting position, + ;; if any. + ;; + ;; If ORIGIN is lesser or if there is no object + ;; following, look for a previous object that might + ;; contain it in cache. If there is no cache, we + ;; didn't miss any object so simply return PARENT. + ;; + ;; If ORIGIN is greater or equal, parse next + ;; candidate for further processing. + (let ((closest + (and candidates + (rassq (apply #'min (mapcar #'cdr candidates)) + candidates)))) + (if (or (not closest) (> (cdr closest) origin)) + (catch 'found + (dolist (obj (cddr objects-data) (throw 'exit parent)) + (when (<= (org-element-property :begin obj) origin) + (if (<= (org-element-property :end obj) origin) + ;; Object ends before ORIGIN and we + ;; know next one in cache starts + ;; after it: bail out. + (throw 'exit parent) + (throw 'found (setq next obj)))))) + (goto-char (cdr closest)) + (setq next + (funcall (intern (format "org-element-%s-parser" + (car closest))))) + (when org-element-use-cache + (push next (cddr objects-data)) + (or update-cache-flag (setq update-cache-flag t))))) + ;; Process NEXT to know if we need to skip it, return + ;; it or move into it. + (let ((cbeg (org-element-property :contents-begin next)) + (cend (org-element-property :contents-end next)) + (obj-end (org-element-property :end next))) + (cond + ;; ORIGIN is after NEXT, so skip it. + ((<= obj-end origin) (goto-char obj-end)) + ;; ORIGIN is within a non-recursive next or + ;; at an object boundaries: Return that object. + ((or (not cbeg) (< origin cbeg) (>= origin cend)) + (throw 'exit + (org-element-put-property next :parent parent))) + ;; Otherwise, move into NEXT and reset flags as we + ;; shift parent. + (t (goto-char cbeg) + (narrow-to-region (point) cend) + (org-element-put-property next :parent parent) + (setq parent next + restriction (org-element-restriction next) + next nil + objects-data nil + candidates 'initial)))))) + ;; Update cache if required. + (when (and update-cache-flag (derived-mode-p 'org-mode)) + (org-element-cache-put cache-key (cons element cache))))))))) (defun org-element-nested-p (elem-A elem-B) "Non-nil when elements ELEM-A and ELEM-B are nested." diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index 3c0d97c3a..c59bd0c99 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -106,8 +106,15 @@ the notes. However, by hand you may place definitions *anywhere*. If this is a string, during export, all subtrees starting with -this heading will be ignored." +this heading will be ignored. + +If you don't use the customize interface to change this variable, +you will need to run the following command after the change: + + \\[universal-argument] \\[org-element-cache-reset]" :group 'org-footnote + :initialize 'custom-initialize-set + :set (lambda (var val) (set var val) (org-element-cache-reset 'all)) :type '(choice (string :tag "Collect footnotes under heading") (const :tag "Define footnotes locally" nil))) diff --git a/lisp/org.el b/lisp/org.el index ac6f739e5..15323bab4 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -140,6 +140,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-element--parse-objects "org-element" (beg end acc restriction)) (declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-cache-reset "org-element" (&optional all)) (declare-function org-element-contents "org-element" (element)) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-interpret-data "org-element" @@ -357,7 +358,8 @@ When MESSAGE is non-nil, display a message with the version." "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." (set var value) (when (featurep 'org) - (org-load-modules-maybe 'force))) + (org-load-modules-maybe 'force) + (org-element-cache-reset 'all))) (defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) "Modules that should always be loaded together with org.el. @@ -5367,6 +5369,8 @@ The following commands are available: (org-setup-filling) ;; Comments. (org-setup-comments-handling) + ;; Initialize cache. + (org-element-cache-reset) ;; Beginning/end of defun (org-set-local 'beginning-of-defun-function 'org-backward-element) (org-set-local 'end-of-defun-function 'org-forward-element) diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 3d31ef474..1a46d7e85 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -847,25 +847,29 @@ Some other text (ert-deftest test-org-element/headline-archive-tag () "Test ARCHIVE tag recognition." ;; Reference test. - (org-test-with-temp-text "* Headline" - (let ((org-archive-tag "ARCHIVE")) - (should-not (org-element-property :archivedp (org-element-at-point))))) + (should-not + (org-test-with-temp-text "* Headline" + (let ((org-archive-tag "ARCHIVE")) + (org-element-property :archivedp (org-element-at-point))))) ;; Single tag. (org-test-with-temp-text "* Headline :ARCHIVE:" (let ((org-archive-tag "ARCHIVE")) (let ((headline (org-element-at-point))) (should (org-element-property :archivedp headline)) ;; Test tag removal. - (should-not (org-element-property :tags headline)))) - (let ((org-archive-tag "Archive")) - (should-not (org-element-property :archivedp (org-element-at-point))))) + (should-not (org-element-property :tags headline))))) ;; Multiple tags. (org-test-with-temp-text "* Headline :test:ARCHIVE:" (let ((org-archive-tag "ARCHIVE")) (let ((headline (org-element-at-point))) (should (org-element-property :archivedp headline)) ;; Test tag removal. - (should (equal (org-element-property :tags headline) '("test"))))))) + (should (equal (org-element-property :tags headline) '("test")))))) + ;; Tag is case-sensitive. + (should-not + (org-test-with-temp-text "* Headline :ARCHIVE:" + (let ((org-archive-tag "Archive")) + (org-element-property :archivedp (org-element-at-point)))))) (ert-deftest test-org-element/headline-properties () "Test properties from property drawer." From d61ce8edd116cb9c1c1de378cd3420f748251961 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 3 Nov 2013 14:18:19 +0100 Subject: [PATCH 037/166] Fix flyspell behaviour on verbatim objects * lisp/org.el (org-do-emphasis-faces): Look for verbatim status at correct location. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 5e1f19508..e750ba036 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5704,7 +5704,7 @@ The time stamps may be either active or inactive.") (font-lock-prepend-text-property (match-beginning 2) (match-end 2) 'face (nth 1 a)) - (and (nth 4 a) + (and (nth 2 a) (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0))) (add-text-properties (match-beginning 2) (match-end 2) From 757f00811d0bdf1e17562eeb4331d872d720f136 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 3 Nov 2013 17:47:55 +0100 Subject: [PATCH 038/166] org-element: Fix error when parsing lowercase keywords * lisp/org-element.el (org-element-context): Fix error when parsing affiliated keywords, e.g. "caption". * testing/lisp/test-org-element.el: Add test. --- lisp/org-element.el | 5 +++-- testing/lisp/test-org-element.el | 5 +++++ 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 873c4bb76..c148cacfa 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4856,9 +4856,10 @@ Providing it allows for quicker computation." ((let ((post (org-element-property :post-affiliated element))) (and post (< origin post))) (beginning-of-line) - (looking-at org-element--affiliated-re) + (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) (cond - ((not (member (upcase (match-string 1)) org-element-parsed-keywords)) + ((not (member-ignore-case (match-string 1) + org-element-parsed-keywords)) (throw 'objects-forbidden element)) ((< (match-end 0) origin) (narrow-to-region (match-end 0) (line-end-position))) diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index ffa01c7ab..12372885f 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -2961,6 +2961,11 @@ Paragraph \\alpha." (org-test-with-temp-text "#+CAPTION: {{{macro}}}\n| a | b |." (progn (search-forward "{") (org-element-type (org-element-context)))))) + (should + (eq 'bold + (org-test-with-temp-text "#+caption: *bold*\nParagraph" + (progn (search-forward "*") + (org-element-type (org-element-context)))))) ;; Correctly set `:parent' property. (should (eq 'paragraph From dbc39fcef501b4f308a1217e3177fbe5d602840c Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 4 Nov 2013 11:30:34 +0100 Subject: [PATCH 039/166] ob-clojure.el: Add support for the cider backend * ob-clojure.el (org-babel-clojure-backend): Add customization options. (org-babel-execute:clojure): Add support for cider. --- lisp/ob-clojure.el | 85 +++++++++++++++++++++++++++------------------- 1 file changed, 50 insertions(+), 35 deletions(-) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index 255fe8d31..d797a3f76 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -24,30 +24,37 @@ ;;; Commentary: -;;; support for evaluating clojure code, relies either on slime or -;;; on nrepl for all eval +;; Support for evaluating clojure code, relies either on Slime or +;; on Nrepl.el for all eval. -;;; Requirements: +;; Requirements: -;;; - clojure (at least 1.2.0) -;;; - clojure-mode -;;; - either slime or nrepl +;; - clojure (at least 1.2.0) +;; - clojure-mode +;; - either cider or nrepl.el or SLIME -;;; For SLIME-way, the best way to install these components is by -;;; following the directions as set out by Phil Hagelberg (Technomancy) -;;; on the web page: http://technomancy.us/126 +;; For cider, see https://github.com/clojure-emacs/cider -;;; For nREPL-way: -;;; get clojure is with https://github.com/technomancy/leiningen -;;; get nrepl from MELPA (clojure-mode is a dependency). +;; For SLIME, the best way to install these components is by following +;; the directions as set out by Phil Hagelberg (Technomancy) on the +;; web page: http://technomancy.us/126 + +;; For nREPL: +;; get clojure with https://github.com/technomancy/leiningen +;; get nrepl from MELPA (clojure-mode is a dependency). ;;; Code: (require 'ob) -(declare-function slime-eval "ext:slime" (sexp &optional package)) +(declare-function cider-current-ns "ext:cider-interaction" ()) +(declare-function nrepl-send-string-sync "ext:nrepl-client" (input &optional ns session)) +(declare-function nrepl-current-tooling-session "ext:nrepl-client" ()) + (declare-function nrepl-current-connection-buffer "ext:nrepl" ()) (declare-function nrepl-eval "ext:nrepl" (body)) +(declare-function slime-eval "ext:slime" (sexp &optional package)) + (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) @@ -57,7 +64,10 @@ (defcustom org-babel-clojure-backend 'nrepl "Backend used to evaluate Clojure code blocks." :group 'org-babel - :type 'symbol) + :type '(choice + (const :tag "cider" cider) + (const :tag "nrepl" nrepl) + (const :tag "SLIME" slime))) (defun org-babel-expand-body:clojure (body params) "Expand BODY according to PARAMS, return the expanded body." @@ -88,31 +98,36 @@ "Execute a block of Clojure code with Babel." (let ((expanded (org-babel-expand-body:clojure body params))) (case org-babel-clojure-backend - (slime - (require 'slime) - (with-temp-buffer - (insert expanded) - ((lambda (result) - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - result - (condition-case nil (org-babel-script-escape result) - (error result))))) - (slime-eval - `(swank:eval-and-grab-output - ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assoc :package params)))))) + (cider + (require 'cider) + (or (nth 1 (nrepl-send-string-sync + (format "(clojure.pprint/pprint %s)" expanded) + (cider-current-ns) + (nrepl-current-tooling-session))) + (error "nREPL not connected! Use M-x cider-jack-in RET"))) (nrepl (require 'nrepl) (if (nrepl-current-connection-buffer) - (let* ((result (nrepl-eval expanded)) - (s (plist-get result :stdout)) - (r (plist-get result :value))) - (if s (concat s "\n" r) r)) - (error "nREPL not connected! Use M-x nrepl-jack-in.")))))) + (let* ((result (nrepl-eval expanded)) + (s (plist-get result :stdout)) + (r (plist-get result :value))) + (if s (concat s "\n" r) r)) + (error "nREPL not connected! Use M-x nrepl-jack-in RET"))) + (slime + (require 'slime) + (with-temp-buffer + (insert expanded) + ((lambda (result) + (let ((result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + result + (condition-case nil (org-babel-script-escape result) + (error result))))) + (slime-eval + `(swank:eval-and-grab-output + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assoc :package params))))))))) (provide 'ob-clojure) - - ;;; ob-clojure.el ends here From d586ef111a3dd2608073e3ea558cb4c0db2aefe4 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 4 Nov 2013 11:54:40 +0100 Subject: [PATCH 040/166] Rename org-favtable.el to org-index.el As requested by Marc Ihm. --- contrib/lisp/org-favtable.el | 1701 ----------------------------- contrib/lisp/org-index.el | 1944 ++++++++++++++++++++++++++++++++++ 2 files changed, 1944 insertions(+), 1701 deletions(-) delete mode 100755 contrib/lisp/org-favtable.el create mode 100644 contrib/lisp/org-index.el diff --git a/contrib/lisp/org-favtable.el b/contrib/lisp/org-favtable.el deleted file mode 100755 index 51f75a5a4..000000000 --- a/contrib/lisp/org-favtable.el +++ /dev/null @@ -1,1701 +0,0 @@ -;;; org-favtable.el --- Lookup table of favorite references and links - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Marc-Oliver Ihm -;; Keywords: hypermedia, matching -;; Requires: org -;; Download: http://orgmode.org/worg/code/elisp/org-favtable.el -;; Version: 2.2.0 - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Purpose: -;; -;; Mark and find your favorite things and locations in org easily: Create -;; and update a lookup table of your references and links. Often used -;; entries bubble to the top and entering some keywords displays only the -;; matching entries. That way the right entry one can be picked easily. -;; -;; References are essentially small numbers (e.g. "R237" or "-455-"), -;; which are created by this package; they are well suited to be used -;; outside of org. Links are just normal org-mode links. -;; -;; -;; Setup: -;; -;; - Add these lines to your .emacs: -;; -;; (require 'org-favtable) -;; ;; Good enough to start, but later you should probably -;; ;; change this id, as will be explained below -;; (setq org-favtable-id "00e26bef-1929-4110-b8b4-7eb9c9ab1fd4") -;; ;; Optionally assign a key. Pick your own favorite. -;; (global-set-key (kbd "C-+") 'org-favtable) -;; -;; - Just invoke `org-favtable', which will explain how to complete your -;; setup by creating the necessary table of favorites. -;; -;; -;; Further reading: -;; -;; Invoke `org-favtable' and pick one of its help options. You may also -;; read the documentation of `org-favtable-id' for setup instructions, of -;; `org-favtable' for regular usage and of `org-favtable--commands' for a -;; list of available commands. -;; - -;;; Change Log: - -;; [2013-02-28 Th] Version 2.2.0: -;; - Allowed shortcuts like "h237" for command "head" with argument "237" -;; - Integrated with org-mark-ring-goto -;; -;; [2013-01-25 Fr] Version 2.1.0: -;; - Added full support for links -;; - New commands "missing" and "statistics" -;; - Renamed the package from "org-reftable" to "org-favtable" -;; - Additional columns are required (e.g. "link"). Error messages will -;; guide you -;; -;; [2012-12-07 Fr] Version 2.0.0: -;; - The format of the table of favorites has changed ! You need to bring -;; your existing table into the new format by hand (which however is -;; easy and explained below) -;; - Reference table can be sorted after usage count or date of last access -;; - Ask user explicitly, which command to invoke -;; - Renamed the package from "org-refer-by-number" to "org-reftable" - -;; [2012-09-22 Sa] Version 1.5.0: -;; - New command "sort" to sort a buffer or region by reference number -;; - New commands "highlight" and "unhighlight" to mark references - -;; [2012-07-13 Fr] Version 1.4.0: -;; - New command "head" to find a headline with a reference number - -;; [2012-04-28 Sa] Version 1.3.0: -;; - New commands occur and multi-occur -;; - All commands can now be invoked explicitly -;; - New documentation -;; - Many bugfixes - -;; [2011-12-10 Sa] Version 1.2.0: -;; - Fixed a bug, which lead to a loss of newly created reference numbers -;; - Introduced single and double prefix arguments -;; - Started this Change Log - -;;; Code: - -(require 'org-table) -(require 'cl) - -(defvar org-favtable--version "2.2.0") -(defvar org-favtable--preferred-command nil) - -(defvar org-favtable--commands '(occur head ref link enter leave goto + help reorder fill sort update highlight unhighlight missing statistics) - "List of commands known to org-favtable: - -Commands known: - - occur: If you supply a keyword (text): Apply emacs standard - occur operation on the table of favorites; ask for a - string (keyword) to select lines. Occur will only show you - lines which contain the given keyword, so you can easily find - the right one. You may supply a list of words seperated by - comma (\",\"), to select lines that contain any or all of the - given words. - - If you supply a reference number: Apply emacs standard - multi-occur operation all org-mode buffers to search for a - specific reference. - - You may also read the note at the end of this help on saving - the keystroke RET to accept this frequent default command. - - head: If invoked outside the table of favorites, ask for a - reference number and search for a heading containing it. If - invoked within favtable dont ask; rather use the reference or - link from the current line. - - ref: Create a new reference, copy any previously selected text. - If already within reftable, fill in ref-column. - - link: Create a new line in reftable with a link to the current node. - Do not populate the ref column; this can later be populated by - calling the \"fill\" command from within the reftable. - - leave: Leave the table of favorites. If the last command has - been \"ref\", the new reference is copied and ready to yank. - This \"org-mark-ring-goto\" and can be called several times - in succession. - - enter: Just enter the node with the table of favorites. - - goto: Search for a specific reference within the table of - favorites. - - help: Show this list of commands. - - +: Show all commands including the less frequently used ones - given below. If \"+\" is followd by enough letters of such a - command (e.g. \"+fi\"), then this command is invoked - directly. - - reorder: Temporarily reorder the table of favorites, e.g. by - count, reference or last access. - - fill: If either ref or link is missing, fill it. - - sort: Sort a set of lines (either the active region or the - whole buffer) by the references found in each line. - - update: For the given reference, update the line in the - favtable. - - highlight: Highlight references in region or buffer. - - unhighlight: Remove highlights. - - missing : Search for missing reference numbers (which do not - appear in the reference table). If requested, add additional - lines for them, so that the command \"new\" is able to reuse - them. - - statistics : Show some statistics (e.g. minimum and maximum - reference) about favtable. - - - -Two ways to save keystrokes: - -When prompting for a command, org-favtable puts the most likely -one (e.g. \"occur\" or \"ref\") at the front of the list, so that -you may just type RET. - -If this command needs additional input (like e.g. \"occur\"), you -may supply this input right away, although you are still beeing -prompted for the command. So do an occur for the string \"foo\", -you can just enter \"foo\" without even entering \"occur\". - - -Another way to save keystrokes applies if you want to choose a -command, that requrires a reference number (and would normally -prompt for it): In that case you may just enter enough characters -from your command, so that it appears first in the list of -matches; then immediately enter the number of the reference you -are searching for. So the input \"h237\" would execute the -command \"head\" for reference \"237\" right away. - -") - -(defvar org-favtable--commands-some '(occur head ref link leave enter goto + help)) - -(defvar org-favtable--columns nil) - -(defvar org-favtable-id nil - "Id of the Org-mode node, which contains the favorite table. - -Read below, on how to set up things. See the help options -\"usage\" and \"commands\" for normal usage after setup. - -Setup requires two steps: - - - Adjust your .emacs initialization file - - - Create a suitable org-mode node - - -Here are the lines, you need to add to your .emacs: - - (require 'org-favtable) - ;; Good enough to start, but later you should probably - ;; change this id, as will be explained below - (setq org-favtable-id \"00e26bef-1929-4110-b8b4-7eb9c9ab1fd4\") - ;; Optionally assign a key. Pick your own favorite. - (global-set-key (kbd \"C-+\") 'org-favtable) - -Do not forget to restart emacs to make these lines effective. - - -As a second step you need to create the org-mode node, where your -reference numbers and links will be stored. It may look like -this: - - * org-favtable - :PROPERTIES: - :ID: 00e26bef-1929-4110-b8b4-7eb9c9ab1fd4 - :END: - - - | | | Comment, description, details | | | | - | ref | link | ;c | count;s | created | last-accessed | - | | <4> | <30> | | | | - |-----+------+--------------------------------+---------+---------+---------------| - | R1 | | My first reference | | | | - - -You may just copy this node into one of your org-files. Many -things however can or should be adjusted: - - - The node needs not be a top level node. - - - Its name is completely at you choice. The node is found - through its ID. - - - There are three lines of headings above the first hline. The - first one is ignored by org-favtable, and you can use them to - give meaningful names to columns; the second line contains - configuration information for org-favtable; please read - further below for its format. The third line is optional and - may contain width-informations (e.g. <30>) only. - - - The sequence of columns does not matter. You may reorder them - any way you like; e.g. make the comment-column the last - columns within the table. Columns ar found by their name, - which appears in the second heading-line. - - - You can add further columns or even remove the - \"Comment\"-column. All other columns from the - example (e.g. \"ref\", \"link\", \"count\", \"created\" and - \"last-accessed\") are required. - - - Your references need not start at \"R1\"; However, having an - initial row is required (it serves as a template for subsequent - references). - - - Your reference need not have the form \"R1\"; you may just as - well choose any text, that contains a single number, - e.g. \"reference-{1}\" or \"#7\" or \"++17++\" or \"-344-\". The - function `org-favtable' will inspect your first reference and - create all subsequent references in the same way. - - - You may want to change the ID-Property of the node above and - create a new one, which is unique (and not just a copy of - mine). You need to change it in the lines copied to your .emacs - too. However, this is not strictly required to make things - work, so you may do this later, after trying out this package. - - -Optionally you may tweak the second header line to adjust -`org-favtable' a bit. In the example above it looks like this - (with spaces collapsed): - - - | ref | link | ;c | count;s | created | last-accessed | - - -The different fields have different meanings: - - - ref : This denotes the column which contains you references - - - link : Column for org-mode links, which can be used to access - locations within your files. - - - ;c : The flag \"c\" (\"c\" for \"copy\") denotes this column - as the one beeing copied on command \"leave\". In the example - above, it is also the comment-column. - - - count;s : this is the column which counts, how many time this - line has been accessed (which is the key-feature of this - package). The flag \"s\" stands for \"sort\", so the table is - sorted after this column. You may also sort after columns - \"ref\" or \"last-accessed\". - - - created : Date when this line was created. - - - last-accessed : Date and time, when this line was last accessed. - - -After this two-step setup process you may invoke `org-favtable' -to create a new favorite. Read the help option \"usage\" for -instructions on normal usage, read the help option \"commands\" -for help on single commands. - -") - - -(defvar org-favtable--text-to-yank nil) -(defvar org-favtable--last-action nil) -(defvar org-favtable--occur-buffer nil) -(defvar org-favtable--ref-regex nil) -(defvar org-favtable--ref-format nil) - - - -(defun org-favtable (&optional what search search-is-link) - "Mark and find your favorite items and org-locations easily: -Create and update a lookup table of your favorite references and -links. Often used entries automatically bubble to the top of the -table; entering some keywords narrows it to just the matching -entries; that way the right one can be picked easily. - -References are essentially small numbers (e.g. \"R237\" or -\"-455-\"), as created by this package; links are normal org-mode -links. Within org-favtable, both are denoted as favorites. - - -Read below for a detailed description of this function. See the -help option \"setup\" or read the documentation of -`org-favtable-id' for setup instructions. - -The function `org-favtable' operates on a dedicated table (called -the table or favorites or favtable, for short) within a special -Org-mode node. The node has to be created as part of your initial -setup. Each line of the favorite table contains: - - - A reference (optional) - - - A link (optional) - - - A number; counting, how often each reference has been - used. This number is updated automatically and the table can - be sorted according to it, so that most frequently used - references appear at the top of the table and can be spotted - easily. - - - Its respective creation date - - - Date and time of last access. This column can alternatively be - used to sort the table. - -To be useful, your table of favorites should probably contain a -column with comments too, which allows lines to be selected by -keywords. - -The table of favorites is found through the id of the containing -node; this id should be stored within `org-favtable-id' (see there -for details). - - -The function `org-favtable' is the only interactive function of -this package and its sole entry point; it offers several commands -to create, find and look up these favorites (references and -links). All of them are explained within org-favtable's help. - - -Finally, org-favtable can also be invoked from elisp; the two -optional arguments accepted are: - - search : string to search for - what : symbol of the command to invoke - search-is-link : t, if argument search is actually a link - -An example would be: - - (org-favtable \"237\" 'head) ;; find heading with ref 237 - -" - - (interactive "P") - - (let (within-node ; True, if we are within node with favtable - result-is-visible ; True, if node or occur is visible in any window - ref-node-buffer-and-point ; cons with buffer and point of favorites node - below-cursor ; word below cursor - active-region ; active region (if any) - link-id ; link of starting node, if required - guarded-search ; with guard against additional digits - search-is-ref ; true, if search is a reference - commands ; currently active set of selectable commands - what-adjusted ; True, if we had to adjust what - what-input ; Input on what question (need not necessary be "what") - reorder-once ; Column to use for single time sorting - parts ; Parts of a typical reference number (which - ; need not be a plain number); these are: - head ; Any header before number (e.g. "R") - maxref ; Maximum number from reference table (e.g. "153") - tail ; Tail after number (e.g. "}" or "") - ref-regex ; Regular expression to match a reference - has-reuse ; True, if table contains a line for reuse - numcols ; Number of columns in favtable - kill-new-text ; Text that will be appended to kill ring - message-text ; Text that will be issued as an explanation, - ; what we have done - initial-ref-or-link ; Initial position in reftable - ) - - ;; - ;; Examine current buffer and location, before turning to favtable - ;; - - ;; Get the content of the active region or the word under cursor - (if (and transient-mark-mode - mark-active) - (setq active-region (buffer-substring (region-beginning) (region-end)))) - (setq below-cursor (thing-at-point 'symbol)) - - - ;; Find out, if we are within favable or not - (setq within-node (string= (org-id-get) org-favtable-id)) - - ;; Find out, if point in any window is within node with favtable - (mapc (lambda (x) (with-current-buffer (window-buffer x) - (when (or - (string= (org-id-get) org-favtable-id) - (eq (window-buffer x) - org-favtable--occur-buffer)) - (setq result-is-visible t)))) - (window-list)) - - - - ;; - ;; Get decoration of references and highest reference from favtable - ;; - - - ;; Save initial ref or link - (if (and within-node - (org-at-table-p)) - (setq initial-ref-or-link - (or (org-favtable--get-field 'ref) - (org-favtable--get-field 'link)))) - - ;; Find node - (setq ref-node-buffer-and-point (org-favtable--id-find)) - (unless ref-node-buffer-and-point - (org-favtable--report-setup-error - (format "Cannot find node with id \"%s\"" org-favtable-id))) - - ;; Get configuration of reftable; catch errors - (let ((error-message - (catch 'content-error - - (with-current-buffer (car ref-node-buffer-and-point) - (save-excursion - (unless (string= (org-id-get) org-favtable-id) - (goto-char (cdr ref-node-buffer-and-point))) - - ;; parse table while still within buffer - (setq parts (org-favtable--parse-and-adjust-table))) - - nil)))) - (when error-message - (org-pop-to-buffer-same-window (car ref-node-buffer-and-point)) - (org-reveal) - (error error-message))) - - ;; Give names to parts of configuration - (setq head (nth 0 parts)) - (setq maxref (nth 1 parts)) - (setq tail (nth 2 parts)) - (setq numcols (nth 3 parts)) - (setq ref-regex (nth 4 parts)) - (setq has-reuse (nth 5 parts)) - (setq org-favtable--ref-regex ref-regex) - (setq org-favtable--ref-format (concat head "%d" tail)) - - ;; - ;; Find out, what we are supposed to do - ;; - - (if (equal what '(4)) (setq what 'leave)) - - ;; Set preferred action, that will be the default choice - (setq org-favtable--preferred-command - (if within-node - (if (memq org-favtable--last-action '(ref link)) - 'leave - 'occur) - (if active-region - 'ref - (if (and below-cursor (string-match ref-regex below-cursor)) - 'occur - nil)))) - - ;; Ask user, what to do - (unless what - (setq commands (copy-list org-favtable--commands-some)) - (while (progn - (setq what-input - (org-icompleting-read - "Please choose: " - (mapcar 'symbol-name - ;; Construct unique list of commands with - ;; preferred one at front - (delq nil (delete-dups - (append - (list org-favtable--preferred-command) - commands)))) - nil nil)) - - - ;; if input starts with "+", any command (not only some) may follow - ;; this allows input like "+sort" to be accepted - (when (string= (substring what-input 0 1) "+") - ;; make all commands available for selection - (setq commands (copy-list org-favtable--commands)) - (unless (string= what-input "+") - ;; not just "+", use following string - (setq what-input (substring what-input 1)) - - (let ((completions - ;; get list of possible completions for what-input - (all-completions what-input (mapcar 'symbol-name commands)))) - ;; use it, if unambigously - (if (= (length completions) 1) - (setq what-input (car completions)))))) - - - ;; if input ends in digits, save them away and do completions on head of input - ;; this allows input like "h224" to be accepted - (when (string-match "^\\([^0-9+]\\)\\([0-9]+\\)\\s *$" what-input) - ;; use first match as input, even if ambigously - (setq org-favtable--preferred-command - (intern (first (all-completions (match-string 1 what-input) - (mapcar 'symbol-name commands))))) - ;; use digits as argument to commands - (setq what-input (format org-favtable--ref-format - (string-to-number (match-string 2 what-input))))) - - (setq what (intern what-input)) - - ;; user is not required to input one of the commands; if - ;; not, take the first one and use the original input for - ;; next question - (if (memq what commands) - ;; input matched one element of list, dont need original - ;; input any more - (setq what-input nil) - ;; what-input will be used for next question, use first - ;; command for what - (setq what (or org-favtable--preferred-command - (first commands))) - ;; remove any trailing dot, that user might have added to - ;; disambiguate his input - (if (equal (substring what-input -1) ".") - ;; but do this only, if dot was really necessary to - ;; disambiguate - (let ((shortened-what-input (substring what-input 0 -1))) - (unless (test-completion shortened-what-input - (mapcar 'symbol-name - commands)) - (setq what-input shortened-what-input))))) - - ;; ask for reorder in loop, because we have to ask for - ;; what right again - (if (eq what 'reorder) - (setq reorder-once - (intern - (org-icompleting-read - "Please choose column to reorder reftable once: " - (mapcar 'symbol-name '(ref count last-accessed)) - nil t)))) - - ;; maybe ask initial question again - (memq what '(reorder +))))) - - - ;; - ;; Get search, if required - ;; - - ;; These actions need a search string: - (when (memq what '(goto occur head update)) - - ;; Maybe we've got a search string from the arguments - (unless search - (let (search-from-table - search-from-cursor) - - ;; Search string can come from several sources: - ;; From ref column of table - (when within-node - (setq search-from-table (org-favtable--get-field 'ref))) - ;; From string below cursor - (when (and (not within-node) - below-cursor - (string-match (concat "\\(" ref-regex "\\)") - below-cursor)) - (setq search-from-cursor (match-string 1 below-cursor))) - - ;; Depending on requested action, get search from one of the sources above - (cond ((eq what 'goto) - (setq search (or what-input search-from-cursor))) - ((memq what '(head occur)) - (setq search (or what-input search-from-table search-from-cursor)))))) - - - ;; If we still do not have a search string, ask user explicitly - (unless search - - (if what-input - (setq search what-input) - (setq search (read-from-minibuffer - (cond ((memq what '(occur head)) - "Text or reference number to search for: ") - ((eq what 'goto) - "Reference number to search for, or enter \".\" for id of current node: ") - ((eq what 'update) - "Reference number to update: "))))) - - (if (string-match "^\\s *[0-9]+\\s *$" search) - (setq search (format "%s%s%s" head (org-trim search) tail)))) - - ;; Clean up and examine search string - (if search (setq search (org-trim search))) - (if (string= search "") (setq search nil)) - (setq search-is-ref (string-match ref-regex search)) - - ;; Check for special case - (when (and (memq what '(head goto)) - (string= search ".")) - (setq search (org-id-get)) - (setq search-is-link t)) - - (when search-is-ref - (setq guarded-search (org-favtable--make-guarded-search search))) - - ;; - ;; Do some sanity checking before really starting - ;; - - ;; Correct requested action, if nothing to search - (when (and (not search) - (memq what '(search occur head))) - (setq what 'enter) - (setq what-adjusted t)) - - ;; For a proper reference as input, we do multi-occur - (if (and (string-match ref-regex search) - (eq what 'occur)) - (setq what 'multi-occur)) - - ;; Check for invalid combinations of arguments; try to be helpful - (when (and (memq what '(head goto)) - (not search-is-link) - (not search-is-ref)) - (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search))) - - - ;; - ;; Prepare - ;; - - ;; Get link if required before moving in - (if (eq what 'link) - (setq link-id (org-id-get-create))) - - ;; Move into table, if outside - (when (memq what '(enter ref link goto occur multi-occur missing statistics)) - - ;; Support orgmode-standard of going back (buffer and position) - (org-mark-ring-push) - - ;; Switch to favtable - (org-pop-to-buffer-same-window (car ref-node-buffer-and-point)) - (goto-char (cdr ref-node-buffer-and-point)) - (show-subtree) - (org-show-context) - - ;; sort favtable - (org-favtable--sort-table reorder-once)) - - ;; Goto back to initial ref, because reformatting of table above might - ;; have moved point - (when initial-ref-or-link - (while (and (org-at-table-p) - (not (or - (string= initial-ref-or-link (org-favtable--get-field 'ref)) - (string= initial-ref-or-link (org-favtable--get-field 'link))))) - (forward-line)) - ;; did not find ref, go back to top - (if (not (org-at-table-p)) (goto-char top))) - - - ;; - ;; Actually do, what is requested - ;; - - (cond - - - ((eq what 'help) - - (let ((help-what - ;; which sort of help ? - (intern - (concat - "help-" - (org-icompleting-read - "Help on: " - (mapcar 'symbol-name '(commands usage setup version example)) - nil t))))) - - ;; help is taken from docstring of functions or variables - (cond ((eq help-what 'help-commands) - (org-favtable--show-help 'org-favtable--commands)) - ((eq help-what 'help-usage) - (org-favtable--show-help 'org-favtable)) - ((eq help-what 'help-setup) - (org-favtable--show-help 'org-favtable-id)) - ((eq help-what 'help-version) - (org-favtable-version))))) - - - ((eq what 'multi-occur) - - ;; Conveniently position cursor on number to search for - (org-favtable--goto-top) - (let (found (initial (point))) - (while (and (not found) - (forward-line) - (org-at-table-p)) - (save-excursion - (setq found (string= search - (org-favtable--get-field 'ref))))) - (if found - (org-favtable--update-line nil) - (goto-char initial))) - - ;; Construct list of all org-buffers - (let (buff org-buffers) - (dolist (buff (buffer-list)) - (set-buffer buff) - (if (string= major-mode "org-mode") - (setq org-buffers (cons buff org-buffers)))) - - ;; Do multi-occur - (multi-occur org-buffers guarded-search) - (if (get-buffer "*Occur*") - (progn - (setq message-text (format "multi-occur for '%s'" search)) - (setq org-favtable--occur-buffer (get-buffer "*Occur*")) - (other-window 1) - (toggle-truncate-lines 1)) - (setq message-text (format "Did not find '%s'" search))))) - - - ((eq what 'head) - - (let (link) - ;; link either from table or passed in as argument - - ;; try to get link - (if search-is-link - (setq link (org-trim search)) - (if (and within-node - (org-at-table-p)) - (setq link (org-favtable--get-field 'link)))) - - ;; use link if available - (if (and link - (not (string= link ""))) - (progn - (org-id-goto link) - (org-favtable--update-line search) - (setq message-text "Followed link")) - - (message (format "Scanning headlines for '%s' ..." search)) - (let (buffer point) - (if (catch 'found - (progn - ;; loop over all headlines, stop on first match - (org-map-entries - (lambda () - (when (looking-at (concat ".*" guarded-search)) - ;; remember location and bail out - (setq buffer (current-buffer)) - (setq point (point)) - (throw 'found t))) - nil 'agenda) - nil)) - - (progn - (org-favtable--update-line search) - (setq message-text (format "Found '%s'" search)) - (org-pop-to-buffer-same-window buffer) - (goto-char point) - (org-reveal)) - (setq message-text (format "Did not find '%s'" search))))))) - - - ((eq what 'leave) - - (when result-is-visible - - ;; If we are within the occur-buffer, switch over to get current line - (if (and (string= (buffer-name) "*Occur*") - (eq org-favtable--last-action 'occur)) - (occur-mode-goto-occurrence))) - - (setq kill-new-text org-favtable--text-to-yank) - (setq org-favtable--text-to-yank nil) - - ;; If "leave" has been called two times in succession, make - ;; org-mark-ring-goto believe it has been called two times too - (if (eq org-favtable--last-action 'leave) - (let ((this-command nil) (last-command nil)) - (org-mark-ring-goto 1)) - (org-mark-ring-goto 0))) - - - ((eq what 'goto) - - ;; Go downward in table to requested reference - (let (found (initial (point))) - (org-favtable--goto-top) - (while (and (not found) - (forward-line) - (org-at-table-p)) - (save-excursion - (setq found - (string= search - (org-favtable--get-field - (if search-is-link 'link 'ref)))))) - (if found - (progn - (setq message-text (format "Found '%s'" search)) - (org-favtable--update-line nil) - (org-table-goto-column (org-favtable--column-num 'ref)) - (if (looking-back " ") (backward-char)) - ;; remember string to copy - (setq org-favtable--text-to-yank - (org-trim (org-table-get-field (org-favtable--column-num 'copy))))) - (setq message-text (format "Did not find '%s'" search)) - (goto-char initial) - (forward-line) - (setq what 'missed)))) - - - ((eq what 'occur) - - ;; search for string: occur - (let (search-regexp - all-or-any - (search-words (split-string search "," t))) - - (if (< (length search-words) 2) - ;; only one word to search; use it as is - (setq search-regexp search) - ;; construct regexp to match any of the words (maybe throw out some matches later) - (setq search-regexp - (mapconcat (lambda (x) (concat "\\(" x "\\)")) search-words "\\|")) - (setq all-or-any - (intern - (org-icompleting-read - "Two or more words have been specified; show lines, that match: " '("all" "any"))))) - - (save-restriction - (org-narrow-to-subtree) - (occur search-regexp) - (widen) - (if (get-buffer "*Occur*") - (with-current-buffer "*Occur*" - - ;; install helpful keyboard-shortcuts within occur-buffer - (let ((keymap (make-sparse-keymap))) - (set-keymap-parent keymap occur-mode-map) - - (define-key keymap (kbd "RET") - (lambda () (interactive) - (org-favtable--occur-helper 'head))) - - (define-key keymap (kbd "") - (lambda () (interactive) - (org-favtable--occur-helper 'multi-occur))) - - (define-key keymap (kbd "") - (lambda () (interactive) - (org-favtable--occur-helper 'goto))) - - (define-key keymap (kbd "") - (lambda () (interactive) - (org-favtable--occur-helper 'update))) - - (use-local-map keymap)) - - ;; Brush up occur buffer - (other-window 1) - (toggle-truncate-lines 1) - (let ((inhibit-read-only t)) - ;; insert some help text - (insert (substitute-command-keys - "Type RET to find heading, C-RET for multi-occur, M-RET to go to occurence and C-M-RET to update line in reftable.\n\n")) - (forward-line 1) - - ;; when matching all of multiple words, remove all lines that do not match one of the words - (when (eq all-or-any 'all) - (mapc (lambda (x) (keep-lines x)) search-words)) - - ;; replace description from occur - (when all-or-any - (forward-line -1) - (kill-line) - (let ((count (- (count-lines (point) (point-max)) 1))) - (insert (format "%d %s for %s of %s" - count - (if (= count 1) "match" "matches") - all-or-any - search))) - (forward-line) - (beginning-of-line)) - - ;; Record link or reference for each line in - ;; occur-buffer, that is linked into reftable. Because if - ;; we later realign the reftable and then reuse the occur - ;; buffer, the original links might point nowehere. - (save-excursion - (while (not (eq (point) (point-max))) - (let ((beg (line-beginning-position)) - (end (line-end-position)) - pos ref link) - - ;; occur has saved the position into a special property - (setq pos (get-text-property (point) 'occur-target)) - (when pos - ;; but this property might soon point nowhere; so retrieve ref-or-link instead - (with-current-buffer (marker-buffer pos) - (goto-char pos) - (setq ref (org-favtable--get-field 'ref)) - (setq link (org-favtable--get-field 'link)))) - ;; save as text property - (put-text-property beg end 'org-favtable--ref ref) - (put-text-property beg end 'org-favtable--link link)) - (forward-line)))) - - (setq message-text - (format "Occur for '%s'" search))) - (setq message-text - (format "Did not find any matches for '%s'" search)))))) - - - ((memq what '(ref link)) - - ;; add a new row (or reuse existing one) - (let (new) - - (when (eq what 'ref) - ;; go through table to find first entry to be reused - (when has-reuse - (org-favtable--goto-top) - ;; go through table - (while (and (org-at-table-p) - (not new)) - (when (string= - (org-favtable--get-field 'count) - ":reuse:") - (setq new (org-favtable--get-field 'ref)) - (if new (org-table-kill-row))) - (forward-line))) - - ;; no ref to reuse; construct new reference - (unless new - (setq new (format "%s%d%s" head (1+ maxref) tail))) - - ;; remember for org-mark-ring-goto - (setq org-favtable--text-to-yank new)) - - ;; insert ref or link as very first row - (org-favtable--goto-top) - (org-table-insert-row) - - ;; fill special columns with standard values - (when (eq what 'ref) - (org-table-goto-column (org-favtable--column-num 'ref)) - (insert new)) - (when (eq what 'link) - (org-table-goto-column (org-favtable--column-num 'link)) - (insert link-id)) - (org-table-goto-column (org-favtable--column-num 'created)) - (org-insert-time-stamp nil nil t) - - ;; goto first empty field - (unless (catch 'empty - (dotimes (col numcols) - (org-table-goto-column (+ col 1)) - (if (string= (org-trim (org-table-get-field)) "") - (throw 'empty t)))) - ;; none found, goto first - (org-table-goto-column 1)) - - (org-table-align) - (if active-region (setq kill-new-text active-region)) - (if (eq what 'ref) - (setq message-text (format "Adding a new row with ref '%s'" new)) - (setq message-text (format "Adding a new row linked to '%s'" link-id))))) - - - ((eq what 'enter) - - ;; simply go into table - (org-favtable--goto-top) - (show-subtree) - (recenter) - (if what-adjusted - (setq message-text "Nothing to search for; at favtable") - (setq message-text "At favtable"))) - - - ((eq what 'fill) - - ;; check, if within reftable - (unless (and within-node - (org-at-table-p)) - (error "Not within table of favorites")) - - ;; applies to missing refs and missing links alike - (let ((ref (org-favtable--get-field 'ref)) - (link (org-favtable--get-field 'link))) - - (if (and (not ref) - (not link)) - ;; have already checked this during parse, check here anyway - (error "Columns ref and link are both empty in this line")) - - ;; fill in new ref - (if (not ref) - (progn - (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail)) - (org-favtable--get-field 'ref kill-new-text) - ;; remember for org-mark-ring-goto - (setq org-favtable--text-to-yank kill-new-text) - (org-id-goto link) - (setq message-text "Filled reftable field with new reference")) - - ;; fill in new link - (if (not link) - (progn - (setq guarded-search (org-favtable--make-guarded-search ref)) - (message (format "Scanning headlines for '%s' ..." ref)) - (let (link) - (if (catch 'found - (org-map-entries - (lambda () - (when (looking-at (concat ".*" guarded-search)) - (setq link (org-id-get-create)) - (throw 'found t))) - nil 'agenda) - nil) - - (progn - (org-favtable--get-field 'link link) - (setq message-text "Inserted link")) - - (setq message-text (format "Did not find reference '%s'" ref))))) - - ;; nothing is missing - (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do"))))) - - - ((eq what 'sort) - - ;; sort lines according to contained reference - (let (begin end where) - (catch 'aborted - ;; either active region or whole buffer - (if (and transient-mark-mode - mark-active) - ;; sort only region - (progn - (setq begin (region-beginning)) - (setq end (region-end)) - (setq where "region")) - ;; sort whole buffer - (setq begin (point-min)) - (setq end (point-max)) - (setq where "whole buffer") - ;; make sure - (unless (y-or-n-p "Sort whole buffer ") - (setq message-text "Sort aborted") - (throw 'aborted nil))) - - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region begin end) - (sort-subr nil 'forward-line 'end-of-line - (lambda () - (if (looking-at (concat ".*" - (org-favtable--make-guarded-search ref-regex 'dont-quote))) - (string-to-number (match-string 1)) - 0)))) - (highlight-regexp ref-regex) - (setq message-text (format "Sorted %s from character %d to %d, %d lines" - where begin end - (count-lines begin end))))))) - - - ((eq what 'update) - - ;; simply update line in reftable - (save-excursion - (let ((ref-or-link (if search-is-link "link" "reference"))) - (beginning-of-line) - (if (org-favtable--update-line search) - (setq message-text (format "Updated %s '%s'" ref-or-link search)) - (setq message-text (format "Did not find %s '%s'" ref-or-link search)))))) - - - ((eq what 'parse) - - ;; Just parse the reftable, which is already done, so nothing to do - ) - - - ((memq what '(highlight unhighlight)) - - (let ((where "buffer")) - (save-excursion - (save-restriction - (when (and transient-mark-mode - mark-active) - (narrow-to-region (region-beginning) (region-end)) - (setq where "region")) - - (if (eq what 'highlight) - (progn - (highlight-regexp ref-regex) - (setq message-text (format "Highlighted references in %s" where))) - (unhighlight-regexp ref-regex) - (setq message-text (format "Removed highlights for references in %s" where))))))) - - - ((memq what '(missing statistics)) - - (org-favtable--goto-top) - (let (missing - ref-field - ref - min - max - (total 0)) - - ;; start with list of all references - (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) - (number-sequence 1 maxref))) - - ;; go through table and remove all refs, that we see - (while (and (forward-line) - (org-at-table-p)) - - ;; get ref-field and number - (setq ref-field (org-favtable--get-field 'ref)) - (if (and ref-field - (string-match ref-regex ref-field)) - (setq ref (string-to-number (match-string 1 ref-field)))) - - ;; remove existing refs from list - (if ref-field (setq missing (delete ref-field missing))) - - ;; record min and max - (if (or (not min) (< ref min)) (setq min ref)) - (if (or (not max) (> ref max)) (setq max ref)) - - ;; count - (setq total (1+ total))) - - ;; insert them, if requested - (forward-line -1) - (if (eq what 'statistics) - - (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. " - total - (format org-favtable--format min) - (format org-favtable--format max) - (length missing))) - - (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the table of favorites" - (length missing))) - (let (type) - (setq type (org-icompleting-read - "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing"))) - (mapc (lambda (x) - (let (org-table-may-need-update) (org-table-insert-row t)) - (org-favtable--get-field 'ref x) - (org-favtable--get-field 'count (format ":%s:" type))) - missing) - (org-table-align) - (setq message-text (format "Inserted %d new lines for missing refernces" (length missing)))) - (setq message-text (format "%d missing references." (length missing))))))) - - - (t (error "This is a bug: unmatched case '%s'" what))) - - - ;; remember what we have done for next time - (setq org-favtable--last-action what) - - ;; tell, what we have done and what can be yanked - (if kill-new-text (setq kill-new-text - (substring-no-properties kill-new-text))) - (if (string= kill-new-text "") (setq kill-new-text nil)) - (let ((m (concat - message-text - (if (and message-text kill-new-text) - " and r" - (if kill-new-text "R" "")) - (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")))) - (unless (string= m "") (message m))) - (if kill-new-text (kill-new kill-new-text)))) - - - -(defun org-favtable--parse-and-adjust-table () - - (let ((maxref 0) - top - bottom - ref-field - link-field - parts - numcols - head - tail - ref-regex - has-reuse - initial-point) - - (setq initial-point (point)) - (org-favtable--goto-top) - (setq top (point)) - - (goto-char top) - - ;; count columns - (org-table-goto-column 100) - (setq numcols (- (org-table-current-column) 1)) - - ;; get contents of columns - (forward-line -2) - (unless (org-at-table-p) - (org-favtable--report-setup-error - "Table of favorites starts with a hline" t)) - - ;; check for optional line consisting solely of width specifications - (beginning-of-line) - (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$") - (forward-line -1)) - (org-table-goto-column 1) - - (setq org-favtable--columns (org-favtable--parse-headings numcols)) - - ;; Go beyond end of table - (while (org-at-table-p) (forward-line 1)) - - ;; Kill all empty rows at bottom - (while (progn - (forward-line -1) - (org-table-goto-column 1) - (and - (not (org-favtable--get-field 'ref)) - (not (org-favtable--get-field 'link)))) - (org-table-kill-row)) - (forward-line) - (setq bottom (point)) - (forward-line -1) - - ;; Retrieve any decorations around the number within the first nonempty ref-field - (goto-char top) - (while (and (org-at-table-p) - (not (setq ref-field (org-favtable--get-field 'ref)))) - (forward-line)) - - ;; Some Checking - (unless ref-field - (org-favtable--report-setup-error - "No line of reference column contains a number" t)) - - (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field) - (org-favtable--report-setup-error - (format "First reference in table table of favorites ('%s') does not contain a number" ref-field) t)) - - - ;; These are the decorations used within the first ref of favtable - (setq head (match-string 1 ref-field)) - (setq tail (match-string 3 ref-field)) - (setq ref-regex (concat (regexp-quote head) - "\\([0-9]+\\)" - (regexp-quote tail))) - - ;; Go through table to find maximum number and do some checking - (let ((ref 0)) - - (while (org-at-table-p) - - (setq ref-field (org-favtable--get-field 'ref)) - (setq link-field (org-favtable--get-field 'link)) - - (if (and (not ref-field) - (not link-field)) - (throw 'content-error "Columns ref and link are both empty in this line")) - - (if ref-field - (if (string-match ref-regex ref-field) - ;; grab number - (setq ref (string-to-number (match-string 1 ref-field))) - (throw 'content-error "Column ref does not contain a number"))) - - ;; check, if higher ref - (if (> ref maxref) (setq maxref ref)) - - ;; check if ref is ment for reuse - (if (string= (org-favtable--get-field 'count) ":reuse:") - (setq has-reuse 1)) - - (forward-line 1))) - - ;; sort used to be here - - (setq parts (list head maxref tail numcols ref-regex has-reuse)) - - ;; go back to top of table - (goto-char top) - - parts)) - - - -(defun org-favtable--sort-table (sort-column) - - (unless sort-column (setq sort-column (org-favtable--column-num 'sort))) - - (let (top - bottom - ref-field - count-field - count-special) - - - ;; get boundaries of table - (org-favtable--goto-top) - (forward-line 0) - (setq top (point)) - (while (org-at-table-p) (forward-line)) - (setq bottom (point)) - - (save-restriction - (narrow-to-region top bottom) - (goto-char top) - (sort-subr t - 'forward-line - 'end-of-line - (lambda () - (let (ref - (ref-field (or (org-favtable--get-field 'ref) "")) - (count-field (or (org-favtable--get-field 'count) "")) - (count-special 0)) - - ;; get reference with leading zeroes, so it can be - ;; sorted as text - (string-match org-favtable--ref-regex ref-field) - (setq ref (format - "%06d" - (string-to-number - (or (match-string 1 ref-field) - "0")))) - - ;; find out, if special token in count-column - (setq count-special (format "%d" - (- 2 - (length (member count-field '(":missing:" ":reuse:")))))) - - ;; Construct different sort-keys according to - ;; requested sort column; prepend count-special to - ;; sort special entries at bottom of table, append ref - ;; as a secondary sort key - (cond - - ((eq sort-column 'count) - (concat count-special - (format - "%08d" - (string-to-number (or (org-favtable--get-field 'count) - ""))) - ref)) - - ((eq sort-column 'last-accessed) - (concat count-special - (org-favtable--get-field 'last-accessed) - " " - ref)) - - ((eq sort-column 'ref) - (concat count-special - ref)) - - (t (error "This is a bug: unmatched case '%s'" sort-column))))) - - nil 'string<))) - - ;; align table - (org-table-align)) - - -(defun org-favtable--goto-top () - - ;; go to heading of node - (while (not (org-at-heading-p)) (forward-line -1)) - (forward-line 1) - ;; go to table within node, but make sure we do not get into another node - (while (and (not (org-at-heading-p)) - (not (org-at-table-p)) - (not (eq (point) (point-max)))) - (forward-line 1)) - - ;; check, if there really is a table - (unless (org-at-table-p) - (org-favtable--report-setup-error - (format "Cannot find favtable within node %s" org-favtable-id) t)) - - ;; go to first hline - (while (and (not (org-at-table-hline-p)) - (org-at-table-p)) - (forward-line 1)) - - ;; and check - (unless (org-at-table-hline-p) - (org-favtable--report-setup-error - "Cannot find hline within table of favorites" t)) - - (forward-line 1) - (org-table-goto-column 1)) - - - -(defun org-favtable--id-find () - "Find org-favtable-id" - (let ((marker (org-id-find org-favtable-id 'marker)) - marker-and-buffer) - - (if marker - (progn - (setq marker-and-buffer (cons (marker-buffer marker) (marker-position marker))) - (move-marker marker nil) - marker-and-buffer) - nil))) - - - -(defun org-favtable--parse-headings (numcols) - - (let (columns) - - ;; Associate names of special columns with column-numbers - (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) - (count . 0) (sort . nil) (copy . nil)))) - - ;; For each column - (dotimes (col numcols) - (let* (field-flags ;; raw heading, consisting of file name and maybe - ;; flags (seperated by ";") - field ;; field name only - field-symbol ;; and as a symbol - flags ;; flags from field-flags - found) - - ;; parse field-flags into field and flags - (setq field-flags (org-trim (org-table-get-field (+ col 1)))) - (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags) - (progn - (setq field (downcase (or (match-string 1 field-flags) ""))) - ;; get flags as list of characters - (setq flags (mapcar 'string-to-char - (split-string - (downcase (match-string 2 field-flags)) - "" t)))) - ;; no flags - (setq field field-flags)) - - (unless (string= field "") (setq field-symbol (intern (downcase field)))) - - ;; Check, that no flags appear twice - (mapc (lambda (x) - (when (memq (car x) flags) - (if (cdr (assoc (cdr x) columns)) - (org-favtable--report-setup-error - (format "More than one heading is marked with flag '%c'" (car x)) t)))) - '((?s . sort) - (?c . copy))) - - ;; Process flags - (if (memq ?s flags) - (setcdr (assoc 'sort columns) field-symbol)) - (if (memq ?c flags) - (setcdr (assoc 'copy columns) (+ col 1))) - - ;; Store columns in alist - (setq found (assoc field-symbol columns)) - (when found - (if (> (cdr found) 0) - (org-favtable--report-setup-error - (format "'%s' appears two times as column heading" (downcase field)) t)) - (setcdr found (+ col 1))))) - - ;; check if all necessary informations have been specified - (mapc (lambda (col) - (unless (> (cdr (assoc col columns)) 0) - (org-favtable--report-setup-error - (format "column '%s' has not been set" col) t))) - '(ref link count created last-accessed)) - - ;; use ref as a default sort-column - (unless (cdr (assoc 'sort columns)) - (setcdr (assoc 'sort columns) 'ref)) - columns)) - - - -(defun org-favtable--report-setup-error (text &optional switch-to-node) - - (when switch-to-node - (org-id-goto org-favtable-id) - (delete-other-windows)) - - (when (y-or-n-p (concat - text - ";\n" - "the correct setup is explained in the documentation of 'org-favtable-id'.\n" - "Do you want to read it ? ")) - (org-favtable--show-help 'org-favtable-id)) - - (error "") - (setq org-favtable--last-action 'leave)) - - - -(defun org-favtable--show-help (function-or-variable) - - (let ((isfun (functionp function-or-variable))) - ;; bring up help-buffer for function or variable - (if isfun - (describe-function function-or-variable) - (describe-variable function-or-variable)) - - - ;; clean up help-buffer - (pop-to-buffer "*Help*") - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (while (progn - (kill-line 1) - (not (looking-at - (if isfun - "(" - "Documentation:"))))) - (kill-line (if isfun 2 3)) - (goto-char (point-max)) - (kill-line -2) - (goto-char (point-min))))) - - - -(defun org-favtable--update-line (ref-or-link) - - (let (initial - found - count-field - (ref-node-buffer-and-point (org-favtable--id-find))) - - (with-current-buffer (car ref-node-buffer-and-point) - - ;; search reference or link, if given (or assume, that we are already positioned right) - (when ref-or-link - (setq initial (point)) - (goto-char (cdr ref-node-buffer-and-point)) - (org-favtable--goto-top) - (while (and (org-at-table-p) - (not (or (string= ref-or-link (org-favtable--get-field 'ref)) - (string= ref-or-link (org-favtable--get-field 'link))))) - (forward-line))) - - (if (not (org-at-table-p)) - (error "Did not find reference or link '%s'" ref-or-link) - (setq count-field (org-favtable--get-field 'count)) - - ;; update count field only if number or empty; leave :missing: and :reuse: as is - (if (or (not count-field) - (string-match "^[0-9]+$" count-field)) - (org-favtable--get-field 'count - (number-to-string - (+ 1 (string-to-number (or count-field "0")))))) - - ;; update timestamp - (org-table-goto-column (org-favtable--column-num 'last-accessed)) - (org-table-blank-field) - (org-insert-time-stamp nil t t) - - (setq found t)) - - (if initial (goto-char initial)) - - found))) - - - -(defun org-favtable--occur-helper (action) - (let ((line-beg (line-beginning-position)) - key search link ref) - - ;; extract reference or link from text property (as put there before) - (setq ref (get-text-property line-beg 'org-favtable--ref)) - (if (string= ref "") (setq ref nil)) - (setq link (get-text-property line-beg 'org-favtable--link)) - (if (string= link "") (setq link nil)) - - (org-favtable action - (or link ref) ;; prefer link - (if link t nil)))) - - -(defun org-favtable--get-field (key &optional value) - (let (field) - (setq field (org-trim (org-table-get-field (cdr (assoc key org-favtable--columns)) value))) - (if (string= field "") (setq field nil)) - - field)) - - -(defun org-favtable--column-num (key) - (cdr (assoc key org-favtable--columns))) - - -(defun org-favtable-version () - "Show version of org-favtable" (interactive) - (message "org-favtable %s" org-favtable--version)) - - -(defun org-favtable--make-guarded-search (ref &optional dont-quote) - (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b")) - - -(defun org-favtable-get-ref-regex-format () - "return cons-cell with regular expression and format for references" - (unless org-favtable--ref-regex - (org-favtable 'parse)) - (cons (org-favtable--make-guarded-search org-favtable--ref-regex 'dont-quote) org-favtable--ref-format)) - - -(defadvice org-mark-ring-goto (after org-favtable--advice-text-to-yank activate) - "Make text from the favtable available for yank." - (when org-favtable--text-to-yank - (kill-new org-favtable--text-to-yank) - (message (format "Ready to yank '%s'" org-favtable--text-to-yank)) - (setq org-favtable--text-to-yank nil))) - - -(provide 'org-favtable) - -;; Local Variables: -;; fill-column: 75 -;; comment-column: 50 -;; End: - -;;; org-favtable.el ends here diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el new file mode 100644 index 000000000..8293a329a --- /dev/null +++ b/contrib/lisp/org-index.el @@ -0,0 +1,1944 @@ +;;; org-index.el --- A personal index for org and beyond + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Marc Ihm +;; Keywords: hypermedia, matching +;; Requires: org +;; Download: http://orgmode.org/worg/code/elisp/org-index.el +;; Version: 2.3.2 + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Purpose: +;; +;; Mark and find your favorite org-locations and other points of interest +;; easily; create and update a lookup table of references and links. When +;; searching, frequently used entries appear at the the top and entering +;; some keywords narrows down to matching entries only; so the right one +;; can be spotted easily. +;; +;; References are essentially small numbers (e.g. "R237" or "-455-"), +;; which are created by this package; they are well suited to be used +;; outside org. Links are normal org-mode links. +;; +;; Setup: +;; +;; - Add these lines to your .emacs: +;; +;; (require 'org-index) +;; +;; ;; Optionally assign a key. Pick your own. +;; (global-set-key (kbd "C-+") 'org-index) +;; +;; - Invoke `org-index', which will assist you to create your +;; index table. +;; +;; - Do not forget to restart emacs to make these lines effective. +;; +;; +;; Further reading: +;; +;; See the documentation of `org-index', which can also be read +;; by invoking `org-index' and and choosing the help-command. +;; +;; For more documentation and working examples, see: +;; +;; http://orgmode.org/worg/org-contrib/org-index.html +;; + +;;; Change Log: + +;; [2013-10-04 Fr] Version 2.3.2: +;; - Bugfix: index-table created by assistant is found after +;; restart of emacs instead of invoking assistent again +;; +;; [2013-07-20 Sa] Version 2.3.0: +;; - Renamed from "org-favtable" to "org-index" +;; - Added an assistent to set up the index table +;; - occur is now incremental, searching as you type +;; - simplified the documentation and help-system +;; - Saving keystrokes, as "+g237" is now valid input +;; - Many bugfixes +;; +;; [2013-02-28 Th] Version 2.2.0: +;; - Allowed shortcuts like "h237" for command "head" with argument "237" +;; - Integrated with org-mark-ring-goto +;; +;; [2013-01-25 Fr] Version 2.1.0: +;; - Added full support for links +;; - New commands "missing" and "statistics" +;; - Renamed the package from "org-reftable" to "org-favtable" +;; - Additional columns are required (e.g. "link"). Error messages will +;; guide you +;; +;; [2012-12-07 Fr] Version 2.0.0: +;; - The format of the table of favorites has changed ! You need to bring +;; your existing table into the new format by hand (which however is +;; easy and explained below) +;; - Reference table can be sorted after usage count or date of last access +;; - Ask user explicitly, which command to invoke +;; - Renamed the package from "org-refer-by-number" to "org-reftable" + +;; [2012-09-22 Sa] Version 1.5.0: +;; - New command "sort" to sort a buffer or region by reference number +;; - New commands "highlight" and "unhighlight" to mark references + +;; [2012-07-13 Fr] Version 1.4.0: +;; - New command "head" to find a headline with a reference number + +;; [2012-04-28 Sa] Version 1.3.0: +;; - New commands occur and multi-occur +;; - All commands can now be invoked explicitly +;; - New documentation +;; - Many bugfixes + +;; [2011-12-10 Sa] Version 1.2.0: +;; - Fixed a bug, which lead to a loss of newly created reference numbers +;; - Introduced single and double prefix arguments +;; - Started this Change Log + +;;; Code: + +(require 'org-table) +(require 'cl) + +(defvar org-index--preferred-command nil) + +(defvar org-index--commands + '(occur head ref link leave enter goto help + reorder fill sort update highlight unhighlight missing statistics) + "List of commands known to org-index.") + +(defvar org-index--commands-some '(occur head ref link leave enter goto help +)) + + +(defvar org-index--columns nil) + +(defcustom org-index-id nil + "Id of the Org-mode node, which contains the index table." + :group 'org + :group 'org-index) + + +(defvar org-index--text-to-yank nil) +(defvar org-index--last-action nil) +(defvar org-index--ref-regex nil) +(defvar org-index--ref-format nil) +(defvar org-index--buffer nil "buffer of index table") +(defvar org-index--point nil "position at start of headline of index table") +(defvar org-index--below-hline nil "position of first cell in first line below hline") +(defvar org-index--point-before nil "point in buffer with index table") + + +(defun org-index (&optional ARG) + "Mark and find your favorite things and org-locations easily: +Create and update a lookup table of references and links. Often +used entries bubble to the top; entering some keywords narrows +down to matching entries only, so that the right one can be +spotted easily. + +References are essentially small numbers (e.g. \"R237\" or \"-455-\"), +which are created by this package; they are well suited to be used +outside of org. Links are normal org-mode links. + +This is version 2.3.2 of org-index. + +The function `org-index' operates on a dedicated table, the index +table, which lives within its own Org-mode node. The table and +its node will be created, when you first invoke org-index. + +Each line in the index table contains: + + - A reference + + - A link + + - A number; counting, how often each reference has been + used. This number is updated automatically and the table can + be sorted after it, so that most frequently used references + appear at the top of the table and can be spotted easily. + + - The creation date of the line. + + - Date and time of last access. This column can alternatively be + used to sort the table. + + - A column for your own comments, which allows lines to be selected by + keywords. + +The index table is found through the id of the containing +node; this id is stored within `org-index-id'. + + +The function `org-index' is the only interactive function of this +package and its sole entry point; it offers several commands to +create, find and look up these favorites (references and links). + +Commands known: + + occur: Incremental search, that after each keystroke shows + matching lines from index table. You may enter a list of words + seperated by comma (\",\"), to select lines that contain all + of the given words. + + If you supply a number (e.g. \"237\"): Apply emacs standard + multi-occur operation on all org-mode buffers to search for + this specific reference. + + You may also read the note at the end of this help on saving + the keystroke RET with this frequent default command. + + head: If invoked outside the index table, ask for a + reference number and search for a heading containing it. If + invoked within index table dont ask; rather use the reference or + link from the current line. + + ref: Create a new reference, copy any previously selected text. + If already within index table, fill in ref-column. + + link: Create a new line in index table with a link to the + current node. Do not populate the ref column; this can later + be populated by calling the \"fill\" command from within the + index table. + + leave: Leave the index table. If the last command has + been \"ref\", the new reference is copied and ready to yank. + This \"org-mark-ring-goto\" and can be called several times + in succession. If you invoke org-index with a prefix argument, + this command \"leave\" is executed without further questions. + + enter: Just enter the node with the index table. + + goto: Search for a specific reference within the index table. + + help: Show this text. + + +: Show all commands including the less frequently used ones + given below. If \"+\" is followd by enough letters of such a + command (e.g. \"+fi\"), then this command is invoked + directly. + + reorder: Temporarily reorder the index table, e.g. by + count, reference or last access. + + fill: If either ref or link is missing, fill it. + + sort: Sort a set of lines (either the active region or the + whole buffer) by the references found in each line. + + update: For the given reference, update the line in the + index table. + + highlight: Highlight references in region or buffer. + + unhighlight: Remove highlights. + + missing : Search for missing reference numbers (which do not + appear in the reference table). If requested, add additional + lines for them, so that the command \"ref\" is able to reuse + them. + + statistics : Show some statistics (e.g. minimum and maximum + reference) about index table. + + + +Two ways to save keystrokes: + +When prompting for a command, org-index puts the most likely +one (e.g. \"occur\" or \"ref\") in front of the list, so that +you may just type RET. + +If this command needs additional input (like e.g. \"occur\"), you +may supply this input right away, although you are still beeing +prompted for the command. So, to do an occur for the string +\"foo\", you can just enter \"foo\" RET, without even typing +\"occur\". + + +Another way to save keystrokes applies if you want to choose a +command, that requrires a reference number (and would normally +prompt for it): In that case you may just enter enough characters +from your command, so that it appears first in the list of +matches; then immediately enter the number of the reference you +are searching for. So the input \"h237\" would execute the +command \"head\" for reference \"237\" right away. + +" + + (interactive "P") + + (org-index-1 (if (equal ARG '(4)) 'leave nil) ) +) + + +(defun org-index-1 (&optional what search search-is-link) +"Do the actual worg for org-index; its optional arguments are: + + search : string to search for + what : symbol of the command to invoke + search-is-link : t, if argument search is actually a link + +An example would be: + + (org-index \"237\" 'head) ;; find heading with ref 237 +" + (let (within-node ; True, if we are within node of the index table + active-window-index ; active window with index table (if any) + below-cursor ; word below cursor + active-region ; active region (if any) + link-id ; link of starting node, if required + guarded-search ; with guard against additional digits + search-is-ref ; true, if search is a reference + commands ; currently active set of selectable commands + what-adjusted ; True, if we had to adjust what + what-input ; Input on what question (need not necessary be "what") + trailing-digits ; any digits, that are are appended to what-input + reorder-once ; Column to use for single time sorting + parts ; Parts of a typical reference number (which + ; need not be a plain number); these are: + head ; Any header before number (e.g. "R") + maxref ; Maximum number from reference table (e.g. "153") + tail ; Tail after number (e.g. "}" or "") + ref-regex ; Regular expression to match a reference + has-reuse ; True, if table contains a line for reuse + numcols ; Number of columns in index table + kill-new-text ; Text that will be appended to kill ring + message-text ; Text that will be issued as an explanation, + ; what we have done + initial-ref-or-link ; Initial position in index table + ) + + ;; + ;; Examine current buffer and location, before turning to index table + ;; + + (unless (boundp 'org-index-id) + (setq org-index-id nil) + (org-index--create-new-index + t + (format "No index table has been created yet." org-index-id))) + + ;; Bail out, if new index has been created + (catch 'created-new-index + + ;; Get the content of the active region or the word under cursor + (if (and transient-mark-mode + mark-active) + (setq active-region (buffer-substring (region-beginning) (region-end)))) + (setq below-cursor (thing-at-point 'symbol)) + + + ;; Find out, if we are within favable or not + (setq within-node (string= (org-id-get) org-index-id)) + + + ;; + ;; Get decoration of references and highest reference from index table + ;; + + + ;; Save initial ref or link + (if (and within-node + (org-at-table-p)) + (setq initial-ref-or-link + (or (org-index--get-field 'ref) + (org-index--get-field 'link)))) + + ;; Find node + (let ((marker (org-id-find org-index-id 'marker)) initial) + (if marker + (progn + (setq org-index--buffer (marker-buffer marker) + org-index--point (marker-position marker)) + (move-marker marker nil)) + (org-index--create-new-index + t + (format "Cannot find node with id \"%s\"" org-index-id)))) + + ;; Check and remember, if active window contains buffer with index table + (if (eq (window-buffer) org-index--buffer) + (setq active-window-index (selected-window))) + + ;; Get configuration of index table; catch errors + (let ((error-message + (catch 'content-error + + (with-current-buffer org-index--buffer + (unless org-index--point-before + (setq org-index--point-before (point))) + + (unless (string= (org-id-get) org-index-id) + (goto-char org-index--point)) + + ;; parse table while still within buffer + (setq parts (org-index--parse-and-adjust-table)) + + ;; go back + (goto-char org-index--point-before) + + nil)))) + + (when error-message + (org-pop-to-buffer-same-window org-index--buffer) + (org-reveal) + (error error-message))) + + ;; Give names to parts of configuration + (setq head (nth 0 parts)) + (setq maxref (nth 1 parts)) + (setq tail (nth 2 parts)) + (setq numcols (nth 3 parts)) + (setq ref-regex (nth 4 parts)) + (setq has-reuse (nth 5 parts)) + (setq org-index--ref-regex ref-regex) + (setq org-index--ref-format (concat head "%d" tail)) + + ;; + ;; Find out, what we are supposed to do + ;; + + ;; Set preferred action, that will be the default choice + (setq org-index--preferred-command + (if within-node + (if (memq org-index--last-action '(ref link)) + 'leave + 'goto) + (if active-region + 'ref + (if (and below-cursor (string-match ref-regex below-cursor)) + 'occur + nil)))) + + ;; Ask user, what to do + (unless what + (setq commands (copy-list org-index--commands-some)) + (while (let (completions starts-with-plus is-only-plus) + + (setq what-input + (org-completing-read + "Please choose: " + (mapcar 'symbol-name + ;; Construct unique list of commands with + ;; preferred one at front + (delq nil (delete-dups + (append + (list org-index--preferred-command) + (copy-list commands))))) + nil nil)) + + ;; if input ends in digits, save them away and do completions on head of input + ;; this allows input like "h224" to be accepted + (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input) + ;; remember digits + (setq trailing-digits (string-to-number (match-string 2 what-input))) + ;; and use non-digits-part to find match + (setq what-input (match-string 1 what-input))) + + ;; if input starts with "+", any command (not only some) may follow + ;; this allows input like "+sort" to be accepted + (when (string= (substring what-input 0 1) "+") + ;; make all commands available for selection + (setq commands (copy-list org-index--commands)) + (setq what-input (substring what-input 1)) + (setq starts-with-plus (> (length what-input) 0)) + (setq is-only-plus (not starts-with-plus))) + + ;; get list of possible completions for what-input; i.e. + ;; all commands, that start with what-input + (setq completions (delq nil (mapcar + (lambda (x) + (let ((where (search what-input (symbol-name x)))) + (if (and where + (= where 0)) + x + nil))) commands))) + + ;; if input starts with "+" and not just "+" + (when starts-with-plus + ;; use first completion, if unambigously + (if (= (length completions) 1) + (setq what-input (symbol-name (car completions))) + (if completions + (error "Input \"+%s\" matches multiple commands: %s" + what-input + (mapconcat 'symbol-name completions ", ")) + (error "Input \"+%s\" matches no commands" what-input)))) + + ;; if input ends in digits, use first completion, even if ambigous + ;; this allows input like "h224" to be accepted + (when (and trailing-digits completions) + ;; use first match as input, even if ambigously + (setq org-index--preferred-command (first completions)) + (setq what-input (number-to-string trailing-digits))) + + ;; convert to symbol + (setq what (intern what-input)) + (if is-only-plus (setq what '+)) + + ;; user is not required to input one of the commands; if + ;; not, take the first one and use the original input for + ;; next question + (if (memq what commands) + ;; input matched one element of list, dont need original + ;; input any more + (setq what-input nil) + ;; what-input will be used for next question, use first + ;; command for what + (setq what (or org-index--preferred-command + (first commands))) + ;; remove any trailing dot, that user might have added to + ;; disambiguate his input + (if (and (> (length what-input) 0) + (equal (substring what-input -1) ".")) + ;; but do this only, if dot was really necessary to + ;; disambiguate + (let ((shortened-what-input (substring what-input 0 -1))) + (unless (test-completion shortened-what-input + (mapcar 'symbol-name + commands)) + (setq what-input shortened-what-input))))) + + ;; ask for reorder in loop, because we have to ask for + ;; what right again + (if (eq what 'reorder) + (setq reorder-once + (intern + (org-icompleting-read + "Please choose column to reorder index table once: " + (mapcar 'symbol-name '(ref count last-accessed)) + nil t)))) + + ;; maybe ask initial question again + (memq what '(reorder +))))) + + + ;; + ;; Get search, if required + ;; + + ;; These actions need a search string: + (when (memq what '(goto occur head update)) + + ;; Maybe we've got a search string from the arguments + (unless search + (let (search-from-table + search-from-cursor) + + ;; Search string can come from several sources: + ;; From link or ref columns of table + (when within-node + (setq search-from-table (org-index--get-field 'link)) + (if search-from-table + (setq search-is-link t) + (setq search-from-table (org-index--get-field 'ref)))) + + ;; From string below cursor + (when (and (not within-node) + below-cursor + (string-match (concat "\\(" ref-regex "\\)") + below-cursor)) + (setq search-from-cursor (match-string 1 below-cursor))) + + ;; Depending on requested action, get search from one of the sources above + (cond ((eq what 'goto) + (setq search (or what-input search-from-cursor))) + ((memq what '(head occur)) + (setq search (or what-input search-from-table search-from-cursor)))))) + + + ;; If we still do not have a search string, ask user explicitly + (unless search + (unless (eq what 'occur) + + (if what-input + (setq search what-input) + (setq search (read-from-minibuffer + (cond ((eq what 'head) + "Text or reference number to search for: ") + ((eq what 'goto) + "Reference number to search for, or enter \".\" for id of current node: ") + ((eq what 'update) + "Reference number to update: "))))) + + (if (string-match "^\\s *[0-9]+\\s *$" search) + (setq search (format "%s%s%s" head (org-trim search) tail)))))) + + ;; Clean up and examine search string + (when search + (setq search (org-trim search)) + (if (string= search "") (setq search nil)) + (when search + (if (string-match "^[0-9]+$" search) + (setq search (concat head search tail))) + (setq search-is-ref (string-match ref-regex search)))) + + ;; Check for special case + (when (and (memq what '(head goto)) + (string= search ".")) + (setq search (org-id-get)) + (setq search-is-link t)) + + (when search-is-ref + (setq guarded-search (org-index--make-guarded-search search))) + + ;; + ;; Do some sanity checking before really starting + ;; + + ;; Correct requested action, if nothing to search + (when (and (not search) + (memq what '(search head))) + (setq what 'enter) + (setq what-adjusted t)) + + ;; For a proper reference as input, we do multi-occur + (if (and search + (string-match ref-regex search) + (eq what 'occur)) + (setq what 'multi-occur)) + + ;; Check for invalid combinations of arguments; try to be helpful + (when (and (memq what '(head goto)) + (not search-is-link) + (not search-is-ref)) + (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search)) + + + ;; + ;; Prepare + ;; + + ;; Get link if required before moving in + (if (eq what 'link) + (let ((org-id-link-to-org-use-id t)) + (setq link-id (org-id-get-create)))) + + ;; Move into table, if outside + + ;; These commands enter index table only temporarily + (when (memq what '(occur multi-occur statistics)) + + ;; Switch to index table + (set-buffer org-index--buffer) + (goto-char org-index--point) + + ;; sort index table + (org-index--sort-table reorder-once)) + + ;; These commands will leave user in index table after they are finished + (when (memq what '(enter ref link goto missing)) + + ;; Support orgmode-standard of going back (buffer and position) + (org-mark-ring-push) + + ;; Switch to index table + (org-pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (show-subtree) + (org-show-context) + (setq org-index--point-before nil) ;; dont want to go back + + ;; sort index table + (org-index--sort-table reorder-once)) + + ;; Goto back to initial ref, because reformatting of table above might + ;; have moved point + (when initial-ref-or-link + (while (and (org-at-table-p) + (not (or + (string= initial-ref-or-link (org-index--get-field 'ref)) + (string= initial-ref-or-link (org-index--get-field 'link))))) + (forward-line)) + ;; did not find ref, go back to top + (if (not (org-at-table-p)) (goto-char org-index--point))) + + + ;; + ;; Actually do, what is requested + ;; + + (cond + + + ((eq what 'help) + + ;; bring up help-buffer for this function + (describe-function 'org-index)) + + + ((eq what 'multi-occur) + + ;; Conveniently position cursor on number to search for + (goto-char org-index--below-hline) + (let (found (initial (point))) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found (string= search + (org-index--get-field 'ref))))) + (if found + (org-index--update-line nil) + (goto-char initial))) + + ;; Construct list of all org-buffers + (let (buff org-buffers) + (dolist (buff (buffer-list)) + (set-buffer buff) + (if (string= major-mode "org-mode") + (setq org-buffers (cons buff org-buffers)))) + + ;; Do multi-occur + (multi-occur org-buffers guarded-search) + (if (get-buffer "*Occur*") + (progn + (setq message-text (format "multi-occur for '%s'" search)) + (other-window 1) + (toggle-truncate-lines 1)) + (setq message-text (format "Did not find '%s'" search))))) + + + ((eq what 'head) + + (let (link) + ;; link either from table or passed in as argument + + ;; try to get link + (if search-is-link + (setq link (org-trim search)) + (if (and within-node + (org-at-table-p)) + (setq link (org-index--get-field 'link)))) + + ;; use link if available + (if (and link + (not (string= link ""))) + (progn + (org-index--update-line search) + (org-id-goto link) + (org-reveal) + (if (eq (current-buffer) org-index--buffer) + (setq org-index--point-before nil)) + (setq message-text "Followed link")) + + (message (format "Scanning headlines for '%s' ..." search)) + (org-index--update-line search) + (let (buffer point) + (if (catch 'found + (progn + ;; loop over all headlines, stop on first match + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + ;; If this is not an inlinetask ... + (when (< (org-element-property :level (org-element-at-point)) + org-inlinetask-min-level) + ;; ... remember location and bail out + (setq buffer (current-buffer)) + (setq point (point)) + (throw 'found t)))) + nil 'agenda) + nil)) + + (progn + (if (eq buffer org-index--buffer) + (setq org-index--point-before nil)) + (setq message-text (format "Found '%s'" search)) + (org-pop-to-buffer-same-window buffer) + (goto-char point) + (org-reveal)) + (setq message-text (format "Did not find '%s'" search))))))) + + + ((eq what 'leave) + + (setq kill-new-text org-index--text-to-yank) + (setq org-index--text-to-yank nil) + + ;; If "leave" has been called two times in succession, make + ;; org-mark-ring-goto believe it has been called two times too + (if (eq org-index--last-action 'leave) + (let ((this-command nil) (last-command nil)) + (org-mark-ring-goto 1)) + (org-mark-ring-goto))) + + + ((eq what 'goto) + + ;; Go downward in table to requested reference + (let (found (initial (point))) + (goto-char org-index--below-hline) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found + (string= search + (org-index--get-field + (if search-is-link 'link 'ref)))))) + (if found + (progn + (setq message-text (format "Found '%s'" search)) + (org-index--update-line nil) + (org-table-goto-column (org-index--column-num 'ref)) + (if (looking-back " ") (backward-char)) + ;; remember string to copy + (setq org-index--text-to-yank + (org-trim (org-table-get-field (org-index--column-num 'copy))))) + (setq message-text (format "Did not find '%s'" search)) + (goto-char initial) + (forward-line) + (setq what 'missed)))) + + + ((eq what 'occur) + + (org-index--do-occur what-input)) + + + ((memq what '(ref link)) + + ;; add a new row (or reuse existing one) + (let (new) + + (when (eq what 'ref) + ;; go through table to find first entry to be reused + (when has-reuse + (goto-char org-index--below-hline) + ;; go through table + (while (and (org-at-table-p) + (not new)) + (when (string= + (org-index--get-field 'count) + ":reuse:") + (setq new (org-index--get-field 'ref)) + (if new (org-table-kill-row))) + (forward-line))) + + ;; no ref to reuse; construct new reference + (unless new + (setq new (format "%s%d%s" head (1+ maxref) tail))) + + ;; remember for org-mark-ring-goto + (setq org-index--text-to-yank new)) + + ;; insert ref or link as very first row + (goto-char org-index--below-hline) + (org-table-insert-row) + + ;; fill special columns with standard values + (when (eq what 'ref) + (org-table-goto-column (org-index--column-num 'ref)) + (insert new)) + (when (eq what 'link) + (org-table-goto-column (org-index--column-num 'link)) + (insert link-id)) + (org-table-goto-column (org-index--column-num 'created)) + (org-insert-time-stamp nil nil t) + (org-table-goto-column (org-index--column-num 'count)) + (insert "1") + + ;; goto copy-field or first empty one + (if (org-index--column-num 'copy) + (org-table-goto-column (org-index--column-num 'copy)) + (unless (catch 'empty + (dotimes (col numcols) + (org-table-goto-column (+ col 1)) + (if (string= (org-trim (org-table-get-field)) "") + (throw 'empty t)))) + ;; none found, goto first + (org-table-goto-column 1))) + + (org-table-align) + (if active-region (setq kill-new-text active-region)) + (if (eq what 'ref) + (setq message-text (format "Adding a new row with ref '%s'" new)) + (setq message-text (format "Adding a new row linked to '%s'" link-id))))) + + + ((eq what 'enter) + + ;; simply go into table + (goto-char org-index--below-hline) + (show-subtree) + (recenter) + (if what-adjusted + (setq message-text "Nothing to search for; at index table") + (setq message-text "At index table"))) + + + ((eq what 'fill) + + ;; check, if within index table + (unless (and within-node + (org-at-table-p)) + (error "Not within index table")) + + ;; applies to missing refs and missing links alike + (let ((ref (org-index--get-field 'ref)) + (link (org-index--get-field 'link))) + + (if (and (not ref) + (not link)) + ;; have already checked this during parse, check here anyway + (error "Columns ref and link are both empty in this line")) + + ;; fill in new ref + (if (not ref) + (progn + (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail)) + (org-index--get-field 'ref kill-new-text) + ;; remember for org-mark-ring-goto + (setq org-index--text-to-yank kill-new-text) + (org-id-goto link) + (setq message-text "Filled field of index table with new reference")) + + ;; fill in new link + (if (not link) + (progn + (setq guarded-search (org-index--make-guarded-search ref)) + (message (format "Scanning headlines for '%s' ..." ref)) + (let (link) + (if (catch 'found + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + (setq link (org-id-get-create)) + (throw 'found t))) + nil 'agenda) + nil) + + (progn + (org-index--get-field 'link link) + (setq message-text "Inserted link")) + + (setq message-text (format "Did not find reference '%s'" ref))))) + + ;; nothing is missing + (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do"))))) + + + ((eq what 'sort) + + ;; sort lines according to contained reference + (let (begin end where) + (catch 'aborted + ;; either active region or whole buffer + (if (and transient-mark-mode + mark-active) + ;; sort only region + (progn + (setq begin (region-beginning)) + (setq end (region-end)) + (setq where "region")) + ;; sort whole buffer + (setq begin (point-min)) + (setq end (point-max)) + (setq where "whole buffer") + ;; make sure + (unless (y-or-n-p "Sort whole buffer ") + (setq message-text "Sort aborted") + (throw 'aborted nil))) + + (save-excursion + (save-restriction + (goto-char (point-min)) + (narrow-to-region begin end) + (sort-subr nil 'forward-line 'end-of-line + (lambda () + (if (looking-at (concat ".*" + (org-index--make-guarded-search ref-regex 'dont-quote))) + (string-to-number (match-string 1)) + 0)))) + (highlight-regexp ref-regex 'isearch) + (setq message-text (format "Sorted %s from character %d to %d, %d lines" + where begin end + (count-lines begin end))))))) + + + ((eq what 'update) + + ;; simply update line in index table + (save-excursion + (let ((ref-or-link (if search-is-link "link" "reference"))) + (beginning-of-line) + (if (org-index--update-line search) + (setq message-text (format "Updated %s '%s'" ref-or-link search)) + (setq message-text (format "Did not find %s '%s'" ref-or-link search)))))) + + + ((eq what 'parse) + ;; Just parse the index table, which is already done, so nothing to do + ) + + + ((memq what '(highlight unhighlight)) + + (let ((where "buffer")) + (save-excursion + (save-restriction + (when (and transient-mark-mode + mark-active) + (narrow-to-region (region-beginning) (region-end)) + (setq where "region")) + + (if (eq what 'highlight) + (progn + (highlight-regexp ref-regex 'isearch) + (setq message-text (format "Highlighted references in %s" where))) + (unhighlight-regexp ref-regex) + (setq message-text (format "Removed highlights for references in %s" where))))))) + + + ((memq what '(missing statistics)) + + (goto-char org-index--below-hline) + (let (missing + ref-field + ref + min + max + (total 0)) + + ;; start with list of all references + (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) + (number-sequence 1 maxref))) + + ;; go through table and remove all refs, that we see + (while (and (forward-line) + (org-at-table-p)) + + ;; get ref-field and number + (setq ref-field (org-index--get-field 'ref)) + (if (and ref-field + (string-match ref-regex ref-field)) + (setq ref (string-to-number (match-string 1 ref-field)))) + + ;; remove existing refs from list + (if ref-field (setq missing (delete ref-field missing))) + + ;; record min and max + (if (or (not min) (< ref min)) (setq min ref)) + (if (or (not max) (> ref max)) (setq max ref)) + + ;; count + (setq total (1+ total))) + + ;; insert them, if requested + (forward-line -1) + (if (eq what 'statistics) + + (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. " + total + (format org-index--ref-format min) + (format org-index--ref-format max) + (length missing))) + + (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table" + (length missing))) + (let (type) + (setq type (org-icompleting-read + "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing"))) + (mapc (lambda (x) + (let (org-table-may-need-update) (org-table-insert-row t)) + (org-index--get-field 'ref x) + (org-index--get-field 'count (format ":%s:" type))) + missing) + (org-table-align) + (setq message-text (format "Inserted %d new lines for missing refernces" (length missing)))) + (setq message-text (format "%d missing references." (length missing))))))) + + + (t (error "This is a bug: unmatched case '%s'" what))) + + + ;; restore point in buffer or window with index table + (if org-index--point-before + ;; buffer displayed in window need to set point there first + (if (eq (window-buffer active-window-index) + org-index--buffer) + (set-window-point active-window-index org-index--point-before) + ;; set position in buffer in any case and second + (with-current-buffer org-index--buffer + (goto-char org-index--point-before) + (setq org-index--point-before nil)))) + + + ;; remember what we have done for next time + (setq org-index--last-action what) + + ;; tell, what we have done and what can be yanked + (if kill-new-text (setq kill-new-text + (substring-no-properties kill-new-text))) + (if (string= kill-new-text "") (setq kill-new-text nil)) + (let ((m (concat + message-text + (if (and message-text kill-new-text) + " and r" + (if kill-new-text "R" "")) + (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")))) + (unless (string= m "") (message m))) + (if kill-new-text (kill-new kill-new-text))))) + + + +(defun org-index--parse-and-adjust-table () + + (let ((maxref 0) + top + bottom + ref-field + link-field + parts + numcols + head + tail + ref-regex + has-reuse + initial-point) + + (setq initial-point (point)) + (org-index--go-below-hline) + (setq org-index--below-hline (point)) + (setq top (point)) + + ;; count columns + (org-table-goto-column 100) + (setq numcols (- (org-table-current-column) 1)) + + ;; get contents of columns + (forward-line -2) + (unless (org-at-table-p) + (org-index--create-new-index + nil + "Index table starts with a hline")) + + ;; check for optional line consisting solely of width specifications + (beginning-of-line) + (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$") + (forward-line -1)) + (org-table-goto-column 1) + + (setq org-index--columns (org-index--parse-headings numcols)) + + ;; Go beyond end of table + (while (org-at-table-p) (forward-line 1)) + + ;; Kill all empty rows at bottom + (while (progn + (forward-line -1) + (org-table-goto-column 1) + (and + (not (org-index--get-field 'ref)) + (not (org-index--get-field 'link)))) + (org-table-kill-row)) + (forward-line) + (setq bottom (point)) + (forward-line -1) + + ;; Retrieve any decorations around the number within the first nonempty ref-field + (goto-char top) + (while (and (org-at-table-p) + (not (setq ref-field (org-index--get-field 'ref)))) + (forward-line)) + + ;; Some Checking + (unless ref-field + (org-index--create-new-index + nil + "Reference column is empty")) + + (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field) + (org-index--create-new-index + nil + (format "First reference in index table ('%s') does not contain a number" ref-field))) + + + ;; These are the decorations used within the first ref of index + (setq head (match-string 1 ref-field)) + (setq tail (match-string 3 ref-field)) + (setq ref-regex (concat (regexp-quote head) + "\\([0-9]+\\)" + (regexp-quote tail))) + + ;; Go through table to find maximum number and do some checking + (let ((ref 0)) + + (while (org-at-table-p) + + (setq ref-field (org-index--get-field 'ref)) + (setq link-field (org-index--get-field 'link)) + + (if (and (not ref-field) + (not link-field)) + (throw 'content-error "Columns ref and link are both empty in this line")) + + (if ref-field + (if (string-match ref-regex ref-field) + ;; grab number + (setq ref (string-to-number (match-string 1 ref-field))) + (throw 'content-error "Column ref does not contain a number"))) + + ;; check, if higher ref + (if (> ref maxref) (setq maxref ref)) + + ;; check if ref is ment for reuse + (if (string= (org-index--get-field 'count) ":reuse:") + (setq has-reuse 1)) + + (forward-line 1))) + + ;; sort used to be here + + (setq parts (list head maxref tail numcols ref-regex has-reuse)) + + ;; go back to top of table + (goto-char top) + + parts)) + + + +(defun org-index--sort-table (sort-column) + + (unless sort-column (setq sort-column (org-index--column-num 'sort))) + + (let (top + bottom + ref-field + count-field + count-special) + + + ;; get boundaries of table + (goto-char org-index--below-hline) + (forward-line 0) + (setq top (point)) + (while (org-at-table-p) (forward-line)) + (setq bottom (point)) + + (save-restriction + (narrow-to-region top bottom) + (goto-char top) + (sort-subr t + 'forward-line + 'end-of-line + (lambda () + (let (ref + (ref-field (or (org-index--get-field 'ref) "")) + (count-field (or (org-index--get-field 'count) "")) + (count-special 0)) + + ;; get reference with leading zeroes, so it can be + ;; sorted as text + (string-match org-index--ref-regex ref-field) + (setq ref (format + "%06d" + (string-to-number + (or (match-string 1 ref-field) + "0")))) + + ;; find out, if special token in count-column + (setq count-special (format "%d" + (- 2 + (length (member count-field '(":missing:" ":reuse:")))))) + + ;; Construct different sort-keys according to + ;; requested sort column; prepend count-special to + ;; sort special entries at bottom of table, append ref + ;; as a secondary sort key + (cond + + ((eq sort-column 'count) + (concat count-special + (format + "%08d" + (string-to-number (or (org-index--get-field 'count) + ""))) + ref)) + + ((eq sort-column 'last-accessed) + (concat count-special + (org-index--get-field 'last-accessed) + " " + ref)) + + ((eq sort-column 'ref) + (concat count-special + ref)) + + (t (error "This is a bug: unmatched case '%s'" sort-column))))) + + nil 'string<))) + + ;; align table + (org-table-align)) + + +(defun org-index--go-below-hline () + + ;; go to heading of node + (while (not (org-at-heading-p)) (forward-line -1)) + (forward-line 1) + ;; go to table within node, but make sure we do not get into another node + (while (and (not (org-at-heading-p)) + (not (org-at-table-p)) + (not (eq (point) (point-max)))) + (forward-line 1)) + + ;; check, if there really is a table + (unless (org-at-table-p) + (org-index--create-new-index + t + (format "Cannot find index table within node %s" org-index-id))) + + ;; go to first hline + (while (and (not (org-at-table-hline-p)) + (org-at-table-p)) + (forward-line 1)) + + ;; and check + (unless (org-at-table-hline-p) + (org-index--create-new-index + nil + "Cannot find hline within index table")) + + (forward-line 1) + (org-table-goto-column 1)) + + + +(defun org-index--parse-headings (numcols) + + (let (columns) + + ;; Associate names of special columns with column-numbers + (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) + (count . 0) (sort . nil) (copy . nil)))) + + ;; For each column + (dotimes (col numcols) + (let* (field-flags ;; raw heading, consisting of file name and maybe + ;; flags (seperated by ";") + field ;; field name only + field-symbol ;; and as a symbol + flags ;; flags from field-flags + found) + + ;; parse field-flags into field and flags + (setq field-flags (org-trim (org-table-get-field (+ col 1)))) + (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags) + (progn + (setq field (downcase (or (match-string 1 field-flags) ""))) + ;; get flags as list of characters + (setq flags (mapcar 'string-to-char + (split-string + (downcase (match-string 2 field-flags)) + "" t)))) + ;; no flags + (setq field field-flags)) + + (unless (string= field "") (setq field-symbol (intern (downcase field)))) + + ;; Check, that no flags appear twice + (mapc (lambda (x) + (when (memq (car x) flags) + (if (cdr (assoc (cdr x) columns)) + (org-index--create-new-index + nil + (format "More than one heading is marked with flag '%c'" (car x)))))) + '((?s . sort) + (?c . copy))) + + ;; Process flags + (if (memq ?s flags) + (setcdr (assoc 'sort columns) field-symbol)) + (if (memq ?c flags) + (setcdr (assoc 'copy columns) (+ col 1))) + + ;; Store columns in alist + (setq found (assoc field-symbol columns)) + (when found + (if (> (cdr found) 0) + (org-index--create-new-index + nil + (format "'%s' appears two times as column heading" (downcase field)))) + (setcdr found (+ col 1))))) + + ;; check if all necessary informations have been specified + (mapc (lambda (col) + (unless (> (cdr (assoc col columns)) 0) + (org-index--create-new-index + nil + (format "column '%s' has not been set" col)))) + '(ref link count created last-accessed)) + + ;; use ref as a default sort-column + (unless (cdr (assoc 'sort columns)) + (setcdr (assoc 'sort columns) 'ref)) + columns)) + + + +(defun org-index--create-new-index (create-new-index reason) + "Create a new empty index table with detailed explanation." + (let (prompt buffer-name title firstref id) + + (setq prompt + (if create-new-index + (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?") + (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before proceeding. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?"))) + + (unless (y-or-n-p prompt) + (message "Cannot proceed without a valid index table: %s" reason) + ;; show existing index + (when (and org-index--buffer + org-index--point) + (org-pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (org-show-context) + (show-subtree) + (recenter 1) + (delete-other-windows)) + (throw 'created-new-index nil)) + + (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil)) + + (setq title (read-from-minibuffer "Please enter the title of the index node: ")) + + (while (progn + (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: ")) + (if (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref) + nil + (let (desc) + ;; firstref not okay, report details + (setq desc + (cond ((string= firstref "") "is empty") + ((not (string-match "^[^0-9]+" firstref)) "starts with a digit") + ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number") + ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits"))) + (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again " firstref desc))) + t))) + + (with-current-buffer buffer-name + (goto-char (point-max)) + (insert (format "\n\n* %s %s\n" firstref title)) + (insert "\n\n Below you find your initial index table, which will grow over time.\n" + " Following that your may read its detailed explanation, which will help you,\n" + " to adopt org-index to your needs. This however is optional reading and not\n" + " required to start using org-index.\n\n") + + (setq id (org-id-get-create)) + (insert (format " + + | | | | | | comment | + | ref | link | created | count;s | last-accessed | ;c | + | | <4> | | | | | + |-----+------+---------+---------+---------------+---------| + | %s | %s | %s | | | %s | + +" + firstref + id + (with-temp-buffer (org-insert-time-stamp nil nil t)) + "This node")) + + + (insert " + + Detailed explanation: + + + The index table above has three lines of headings above the first + hline: + + - The first one is ignored by org-index, and you can use it to + give meaningful names to columns. In the table above only one + column has a name (\"comment\"). This line is optional. + + - The second line is the most important one, because it + contains the configuration information for org-index; please + read further below for its format. + + - The third line is again optional; it may only specify the + widths of the individual columns (e.g. <4>). + + The columns get their meaning by the second line of headings; + specifically by one of the keywords (e.g. \"ref\") or a flag + seperated by a semicolon (e.g. \";s\"). + + + + The keywords and flags are: + + + - ref: This contains the reference, which consists of a decorated + number, which is incremented for each new line. References are + meant to be used in org-mode headlines or outside of org´, + e.g. within folder names. + + - link: org-mode link pointing to the matching location within org. + + - created: When has this line been created ? + + - count: How many times has this line accessed ? The trailing + flag \"s\" makes the table beeing sorted after + this column, so that often used entries appear at the top of + the table. + + - last-accessed: When has this line ben accessed + + - The last column above has no keyword, only the flag \"c\", + which makes its content beeing copied under certain + conditions. It is typically used for comments. + + The sequence of columns does not matter. You may reorder them any + way you like. Columns are found by their name, which appears in + the second line of headings. + + You can add further columns or even remove the last column. All + other columns are required. + + + Finally: This node needs not be a top level node; its name is + completely at you choice; it is found through its ID only. + +") + + + (while (not (org-at-table-p)) (forward-line -1)) + (org-table-align) + (while (not (org-at-heading-p)) (forward-line -1)) + + ;; present results to user + (if (and (not create-new-index) + org-index--buffer + org-index--point) + + ;; we had an error with the existing table, so present old and new one + (progn + ;; show existing index + (org-pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (org-show-context) + (show-subtree) + (recenter 1) + (delete-other-windows) + ;; show new index + (select-window (split-window-vertically)) + (org-pop-to-buffer-same-window buffer-name) + (org-id-goto id) + (org-show-context) + (show-subtree) + (recenter 1) + (message "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)) + + ;; Only show the new index + (org-pop-to-buffer-same-window buffer-name) + (delete-other-windows) + (org-id-goto id) + (org-show-context) + (show-subtree) + (recenter 1) + (setq org-index-id id) + (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ") + (progn + (customize-save-variable 'org-index-id id) + (message "Saved org-index-id '%s' to %s" org-index-id custom-file)) + (let (sq) + (setq sq (format "(setq org-index-id \"%s\")" org-index-id)) + (kill-new sq) + (message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))))) + ;; cannot handle this situation in higher code, but do not want to finish with an error + (throw 'created-new-index nil))) + + + + +(defun org-index--update-line (ref-or-link) + + (let (initial + found + count-field) + + (with-current-buffer org-index--buffer + + ;; search reference or link, if given (or assume, that we are already positioned right) + (when ref-or-link + (setq initial (point)) + (goto-char org-index--below-hline) + (while (and (org-at-table-p) + (not (or (string= ref-or-link (org-index--get-field 'ref)) + (string= ref-or-link (org-index--get-field 'link))))) + (forward-line))) + + (if (not (org-at-table-p)) + (error "Did not find reference or link '%s'" ref-or-link) + (setq count-field (org-index--get-field 'count)) + + ;; update count field only if number or empty; leave :missing: and :reuse: as is + (if (or (not count-field) + (string-match "^[0-9]+$" count-field)) + (org-index--get-field 'count + (number-to-string + (+ 1 (string-to-number (or count-field "0")))))) + + ;; update timestamp + (org-table-goto-column (org-index--column-num 'last-accessed)) + (org-table-blank-field) + (org-insert-time-stamp nil t t) + + (setq found t)) + + (if initial (goto-char initial)) + + found))) + + + +(defun org-index--get-field (key &optional value) + (let (field) + (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value))) + (if (string= field "") (setq field nil)) + + field)) + + +(defun org-index--column-num (key) + (cdr (assoc key org-index--columns))) + + +(defun org-index--make-guarded-search (ref &optional dont-quote) + (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b")) + + +(defun org-index-get-ref-regex-format () + "return cons-cell with regular expression and format for references" + (unless org-index--ref-regex + (org-index-1 'parse)) + (cons (org-index--make-guarded-search org-index--ref-regex 'dont-quote) org-index--ref-format)) + + +(defun org-index--do-occur (initial-search) + (let ( + (occur-buffer-name "*org-index-occur*") + (word "") ; last word to search for growing and shrinking on keystrokes + (prompt "Search for: ") + words ; list of other words that must match too + occur-buffer + lines-to-show ; number of lines to show in window + start-of-lines ; position, where lines begin + left-off-at ; stack of last positions in index table + after-inserted ; in occur-buffer + lines-visible ; in occur-buffer + below-hline-bol ; below-hline and at bol + exit-gracefully ; true if normal exit + in-c-backspace ; true while processing C-backspace + ret from to key) + + ;; clear buffer + (if (get-buffer "*org-index-occur*") + (kill-buffer occur-buffer-name)) + (setq occur-buffer (get-buffer-create "*org-index-occur*")) + + (with-current-buffer org-index--buffer + (let ((initial (point))) + (goto-char org-index--below-hline) + (forward-line 0) + (setq below-hline-bol (point)) + (goto-char initial))) + + (org-pop-to-buffer-same-window occur-buffer) + (toggle-truncate-lines 1) + + (unwind-protect ; to reset cursor-shape even in case of errors + (progn + + ;; fill in header + (erase-buffer) + (insert (concat "Incremental search, showing one window of matches.\n" + "Use DEL and C-DEL to erase, cursor keys to move, RET to find heading.\n\n")) + (setq start-of-lines (point)) + (setq cursor-type 'hollow) + + ;; get window size of occur-buffer as number of lines to be searched + (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1)) + + + ;; fill initially + (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol)) + (when (car ret) + (insert (cdr ret)) + (setq left-off-at (cons (car ret) nil)) + (setq after-inserted (cons (point) nil))) + + ;; read keys + (while + (progn + (goto-char start-of-lines) + (setq lines-visible 0) + + ;; use initial-search (if present) to simulate keyboard input + (if (and initial-search + (> (length initial-search) 0)) + (progn + (setq key (string-to-char (substring initial-search 0 1))) + (if (length initial-search) + (setq initial-search (substring initial-search 1)))) + (if in-c-backspace + (setq key 'backspace) + (setq key (read-event + (format "%s %s" + prompt + (mapconcat 'identity (reverse (cons word words)) ",")))) + + (setq exit-gracefully (memq key (list 'return 'up 'down 'left 'right))))) + + (not exit-gracefully)) + + (cond + + ((eq key 'C-backspace) + + (setq in-c-backspace t)) + + ((eq key 'backspace) ; erase last char + + (if (= (length word) 0) + + ;; nothing more to delete + (setq in-c-backspace nil) + + ;; unhighlight longer match + (let ((case-fold-search t)) + (unhighlight-regexp (regexp-quote word))) + + ;; chars left shorten word + (setq word (substring word 0 -1)) + (when (= (length word) 0) ; when nothing left, use next word from list + (setq word (car words)) + (setq words (cdr words)) + (setq in-c-backspace nil)) + + ;; remove everything, that has been added for char just deleted + (when (cdr after-inserted) + (setq after-inserted (cdr after-inserted)) + (goto-char (car after-inserted)) + (delete-region (point) (point-max))) + + ;; back up last position in index table too + (when (cdr left-off-at) + (setq left-off-at (cdr left-off-at))) + + ;; go through buffer and check, if any invisible line should now be shown + (goto-char start-of-lines) + (while (< (point) (point-max)) + (if (outline-invisible-p) + (progn + (setq from (line-beginning-position) + to (line-beginning-position 2)) + + ;; check for matches + (when (org-index--test-words (cons word words) (buffer-substring from to)) + (when (<= lines-visible lines-to-show) ; show, if more lines required + (outline-flag-region from to nil) + (incf lines-visible)))) + + ;; already visible, just count + (incf lines-visible)) + + (forward-line 1)) + + ;; highlight shorter word + (unless (= (length word) 0) + (let ((case-fold-search t)) + (highlight-regexp (regexp-quote word) 'isearch))))) + + + ((eq key ?,) ; comma: enter an additional search word + + ;; push current word and clear, no need to change display + (setq words (cons word words)) + (setq word "")) + + + ((and (characterp key) + (aref printable-chars key)) ; any other char: add to current search word + + + ;; unhighlight short word + (unless (= (length word) 0) + (let ((case-fold-search t)) + (unhighlight-regexp (regexp-quote word)))) + + ;; add to word + (setq word (concat word (downcase (string key)))) + + ;; hide lines, that do not match longer word any more + (while (< (point) (point-max)) + (unless (outline-invisible-p) + (setq from (line-beginning-position) + to (line-beginning-position 2)) + + ;; check for matches + (if (org-index--test-words (list word) (buffer-substring from to)) + (incf lines-visible) ; count as visible + (outline-flag-region from to t))) ; hide + + (forward-line 1)) + + ;; duplicate top of stacks; eventually overwritten below + (setq left-off-at (cons (car left-off-at) left-off-at)) + (setq after-inserted (cons (car after-inserted) after-inserted)) + + ;; get new lines from index table + (when (< lines-visible lines-to-show) + (setq ret (org-index--get-matching-lines (cons word words) + (- lines-to-show lines-visible) + (car left-off-at))) + + (when (car ret) + (insert (cdr ret)) + (setcar left-off-at (car ret)) + (setcar after-inserted (point)))) + + ;; highlight longer word + (let ((case-fold-search t)) + (highlight-regexp (regexp-quote word) 'isearch))))) + + ;; search is done collect and brush up results + ;; remove any lines, that are still invisible + (goto-char start-of-lines) + (while (< (point) (point-max)) + (if (outline-invisible-p) + (delete-region (line-beginning-position) (line-beginning-position 2)) + (forward-line 1))) + + ;; get all the rest + (message "Getting all matches ...") + (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at))) + (message "done.") + (insert (cdr ret))) + + ;; postprocessing even for non graceful exit + (setq cursor-type t) + ;; replace previous heading + (let ((numlines (count-lines (point) start-of-lines))) + (goto-char start-of-lines) + (forward-line -1) + (delete-region (point-min) (point)) + (insert (format (concat (if exit-gracefully + "Search is done; showing all %d matches.\n" + "Search aborted; showing only some matches.\n") + "Use cursor keys to move, press RET to find heading.\n") + numlines))) + (forward-line)) + + ;; install keyboard-shortcuts within occur-buffer + (let ((keymap (make-sparse-keymap)) + fun-on-ret) + (set-keymap-parent keymap text-mode-map) + + (setq fun-on-ret (lambda () (interactive) + (let ((ref (org-index--get-field 'ref)) + (link (org-index--get-field 'link))) + (org-index-1 'head + (or link ref) ;; prefer link + (if link t nil))))) + + (define-key keymap (kbd "RET") fun-on-ret) + (use-local-map keymap) + + ;; perform action according to last char + (cond + ((eq key 'return) + (funcall fun-on-ret)) + + ((eq key 'up) + (forward-line -1)) + + ((eq key 'down) + (forward-line 1)) + + ((eq key 'left) + (forward-char -1)) + + ((eq key 'right) + (forward-char 1)))))) + + +(defun org-index--get-matching-lines (words numlines start-from) + (let ((numfound 0) + pos + initial line lines) + + (with-current-buffer org-index--buffer + + ;; remember initial pos and start at requested + (setq initial (point)) + (goto-char start-from) + + ;; loop over buffer until we have found enough lines + (while (and (or (< numfound numlines) + (= numlines 0)) + (org-at-table-p)) + + ;; check each word + (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2))) + (when (org-index--test-words words line) + (setq lines (concat lines line)) + (incf numfound)) + (forward-line 1) + (setq pos (point))) + + ;; return to initial position + (goto-char initial)) + + (unless lines (setq lines "")) + (cons pos lines))) + + +(defun org-index--test-words (words line) + (let ((found-all t)) + (setq line (downcase line)) + (catch 'not-found + (dolist (w words) + (or (search w line) + (throw 'not-found nil))) + t))) + + +(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate) + "Make text from org-index available for yank." + (when org-index--text-to-yank + (kill-new org-index--text-to-yank) + (message (format "Ready to yank '%s'" org-index--text-to-yank)) + (setq org-index--text-to-yank nil))) + + +(provide 'org-index) + +;; Local Variables: +;; fill-column: 75 +;; comment-column: 50 +;; End: + +;;; org-index.el ends here From 56d405a41c3ce0d4c181bdc920e7a8a7647330b2 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 4 Nov 2013 12:19:45 +0100 Subject: [PATCH 041/166] org.el (org-babel-load-file): Set `exported-file' correctly * org.el (org-babel-load-file): Set `exported-file' correctly, in case the file as been tangled using a buffer-local value. * ob-tangle.el (org-babel-tangle-file): Return the list of tangled files. Thanks to Sam Flint for reporting this. --- lisp/ob-tangle.el | 16 +++++++++------- lisp/org.el | 3 ++- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 8141943ca..9f0e2de7f 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -144,16 +144,18 @@ evaluating BODY." Source code blocks are extracted with `org-babel-tangle'. Optional argument TARGET-FILE can be used to specify a default export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language." +used to limit the exported source code blocks by language. +Return a list whose CAR is the tangled file name." (interactive "fFile to tangle: \nP") (let ((visited-p (get-file-buffer (expand-file-name file))) to-be-removed) - (save-window-excursion - (find-file file) - (setq to-be-removed (current-buffer)) - (org-babel-tangle nil target-file lang)) - (unless visited-p - (kill-buffer to-be-removed)))) + (prog1 + (save-window-excursion + (find-file file) + (setq to-be-removed (current-buffer)) + (org-babel-tangle nil target-file lang)) + (unless visited-p + (kill-buffer to-be-removed))))) (defun org-babel-tangle-publish (_ filename pub-dir) "Tangle FILENAME and place the results in PUB-DIR." diff --git a/lisp/org.el b/lisp/org.el index e750ba036..afd7b212f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -198,7 +198,8 @@ file to byte-code before it is loaded." ;; tangle if the org-mode file is newer than the elisp file (unless (and (file-exists-p exported-file) (> (funcall age file) (funcall age exported-file))) - (org-babel-tangle-file file exported-file "emacs-lisp")) + (setq exported-file + (car (org-babel-tangle-file file exported-file "emacs-lisp")))) (message "%s %s" (if compile (progn (byte-compile-file exported-file 'load) From 2d444c1647e3bb3923fbc2a3c197bc67b221df41 Mon Sep 17 00:00:00 2001 From: Aaron Ecay Date: Mon, 28 Oct 2013 17:40:37 -0400 Subject: [PATCH 042/166] make comment-dwim in source code blocks more DWIM-ish MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/org.el (org-insert-comment, org-comment-or-uncomment-region): use the relevant language’s major mode comment function if called from within a source block. This patch makes it easier to (un)comment lines of babel source. Now M-; in a soucre code block should Just Work. The modification to ‘org-insert-comment’ also fixes a bug, whereby the function would eat blank lines after it. The first block, where ! is the point, would lead to the second instead of the third: #+name: orig #+begin_src org xxxxxxx ! yyyyyy #+end_src #+name: bad #+begin_src org xxxxxxx # yyyyyy #+end_src #+name: desired #+begin_src org xxxxxxx # yyyyyy #+end_src Also, the ‘org-comment-or-uncomment-region’ change results in an undesirably move of the point after the comment is created. This is because ‘comment-region’ wraps the call to ‘comment-region-function’ in a ‘save-excursion’. The org mode code deletes and reinserts the whole babel block, which confuses save-excursion. Org carefully puts the point back in the proper place, but comment-region’s save-excursion then substitutes its own erroneous placement. --- lisp/org.el | 126 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 74 insertions(+), 52 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 6d538b7c9..485f6d0b7 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -22495,64 +22495,86 @@ non-nil." (defun org-insert-comment () "Insert an empty comment above current line. If the line is empty, insert comment at its beginning." - (beginning-of-line) - (if (looking-at "\\s-*$") (replace-match "") (open-line 1)) - (org-indent-line) - (insert "# ")) + (if (org-in-src-block-p t) + (progn + (require 'ob-core) + (org-babel-do-in-edit-buffer + (call-interactively #'comment-dwim))) + (beginning-of-line) + (if (looking-at "\\s-*$") + (delete-region (point) (point-at-eol)) + (open-line 1)) + (org-indent-line) + (insert "# "))) (defvar comment-empty-lines) ; From newcomment.el. (defun org-comment-or-uncomment-region (beg end &rest ignore) "Comment or uncomment each non-blank line in the region. Uncomment each non-blank line between BEG and END if it only contains commented lines. Otherwise, comment them." - (save-restriction - ;; Restrict region - (narrow-to-region (save-excursion (goto-char beg) - (skip-chars-forward " \r\t\n" end) - (line-beginning-position)) - (save-excursion (goto-char end) - (skip-chars-backward " \r\t\n" beg) - (line-end-position))) - (let ((uncommentp - ;; UNCOMMENTP is non-nil when every non blank line between - ;; BEG and END is a comment. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) - (let ((element (org-element-at-point))) - (and (eq (org-element-type element) 'comment) - (goto-char (min (point-max) - (org-element-property - :end element))))))) - (eobp)))) - (if uncommentp - ;; Only blank lines and comments in region: uncomment it. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") - (replace-match "" nil nil nil 1)) - (forward-line))) - ;; Comment each line in region. - (let ((min-indent (point-max))) - ;; First find the minimum indentation across all lines. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) (not (zerop min-indent))) - (unless (looking-at "[ \t]*$") - (setq min-indent (min min-indent (current-indentation)))) - (forward-line))) - ;; Then loop over all lines. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) - ;; Don't get fooled by invisible text (e.g. link path) - ;; when moving to column MIN-INDENT. - (let ((buffer-invisibility-spec nil)) - (org-move-to-column min-indent t)) - (insert comment-start)) - (forward-line)))))))) + (let* ((pt (point-marker)) + (head (and (org-in-src-block-p t) + (require 'ob-core) + (org-babel-where-is-src-block-head))) + (foot (and head + (save-excursion + (goto-char head) + (looking-at org-babel-src-block-regexp) + (goto-char (match-end 0)) + (point-at-bol))))) + (if (and head foot + (> beg head) + (< end foot)) + (org-babel-do-in-edit-buffer + (call-interactively #'comment-dwim)) + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) + (let ((uncommentp + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + ;; Don't get fooled by invisible text (e.g. link path) + ;; when moving to column MIN-INDENT. + (let ((buffer-invisibility-spec nil)) + (org-move-to-column min-indent t)) + (insert comment-start)) + (forward-line)))))))))) ;;; Planning From 2a95f5e40958d7b9e79e5ad64eb24507c9d638d5 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 4 Nov 2013 12:45:22 +0100 Subject: [PATCH 043/166] org.texi (Catching invisible edits): Fix typo * org.texi (Catching invisible edits): Fix typo. Thanks to Cyprien Gay for reporting this. --- doc/org.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/org.texi b/doc/org.texi index 852c1531a..94f7ac30a 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -1375,7 +1375,7 @@ entries. @vindex org-catch-invisible-edits @cindex edits, catching invisible Sometimes you may inadvertently edit an invisible part of the buffer and be -confused on what as been edited and how to undo the mistake. Setting +confused on what has been edited and how to undo the mistake. Setting @code{org-catch-invisible-edits} to non-@code{nil} will help prevent this. See the docstring of this option on how Org should catch invisible edits and process them. From ae1e22b64d0368b88d8e81167da9c63a7937e9b0 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 4 Nov 2013 12:52:01 +0100 Subject: [PATCH 044/166] org.el (org-sort-entries): Enhance the docstring MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * org.el (org-sort-entries): Mention the `org-after-sorting-entries-or-items-hook' hook in the docstring. Thanks to Andreas Röhler for suggesting this. --- lisp/org.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 485f6d0b7..610c50628 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8595,7 +8595,9 @@ Comparing entries ignores case by default. However, with an optional argument WITH-CASE, the sorting considers case as well. Sorting is done against the visible part of the headlines, it ignores hidden -links." +links. + +When sorting is done, call `org-after-sorting-entries-or-items-hook'." (interactive "P") (let ((case-func (if with-case 'identity 'downcase)) (cmstr From 228ea6881b56a335de11cdf11f26853c33cc8336 Mon Sep 17 00:00:00 2001 From: Yasushi SHOJI Date: Sat, 12 Oct 2013 20:10:06 +0900 Subject: [PATCH 045/166] lisp/org.el (org-set-tags): Calculate width of tags with string-width * lisp/org.el (org-set-tags): Width of strings presenting on a buffer should be calculated with `string-width' instead of `length'. This fixes unaligned tags for the languages with multi-width characters. TINYCHANGE --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 610c50628..03c662d15 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14543,7 +14543,7 @@ With prefix ARG, realign all tags in headings in the current buffer." 0) p0 (if (equal (char-before) ?*) (1+ (point)) (point)) tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) - c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) + c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (string-width tags)))) rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) (replace-match rpl t t) (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) @@ -20403,7 +20403,7 @@ If `org-special-ctrl-o' is nil, just call `open-line' everywhere." (open-line n)) ((org-at-table-p) (org-table-insert-row)) - (t + (t (open-line n)))) (defun org-return (&optional indent) From 28f4b898305006730a6a7ba67e27df33c243d702 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 4 Nov 2013 18:00:40 +0100 Subject: [PATCH 046/166] Small refactoring in comment functions * lisp/org.el (org-insert-comment, org-comment-or-uncomment-region): Use `org-element-at-point' instead of `org-in-src-block-p' to check if we're within a source block. * testing/lisp/test-org.el: Add test. --- lisp/org.el | 150 +++++++++++++++++++++------------------ testing/lisp/test-org.el | 20 +++++- 2 files changed, 99 insertions(+), 71 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 03c662d15..539ed3c94 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -22496,15 +22496,25 @@ non-nil." (defun org-insert-comment () "Insert an empty comment above current line. -If the line is empty, insert comment at its beginning." - (if (org-in-src-block-p t) +If the line is empty, insert comment at its beginning. When +point is within a source block, comment according to the related +major mode." + (if (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'src-block) + (< (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (line-end-position)) + (point)) + (> (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)) + (point)))) (progn (require 'ob-core) - (org-babel-do-in-edit-buffer - (call-interactively #'comment-dwim))) + (org-babel-do-in-edit-buffer (call-interactively #'comment-dwim))) (beginning-of-line) - (if (looking-at "\\s-*$") - (delete-region (point) (point-at-eol)) + (if (looking-at "\\s-*$") (delete-region (point) (point-at-eol)) (open-line 1)) (org-indent-line) (insert "# "))) @@ -22513,70 +22523,70 @@ If the line is empty, insert comment at its beginning." (defun org-comment-or-uncomment-region (beg end &rest ignore) "Comment or uncomment each non-blank line in the region. Uncomment each non-blank line between BEG and END if it only -contains commented lines. Otherwise, comment them." - (let* ((pt (point-marker)) - (head (and (org-in-src-block-p t) - (require 'ob-core) - (org-babel-where-is-src-block-head))) - (foot (and head - (save-excursion - (goto-char head) - (looking-at org-babel-src-block-regexp) - (goto-char (match-end 0)) - (point-at-bol))))) - (if (and head foot - (> beg head) - (< end foot)) - (org-babel-do-in-edit-buffer - (call-interactively #'comment-dwim)) - (save-restriction - ;; Restrict region - (narrow-to-region (save-excursion (goto-char beg) - (skip-chars-forward " \r\t\n" end) - (line-beginning-position)) - (save-excursion (goto-char end) - (skip-chars-backward " \r\t\n" beg) - (line-end-position))) - (let ((uncommentp - ;; UNCOMMENTP is non-nil when every non blank line between - ;; BEG and END is a comment. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) - (let ((element (org-element-at-point))) - (and (eq (org-element-type element) 'comment) - (goto-char (min (point-max) - (org-element-property - :end element))))))) - (eobp)))) - (if uncommentp - ;; Only blank lines and comments in region: uncomment it. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") - (replace-match "" nil nil nil 1)) - (forward-line))) - ;; Comment each line in region. - (let ((min-indent (point-max))) - ;; First find the minimum indentation across all lines. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) (not (zerop min-indent))) - (unless (looking-at "[ \t]*$") - (setq min-indent (min min-indent (current-indentation)))) - (forward-line))) - ;; Then loop over all lines. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) - ;; Don't get fooled by invisible text (e.g. link path) - ;; when moving to column MIN-INDENT. - (let ((buffer-invisibility-spec nil)) - (org-move-to-column min-indent t)) - (insert comment-start)) - (forward-line)))))))))) +contains commented lines. Otherwise, comment them. If region is +strictly within a source block, use appropriate comment syntax." + (if (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'src-block) + (< (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (line-end-position)) + beg) + (>= (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)) + end))) + (progn + (require 'ob-core) + (org-babel-do-in-edit-buffer (call-interactively #'comment-dwim))) + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) + (let ((uncommentp + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + ;; Don't get fooled by invisible text (e.g. link path) + ;; when moving to column MIN-INDENT. + (let ((buffer-invisibility-spec nil)) + (org-move-to-column min-indent t)) + (insert comment-start)) + (forward-line))))))))) ;;; Planning diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 0e068dd10..f4672ebb3 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -96,7 +96,25 @@ (equal "# \n#+KEYWORD: value" (org-test-with-temp-text "#+KEYWORD: value" (progn (call-interactively 'comment-dwim) - (buffer-string)))))) + (buffer-string))))) + ;; In a source block, use appropriate syntax. + (should + (equal " ;; " + (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\n\n#+END_SRC" + (forward-line) + (let ((org-edit-src-content-indentation 2)) + (call-interactively 'comment-dwim)) + (buffer-substring-no-properties (line-beginning-position) (point))))) + (should + (equal "#+BEGIN_SRC emacs-lisp\n ;; a\n ;; b\n#+END_SRC" + (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\na\nb\n#+END_SRC" + (forward-line) + (transient-mark-mode 1) + (push-mark (point) t t) + (forward-line 2) + (let ((org-edit-src-content-indentation 2)) + (call-interactively 'comment-dwim)) + (buffer-string))))) From 8255286e221dffe3feae9e7e4f2573772b2e56ee Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 4 Nov 2013 18:16:28 +0100 Subject: [PATCH 047/166] org-element: Small refactoring * lisp/org-element.el (org-element-item-parser, org-element-plain-list-parser): Remove dependencies on org-list library. --- lisp/org-element.el | 25 +++++++++++++++---------- 1 file changed, 15 insertions(+), 10 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 9b5257438..2b669ebb8 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1063,9 +1063,9 @@ Assume point is at the beginning of the item." 64)) ((string-match "[0-9]+" c) (string-to-number (match-string 0 c))))))) - (end (save-excursion (goto-char (org-list-get-item-end begin struct)) - (unless (bolp) (forward-line)) - (point))) + (end (progn (goto-char (nth 6 (assq (point) struct))) + (unless (bolp) (forward-line)) + (point))) (contents-begin (progn (goto-char ;; Ignore tags in un-ordered lists: they are just @@ -1240,15 +1240,20 @@ containing `:type', `:begin', `:end', `:contents-begin' and Assume point is at the beginning of the list." (save-excursion (let* ((struct (or structure (org-element--list-struct limit))) - (prevs (org-list-prevs-alist struct)) - (type (org-list-get-list-type (point) struct prevs)) + (type (cond ((org-looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) + ((nth 5 (assq (point) struct)) 'descriptive) + (t 'unordered))) (contents-begin (point)) (begin (car affiliated)) - (contents-end - (progn (goto-char (org-list-get-list-end (point) struct prevs)) - (unless (bolp) (forward-line)) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) + (contents-end (let* ((item (assq contents-begin struct)) + (ind (nth 1 item)) + (pos (nth 6 item))) + (while (and (setq item (assq pos struct)) + (= (nth 1 item) ind)) + (setq pos (nth 6 item))) + pos)) + (end (progn (goto-char contents-end) + (skip-chars-forward " \r\t\n" limit) (if (= (point) limit) limit (line-beginning-position))))) ;; Return value. (list 'plain-list From 8403332dbc6f364acf61a9a7f4f8ca25e17fb682 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 4 Nov 2013 19:28:07 +0100 Subject: [PATCH 048/166] org-element: Fix bug in cache * lisp/org-element.el (org-element--cache-sync): Modifying blank lines at the end of a list or a footnote definition no longer corrupt cache. --- lisp/org-element.el | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 2b669ebb8..f6343b8ff 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -5038,8 +5038,23 @@ removed from the cache." ((>= key beg) (remhash key org-element--cache)) ;; Preserve any element ending before BEG. If it ;; overlaps the BEG-END area, remove it. - (t (or (< (org-element-property :end (car value)) beg) - (remhash key org-element--cache))))) + (t + (when (let ((element (car value))) + (or (>= (org-element-property :end element) beg) + ;; Special case: footnote definitions and + ;; plain lists can end with blank lines. + ;; Modifying those can also alter last + ;; element inside. We must therefore + ;; remove these elements from cache. + (let ((parent + (org-element-property :parent element))) + (and (memq (org-element-type parent) + '(footnote-definition plain-list)) + (>= (org-element-property :end parent) beg) + (= (org-element-property :contents-end + parent) + (org-element-property :end element)))))) + (remhash key org-element--cache))))) org-element--cache) ;; Signal cache as up-to-date. (org-element--cache-cancel-changes)))))) From 1fad782491d5065a39695c6668072775138a6532 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 4 Nov 2013 23:36:18 +0100 Subject: [PATCH 049/166] org-agenda.el (org-agenda-drag-line-forward): Fix bugs * org-agenda.el (org-agenda-drag-line-forward) (org-agenda-drag-line-backward): Fix bugs: don't drag lines without text and don't drag lines before/after hidden lines. Thanks to Thomas Morgan for reporting bugs in this area. --- lisp/org-agenda.el | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 8cfe858ff..bd19cc504 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -9913,11 +9913,12 @@ current HH:MM time." "Drag an agenda line forward by ARG lines." (interactive "p") (let ((inhibit-read-only t) lst) - (if (save-excursion - (dotimes (n arg) - (beginning-of-line 2) - (push (not (get-text-property (point) 'txt)) lst)) - (delq nil lst)) + (if (or (not (get-text-property (point) 'txt)) + (save-excursion + (dotimes (n arg) + (move-beginning-of-line 2) + (push (not (get-text-property (point) 'txt)) lst)) + (delq nil lst))) (message "Cannot move line forward") (org-drag-line-forward arg)))) @@ -9925,11 +9926,12 @@ current HH:MM time." "Drag an agenda line backward by ARG lines." (interactive "p") (let ((inhibit-read-only t) lst) - (if (save-excursion - (dotimes (n arg) - (beginning-of-line 0) - (push (not (get-text-property (point) 'txt)) lst)) - (delq nil lst)) + (if (or (not (get-text-property (point) 'txt)) + (save-excursion + (dotimes (n arg) + (move-beginning-of-line 0) + (push (not (get-text-property (point) 'txt)) lst)) + (delq nil lst))) (message "Cannot move line backward") (org-drag-line-backward arg)))) From e63b87a46f4f3b2649a264f24b1114d709426d2a Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 5 Nov 2013 00:05:33 +0100 Subject: [PATCH 050/166] org.el (org-open-file): Reveal context around point MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * org.el (org-open-file): Reveal context around point when opening a link to an Org file with a line number. Thanks to François Pinard for suggesting this. --- lisp/org.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 539ed3c94..4debf3d14 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11086,7 +11086,9 @@ If the file does not exist, an error is thrown." (eq cmd 'emacs)) (funcall (cdr (assq 'file org-link-frame-setup)) file) (widen) - (if line (org-goto-line line) + (if line (progn (org-goto-line line) + (if (derived-mode-p 'org-mode) + (org-reveal))) (if search (org-link-search search)))) ((consp cmd) (let ((file (convert-standard-filename file))) From 08d93aa2d5b51e0efd181149a9fe26de81fc3b42 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 5 Nov 2013 00:14:03 +0100 Subject: [PATCH 051/166] contrib/lisp/ox-rss.el: Enhance RFC822 formatting string * contrib/lisp/ox-rss.el (org-rss-headline) (org-rss-build-channel-info): Use %b instead of %h for RFC822 dates. Thanks to Andrea Rossetti for reporting this. --- contrib/lisp/ox-rss.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el index 9b8437fe3..2777e02a4 100644 --- a/contrib/lisp/ox-rss.el +++ b/contrib/lisp/ox-rss.el @@ -236,7 +236,7 @@ communication channel." (pubdate (let ((system-time-locale "C")) (format-time-string - "%a, %d %h %Y %H:%M:%S %z" + "%a, %d %b %Y %H:%M:%S %z" (org-time-string-to-time (or (org-element-property :PUBDATE headline) (error "Missing PUBDATE property")))))) @@ -308,7 +308,7 @@ as a communication channel." (author (and (plist-get info :with-author) (let ((auth (plist-get info :author))) (and auth (org-export-data auth info))))) - (date (format-time-string "%a, %d %h %Y %H:%M:%S %z")) ;; RFC 882 + (date (format-time-string "%a, %d %b %Y %H:%M:%S %z")) ;; RFC 882 (description (org-export-data (plist-get info :description) info)) (lang (plist-get info :language)) (keywords (plist-get info :keywords)) From a2c71a6e359cb93aa652f65c666294fb2a3b5e1b Mon Sep 17 00:00:00 2001 From: Rick Frankel Date: Tue, 5 Nov 2013 12:07:41 +0100 Subject: [PATCH 052/166] org-table.el (org-table-recalculate): Generate user error if an hline relative reference is use on the LHS of a formula * org-table.el (org-table-recalculate): Generate user error if an hline relative reference is use on the LHS of a formula. TINYCHANGE --- lisp/org-table.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/org-table.el b/lisp/org-table.el index 7be77ccba..7024178ad 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -3016,6 +3016,8 @@ known that the table will be realigned a little later anyway." ;; Insert constants in all formulas (setq eqlist (mapcar (lambda (x) + (if (string-match "^@-?I+" (car x)) + (user-error "Can't assign to hline relative reference")) (when (string-match "\\`$[<>]" (car x)) (setq lhs1 (car x)) (setq x (cons (substring From 6c48056b2bc46038f123e275ec44af384785e886 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 5 Nov 2013 12:13:46 +0100 Subject: [PATCH 053/166] Some clean-up related to org-remember being removed * org.el (org-directory, org-default-notes-file) (org-reverse-note-order): Don't use the `org-remember' customization group. (org-require-autoloaded-modules): Don't require `org-remember'. * org-capture.el: Update commentary section to reflect the fact that org-remember.el is not used anymore. --- lisp/org-capture.el | 8 ++++---- lisp/org.el | 9 +++------ 2 files changed, 7 insertions(+), 10 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 0a6e4e462..871382d65 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -24,14 +24,14 @@ ;; ;;; Commentary: -;; This file contains an alternative implementation of the same functionality -;; that is also provided by org-remember.el. The implementation is more +;; This file contains an alternative implementation of the functionality +;; that used to be provided by org-remember.el. The implementation is more ;; streamlined, can produce more target types (e.g. plain list items or ;; table lines). Also, it does not use a temporary buffer for editing ;; the captured entry - instead it uses an indirect buffer that visits ;; the new entry already in the target buffer (this was an idea by Samuel -;; Wales). John Wiegley's excellent `remember.el' is not needed for this -;; implementation, even though we borrow heavily from its ideas. +;; Wales). John Wiegley's excellent `remember.el' is not needed anymore +;; for this implementation, even though we borrow heavily from its ideas. ;; This implementation heavily draws on ideas by James TD Smith and ;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. diff --git a/lisp/org.el b/lisp/org.el index afd7b212f..6ff655bf4 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -2054,16 +2054,14 @@ following situations: note buffer with `C-1 C-c C-c'. The user is prompted for an org file, with `org-directory' as the default path." :group 'org-refile - :group 'org-remember :group 'org-capture :type 'directory) (defcustom org-default-notes-file (convert-standard-filename "~/.notes") "Default target for storing notes. -Used as a fall back file for org-remember.el and org-capture.el, for -templates that do not specify a target file." +Used as a fall back file for org-capture.el, for templates that +do not specify a target file." :group 'org-refile - :group 'org-remember :group 'org-capture :type '(choice (const :tag "Default from remember-data-file" nil) @@ -2093,7 +2091,6 @@ outline-path-completion Headlines in the current buffer are offered via When nil, new notes will be filed to the end of a file or entry. This can also be a list with cons cells of regular expressions that are matched against file names, and values." - :group 'org-remember :group 'org-capture :group 'org-refile :type '(choice @@ -21082,7 +21079,7 @@ Your bug report will be posted to the Org-mode mailing list. (interactive) (mapc 'require '(org-agenda org-archive org-attach org-clock org-colview org-id - org-remember org-table org-timer))) + org-table org-timer))) ;;;###autoload (defun org-reload (&optional uncompiled) From c1eff607b85312eac2d5be3789ffb3e3aed71e06 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 5 Nov 2013 17:26:46 +0100 Subject: [PATCH 054/166] ox-odt.el (org-odt-table-style-format): Use %s for inserting the rel-width property as a string * ox-odt.el (org-odt-table-style-format): Use %s for inserting the rel-width property as a string. (org-odt-template): Fall back on a string for :rel-width. Thanks to Derek Feichtinger for reporting this bug. --- lisp/ox-odt.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index a0f8114e7..07f6889ae 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -223,7 +223,7 @@ standard Emacs.") (defconst org-odt-table-style-format " - + " "Template for auto-generated Table styles.") @@ -1456,7 +1456,7 @@ original parsed data. INFO is a plist holding export options." ;; - Dump automatic table styles. (loop for (style-name props) in (plist-get org-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) 96)) + (when (setq props (or (plist-get props :rel-width) "96")) (insert (format org-odt-table-style-format style-name props)))) ;; - Dump date-styles. (when org-odt-use-date-fields From 15d1709b1926bdb725c16215d7df6635cb9236ba Mon Sep 17 00:00:00 2001 From: Oleh Date: Tue, 5 Nov 2013 19:14:55 +0100 Subject: [PATCH 055/166] org.el (org-use-speed-commands): Enhance docstring * org.el (org-use-speed-commands): Enhance docstring. TINYCHANGE --- lisp/org.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 2733480e6..4d054eed2 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1010,7 +1010,13 @@ new-frame Make a new frame each time. Note that in this case (defcustom org-use-speed-commands nil "Non-nil means activate single letter commands at beginning of a headline. This may also be a function to test for appropriate locations where speed -commands should be active." +commands should be active. + +For example, to activate speed commands when the point is on any +star at the beginning of the headline, you can do this: + + (setq org-use-speed-commands + (lambda () (and (looking-at org-outline-regexp) (looking-back \"^\\**\"))))" :group 'org-structure :type '(choice (const :tag "Never" nil) From 8ae106907af2b43f6b5f8cd1bb8753d28bf56afc Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 5 Nov 2013 19:41:41 +0100 Subject: [PATCH 056/166] org-agenda.el (org-agenda-filter-make-matcher): Fix regression * org-agenda.el (org-agenda-filter-make-matcher): When filtering tags and hitting space, filter out entries with tags, only keep those without tags. Thanks to Serguei Son for reporting this regression. --- lisp/org-agenda.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index bd19cc504..16f1b4d78 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7529,9 +7529,11 @@ to switch to narrowing." (if notgroup (push (cons 'and nf0) f) (push (cons (or op 'or) nf0) f))))) - (if (equal nfilter filter) - (funcall ffunc f1 f filter t nil) - (funcall ffunc nf1 nf nfilter nil nil))))) + (cond ((equal filter '("+")) + (setq f (list (list 'not 'tags)))) + ((equal nfilter filter) + (funcall ffunc f1 f filter t nil)) + (t (funcall ffunc nf1 nf nfilter nil nil)))))) ;; Category filter ((eq type 'category) (setq filter From 4223af978a3d194797e741cd76f927803d035d91 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 5 Nov 2013 20:47:29 +0100 Subject: [PATCH 057/166] org-footnote: Fix void `org-element-cache-reset' symbol error * lisp/org-footnote.el (org-footnote-section): Fix void `org-element-cache-reset' symbol error. --- lisp/org-footnote.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index c59bd0c99..e80f36fde 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -114,7 +114,10 @@ you will need to run the following command after the change: \\[universal-argument] \\[org-element-cache-reset]" :group 'org-footnote :initialize 'custom-initialize-set - :set (lambda (var val) (set var val) (org-element-cache-reset 'all)) + :set (lambda (var val) + (set var val) + (when (fboundp 'org-element-cache-reset) + (org-element-cache-reset 'all))) :type '(choice (string :tag "Collect footnotes under heading") (const :tag "Define footnotes locally" nil))) From 06ae4f07a1c5cfd4f89a96b74234751c7e9453c5 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 5 Nov 2013 21:54:12 +0100 Subject: [PATCH 058/166] org.el (org-insert-link): Don't remove brackets when they belong to a timestamp in a headline * org.el (org-insert-link): Don't remove brackets when they belong to a timestamp in a headline. Thanks to David Belohrad for spotting this. --- lisp/org.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 6ff655bf4..7b68ba197 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -10013,7 +10013,8 @@ Use TAB to complete link prefixes, then RET for type-specific completion support (setq org-stored-links (delq (assoc link org-stored-links) org-stored-links))) - (if (string-match org-plain-link-re link) + (if (and (string-match org-plain-link-re link) + (not (string-match org-ts-regexp link))) ;; URL-like link, normalize the use of angular brackets. (setq link (org-remove-angle-brackets link))) From 2911965bfef9072a3031d48dfe2ea50bcb3ff9df Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 6 Nov 2013 09:59:46 +0100 Subject: [PATCH 059/166] org-agenda: Fix bug when showing the new time * org-agenda.el (org-agenda-show-new-time): Ignore invisible text when inserting the new time as a text property. * org-compat.el (org-move-to-column): New argument `ignore-invisible' to turn on `buffer-invisibility-spec'. Thanks to Marcin Borkowski and Karl Voit for reporting this. --- lisp/org-agenda.el | 2 +- lisp/org-compat.el | 6 ++---- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 16f1b4d78..fedbbe72e 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -9149,7 +9149,7 @@ Called with a universal prefix arg, show the priority instead of setting it." (goto-char (point-max)) (while (not (bobp)) (when (equal marker (org-get-at-bol 'org-marker)) - (org-move-to-column (- (window-width) (length stamp)) t) + (org-move-to-column (- (window-width) (length stamp)) t nil t) (org-agenda-fix-tags-filter-overlays-at (point)) (if (featurep 'xemacs) ;; Use `duplicable' property to trigger undo recording diff --git a/lisp/org-compat.el b/lisp/org-compat.el index c4d15d8e6..b714f13a6 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -335,10 +335,8 @@ Works on both Emacs and XEmacs." (org-xemacs-without-invisibility (indent-line-to column)) (indent-line-to column))) -(defun org-move-to-column (column &optional force buffer) - ;; set buffer-invisibility-spec to nil so that move-to-column - ;; does the right thing despite the presence of invisible text. - (let ((buffer-invisibility-spec nil)) +(defun org-move-to-column (column &optional force buffer ignore-invisible) + (let ((buffer-invisibility-spec ignore-invisible)) (if (featurep 'xemacs) (org-xemacs-without-invisibility (move-to-column column force buffer)) (move-to-column column force)))) From 747f46aa1f94fc8375fddd3620e15b9b0c0ff86e Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 6 Nov 2013 15:51:57 +0100 Subject: [PATCH 060/166] org-capture: Fix bug when capturing with templates using `function' * org-capture.el (org-capture): Store :return-to-wconf earlier. (org-capture-place-template): Don't store :return-to-wconf when called from a capture template using `function', rely on the early :return-to-wconf value store from `org-capture'. Thanks to Brett Viren for raising this issue. --- lisp/org-capture.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 871382d65..804539eb2 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -577,8 +577,9 @@ of the day at point (if any) or the current HH:MM time." (file-name-nondirectory (buffer-file-name orig-buf))) :annotation annotation - :initial initial) - (org-capture-put :default-time + :initial initial + :return-to-wconf (current-window-configuration) + :default-time (or org-overriding-default-time (org-current-time))) (org-capture-set-target-location) @@ -593,7 +594,8 @@ of the day at point (if any) or the current HH:MM time." ;;insert at point (org-capture-insert-template-here) (condition-case error - (org-capture-place-template) + (org-capture-place-template + (equal (car (org-capture-get :target)) 'function)) ((error quit) (if (and (buffer-base-buffer (current-buffer)) (string-match "\\`CAPTURE-" (buffer-name))) @@ -986,9 +988,12 @@ it. When it is a variable, retrieve the value. Return whatever we get." (ignore-errors (org-set-local (car v) (cdr v)))) (buffer-local-variables buffer))) -(defun org-capture-place-template () - "Insert the template at the target location, and display the buffer." - (org-capture-put :return-to-wconf (current-window-configuration)) +(defun org-capture-place-template (&optional inhibit-wconf-store) + "Insert the template at the target location, and display the buffer. +When `inhibit-wconf-store', don't store the window configuration, as it +may have been stored before." + (unless inhibit-wconf-store + (org-capture-put :return-to-wconf (current-window-configuration))) (delete-other-windows) (org-switch-to-buffer-other-window (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) From 4c94c4d062ce7aa28bc21301ec34857745029f5c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 6 Nov 2013 15:26:53 +0100 Subject: [PATCH 061/166] ox-html: Add TODO keyword to TOC entries * lisp/ox-html.el (org-html--format-toc-headline): TOC entries are closer to regular headline formatting. --- lisp/ox-html.el | 52 +++++++++++++++++++++++++++---------------------- 1 file changed, 29 insertions(+), 23 deletions(-) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index afc2437dd..c47cc8610 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -1969,34 +1969,40 @@ and value is its relative level, as an integer." (defun org-html--format-toc-headline (headline info) "Return an appropriate table of contents entry for HEADLINE. INFO is a plist used as a communication channel." - (let* ((headline-number (org-export-get-headline-number headline info)) - (section-number - (and (not (org-export-low-level-p headline info)) - (org-export-numbered-headline-p headline info) - (concat (mapconcat 'number-to-string headline-number ".") ". "))) + (let* ((todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data-with-backend + (org-export-get-alt-title headline info) + ;; Create an anonymous back-end that will ignore any + ;; footnote-reference, link, radio-target and target + ;; in table of contents. + (org-export-create-backend + :parent 'html + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) + info)) (tags (and (eq (plist-get info :with-tags) t) (org-export-get-tags headline info)))) (format "%s" - ;; Label. (org-export-solidify-link-text (or (org-element-property :CUSTOM_ID headline) - (concat "sec-" (mapconcat 'number-to-string - headline-number "-")))) - ;; Body. - (concat section-number - (org-export-data-with-backend - (org-export-get-alt-title headline info) - ;; Create an anonymous back-end that will ignore - ;; any footnote-reference, link, radio-target and - ;; target in table of contents. - (org-export-create-backend - :parent 'html - :transcoders '((footnote-reference . ignore) - (link . (lambda (object c i) c)) - (radio-target . (lambda (object c i) c)) - (target . ignore))) - info) - (and tags "   ") (org-html--tags tags))))) + (concat "sec-" + (mapconcat + #'number-to-string + (org-export-get-headline-number headline info) + "-")))) + (apply (if (functionp org-html-format-headline-function) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags)) + #'org-html-format-headline) + todo todo-type priority text tags :section-number nil)))) (defun org-html-list-of-listings (info) "Build a list of listings. From fe3379bda6ca23474639b114592958bf14431c88 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 6 Nov 2013 16:15:45 +0100 Subject: [PATCH 062/166] org.el (org-agenda-prepare-buffers): Restore the point position * org.el (org-agenda-prepare-buffers): Restore the point position. Thanks to Samuel Wales for spotting this. --- lisp/org.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 7b68ba197..2b5e3d056 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18052,10 +18052,10 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (inhibit-read-only t) (org-inhibit-startup org-agenda-inhibit-startup) (rea (concat ":" org-archive-tag ":")) - file re) + file re pos) (setq org-tag-alist-for-agenda nil org-tag-groups-alist-for-agenda nil) - (save-excursion + (save-window-excursion (save-restriction (while (setq file (pop files)) (catch 'nextfile @@ -18065,6 +18065,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved (set-buffer (org-get-agenda-file-buffer file))) (widen) (org-set-regexps-and-options-for-tags) + (setq pos (point)) (goto-char (point-min)) (let ((case-fold-search t)) (when (search-forward "#+setupfile" nil t) @@ -18108,7 +18109,8 @@ When a buffer is unmodified, it is just killed. When modified, it is saved org-comment-string)) (while (re-search-forward re nil t) (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc)))))))) + (match-beginning 0) (org-end-of-subtree t) pc)))) + (goto-char pos))))) (setq org-todo-keywords-for-agenda (org-uniquify org-todo-keywords-for-agenda)) (setq org-todo-keyword-alist-for-agenda From 47b0eec8dc39990731f400640d64ab70a8356ccd Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 6 Nov 2013 16:26:38 +0100 Subject: [PATCH 063/166] org-capture.el (org-capture-refile): Don't finalize prematurely * org-capture.el (org-capture-refile): Don't finalize prematurely. Thanks to Rodrigo Amestica for reporting this. --- lisp/org-capture.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 804539eb2..39804ac3c 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -789,14 +789,14 @@ already gone. Any prefix argument will be passed to the refile command." (let ((pos (point)) (base (buffer-base-buffer (current-buffer))) (org-refile-for-capture t)) - (org-capture-finalize) (save-window-excursion (with-current-buffer (or base (current-buffer)) (save-excursion (save-restriction (widen) (goto-char pos) - (call-interactively 'org-refile))))))) + (call-interactively 'org-refile))))) + (org-capture-finalize))) (defun org-capture-kill () "Abort the current capture process." From 4c04c13a189e6f6729d1ee9adae346ffc30522c4 Mon Sep 17 00:00:00 2001 From: Jonas Hoersch Date: Wed, 30 Oct 2013 15:39:33 +0100 Subject: [PATCH 064/166] org-inlinetask: Hide inline tasks in 'children visibility state * lisp/org.el (org-cycle-hide-inline-tasks): Re-hide inline tasks when switching to 'children visibility state. TINYCHANGE --- lisp/org.el | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 2b5e3d056..7042d69c7 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7071,11 +7071,19 @@ open and agenda-wise Org files." (org-flag-drawer t)))))) (defun org-cycle-hide-inline-tasks (state) - "Re-hide inline task when switching to 'contents visibility state." - (when (and (eq state 'contents) - (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level) - (hide-sublevels (1- org-inlinetask-min-level)))) + "Re-hide inline tasks when switching to 'contents or 'children +visibility state." + (case state + (contents + (when (org-bound-and-true-p org-inlinetask-min-level) + (hide-sublevels (1- org-inlinetask-min-level)))) + (children + (when (featurep 'org-inlinetask) + (save-excursion + (while (and (outline-next-heading) + (org-inlinetask-at-task-p)) + (org-inlinetask-toggle-visibility) + (org-inlinetask-goto-end))))))) (defun org-flag-drawer (flag) "When FLAG is non-nil, hide the drawer we are within. From 92f89eedbad33376ffbcc383f1167f8bfa11ca05 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 6 Nov 2013 19:14:14 +0100 Subject: [PATCH 065/166] ox-org: Fix headline level during subtree export * lisp/org-element.el (org-element-headline-interpreter): Take into consideration `org-odd-levels-only' when building a headline. * lisp/ox-org.el (org-org-headline): Correctly set transcoded headline level during subtree export. --- lisp/org-element.el | 2 +- lisp/ox-org.el | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index c148cacfa..f70828a12 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -868,7 +868,7 @@ CONTENTS is the contents of the element." (commentedp (org-element-property :commentedp headline)) (quotedp (org-element-property :quotedp headline)) (pre-blank (or (org-element-property :pre-blank headline) 0)) - (heading (concat (make-string level ?*) + (heading (concat (make-string (org-reduced-level level) ?*) (and todo (concat " " todo)) (and quotedp (concat " " org-quote-string)) (and commentedp (concat " " org-comment-string)) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 022474a82..41798b3e1 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -130,6 +130,8 @@ CONTENTS is its contents, as a string or nil. INFO is ignored." (org-element-put-property headline :tags nil)) (unless (plist-get info :with-priority) (org-element-put-property headline :priority nil)) + (org-element-put-property headline :level + (org-export-get-relative-level headline info)) (org-element-headline-interpreter headline contents)) (defun org-org-keyword (keyword contents info) From 2b25b5d978b3ab5abe42afa4808438f895176c82 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Thu, 7 Nov 2013 20:25:38 +0100 Subject: [PATCH 066/166] test-org-table: Replace hline lhs expression in table formula * testing/lisp/test-org-table.el: Replace hline lhs expression in table formula with relative row expression. This fixes a test fail introduced by a2c71a6e35. The failing test does not check relative hline references, so it should not rely on undocumented behaviour. --- testing/lisp/test-org-table.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el index 5386726bc..e78e56ba0 100644 --- a/testing/lisp/test-org-table.el +++ b/testing/lisp/test-org-table.el @@ -421,7 +421,7 @@ reference (with row). Mode string N." " 1 ;; Compare field reference ($1) with field reference (@1) - "#+TBLFM: @I$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E" + "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E" ;; Compare field reference ($1) with absolute term (concat "#+TBLFM: " "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: " From b21c5fa2724ea3a0efc073f7231cce6349a397cf Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 8 Nov 2013 08:54:52 +0100 Subject: [PATCH 067/166] ox-latex: Remove all temporary files when compiling * lisp/ox-latex.el (org-latex-compile): Remove all numbered temporary files after compiling. --- lisp/ox-latex.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 339f5a3fd..1da7f9bbc 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -2852,9 +2852,13 @@ Return PDF file name or an error if it couldn't be produced." ;; Else remove log files, when specified, and signal end of ;; process to user, along with any error encountered. (when (and (not snippet) org-latex-remove-logfiles) - (dolist (ext org-latex-logfiles-extensions) - (let ((file (concat out-dir base-name "." ext))) - (when (file-exists-p file) (delete-file file))))) + (dolist (file (directory-files + out-dir t + (concat (regexp-quote base-name) + "\\(?:\\.[0-9]+\\)?" + "\\." + (regexp-opt org-latex-logfiles-extensions)))) + (delete-file file))) (message (concat "Process completed" (if (not errors) "." (concat " with errors: " errors))))) From f31eb421d6856f9fa6fed1364a4809fd423925c2 Mon Sep 17 00:00:00 2001 From: Marc-Oliver Ihm Date: Fri, 8 Nov 2013 20:53:38 +0100 Subject: [PATCH 068/166] Small change to org-index.el to reflect the new location of org-index.el --- contrib/lisp/org-index.el | 3887 ++++++++++++++++++------------------- 1 file changed, 1943 insertions(+), 1944 deletions(-) diff --git a/contrib/lisp/org-index.el b/contrib/lisp/org-index.el index 8293a329a..a670cd68b 100644 --- a/contrib/lisp/org-index.el +++ b/contrib/lisp/org-index.el @@ -1,1944 +1,1943 @@ -;;; org-index.el --- A personal index for org and beyond - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Marc Ihm -;; Keywords: hypermedia, matching -;; Requires: org -;; Download: http://orgmode.org/worg/code/elisp/org-index.el -;; Version: 2.3.2 - -;; This file is not part of GNU Emacs. - -;;; License: - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary: - -;; Purpose: -;; -;; Mark and find your favorite org-locations and other points of interest -;; easily; create and update a lookup table of references and links. When -;; searching, frequently used entries appear at the the top and entering -;; some keywords narrows down to matching entries only; so the right one -;; can be spotted easily. -;; -;; References are essentially small numbers (e.g. "R237" or "-455-"), -;; which are created by this package; they are well suited to be used -;; outside org. Links are normal org-mode links. -;; -;; Setup: -;; -;; - Add these lines to your .emacs: -;; -;; (require 'org-index) -;; -;; ;; Optionally assign a key. Pick your own. -;; (global-set-key (kbd "C-+") 'org-index) -;; -;; - Invoke `org-index', which will assist you to create your -;; index table. -;; -;; - Do not forget to restart emacs to make these lines effective. -;; -;; -;; Further reading: -;; -;; See the documentation of `org-index', which can also be read -;; by invoking `org-index' and and choosing the help-command. -;; -;; For more documentation and working examples, see: -;; -;; http://orgmode.org/worg/org-contrib/org-index.html -;; - -;;; Change Log: - -;; [2013-10-04 Fr] Version 2.3.2: -;; - Bugfix: index-table created by assistant is found after -;; restart of emacs instead of invoking assistent again -;; -;; [2013-07-20 Sa] Version 2.3.0: -;; - Renamed from "org-favtable" to "org-index" -;; - Added an assistent to set up the index table -;; - occur is now incremental, searching as you type -;; - simplified the documentation and help-system -;; - Saving keystrokes, as "+g237" is now valid input -;; - Many bugfixes -;; -;; [2013-02-28 Th] Version 2.2.0: -;; - Allowed shortcuts like "h237" for command "head" with argument "237" -;; - Integrated with org-mark-ring-goto -;; -;; [2013-01-25 Fr] Version 2.1.0: -;; - Added full support for links -;; - New commands "missing" and "statistics" -;; - Renamed the package from "org-reftable" to "org-favtable" -;; - Additional columns are required (e.g. "link"). Error messages will -;; guide you -;; -;; [2012-12-07 Fr] Version 2.0.0: -;; - The format of the table of favorites has changed ! You need to bring -;; your existing table into the new format by hand (which however is -;; easy and explained below) -;; - Reference table can be sorted after usage count or date of last access -;; - Ask user explicitly, which command to invoke -;; - Renamed the package from "org-refer-by-number" to "org-reftable" - -;; [2012-09-22 Sa] Version 1.5.0: -;; - New command "sort" to sort a buffer or region by reference number -;; - New commands "highlight" and "unhighlight" to mark references - -;; [2012-07-13 Fr] Version 1.4.0: -;; - New command "head" to find a headline with a reference number - -;; [2012-04-28 Sa] Version 1.3.0: -;; - New commands occur and multi-occur -;; - All commands can now be invoked explicitly -;; - New documentation -;; - Many bugfixes - -;; [2011-12-10 Sa] Version 1.2.0: -;; - Fixed a bug, which lead to a loss of newly created reference numbers -;; - Introduced single and double prefix arguments -;; - Started this Change Log - -;;; Code: - -(require 'org-table) -(require 'cl) - -(defvar org-index--preferred-command nil) - -(defvar org-index--commands - '(occur head ref link leave enter goto help + reorder fill sort update highlight unhighlight missing statistics) - "List of commands known to org-index.") - -(defvar org-index--commands-some '(occur head ref link leave enter goto help +)) - - -(defvar org-index--columns nil) - -(defcustom org-index-id nil - "Id of the Org-mode node, which contains the index table." - :group 'org - :group 'org-index) - - -(defvar org-index--text-to-yank nil) -(defvar org-index--last-action nil) -(defvar org-index--ref-regex nil) -(defvar org-index--ref-format nil) -(defvar org-index--buffer nil "buffer of index table") -(defvar org-index--point nil "position at start of headline of index table") -(defvar org-index--below-hline nil "position of first cell in first line below hline") -(defvar org-index--point-before nil "point in buffer with index table") - - -(defun org-index (&optional ARG) - "Mark and find your favorite things and org-locations easily: -Create and update a lookup table of references and links. Often -used entries bubble to the top; entering some keywords narrows -down to matching entries only, so that the right one can be -spotted easily. - -References are essentially small numbers (e.g. \"R237\" or \"-455-\"), -which are created by this package; they are well suited to be used -outside of org. Links are normal org-mode links. - -This is version 2.3.2 of org-index. - -The function `org-index' operates on a dedicated table, the index -table, which lives within its own Org-mode node. The table and -its node will be created, when you first invoke org-index. - -Each line in the index table contains: - - - A reference - - - A link - - - A number; counting, how often each reference has been - used. This number is updated automatically and the table can - be sorted after it, so that most frequently used references - appear at the top of the table and can be spotted easily. - - - The creation date of the line. - - - Date and time of last access. This column can alternatively be - used to sort the table. - - - A column for your own comments, which allows lines to be selected by - keywords. - -The index table is found through the id of the containing -node; this id is stored within `org-index-id'. - - -The function `org-index' is the only interactive function of this -package and its sole entry point; it offers several commands to -create, find and look up these favorites (references and links). - -Commands known: - - occur: Incremental search, that after each keystroke shows - matching lines from index table. You may enter a list of words - seperated by comma (\",\"), to select lines that contain all - of the given words. - - If you supply a number (e.g. \"237\"): Apply emacs standard - multi-occur operation on all org-mode buffers to search for - this specific reference. - - You may also read the note at the end of this help on saving - the keystroke RET with this frequent default command. - - head: If invoked outside the index table, ask for a - reference number and search for a heading containing it. If - invoked within index table dont ask; rather use the reference or - link from the current line. - - ref: Create a new reference, copy any previously selected text. - If already within index table, fill in ref-column. - - link: Create a new line in index table with a link to the - current node. Do not populate the ref column; this can later - be populated by calling the \"fill\" command from within the - index table. - - leave: Leave the index table. If the last command has - been \"ref\", the new reference is copied and ready to yank. - This \"org-mark-ring-goto\" and can be called several times - in succession. If you invoke org-index with a prefix argument, - this command \"leave\" is executed without further questions. - - enter: Just enter the node with the index table. - - goto: Search for a specific reference within the index table. - - help: Show this text. - - +: Show all commands including the less frequently used ones - given below. If \"+\" is followd by enough letters of such a - command (e.g. \"+fi\"), then this command is invoked - directly. - - reorder: Temporarily reorder the index table, e.g. by - count, reference or last access. - - fill: If either ref or link is missing, fill it. - - sort: Sort a set of lines (either the active region or the - whole buffer) by the references found in each line. - - update: For the given reference, update the line in the - index table. - - highlight: Highlight references in region or buffer. - - unhighlight: Remove highlights. - - missing : Search for missing reference numbers (which do not - appear in the reference table). If requested, add additional - lines for them, so that the command \"ref\" is able to reuse - them. - - statistics : Show some statistics (e.g. minimum and maximum - reference) about index table. - - - -Two ways to save keystrokes: - -When prompting for a command, org-index puts the most likely -one (e.g. \"occur\" or \"ref\") in front of the list, so that -you may just type RET. - -If this command needs additional input (like e.g. \"occur\"), you -may supply this input right away, although you are still beeing -prompted for the command. So, to do an occur for the string -\"foo\", you can just enter \"foo\" RET, without even typing -\"occur\". - - -Another way to save keystrokes applies if you want to choose a -command, that requrires a reference number (and would normally -prompt for it): In that case you may just enter enough characters -from your command, so that it appears first in the list of -matches; then immediately enter the number of the reference you -are searching for. So the input \"h237\" would execute the -command \"head\" for reference \"237\" right away. - -" - - (interactive "P") - - (org-index-1 (if (equal ARG '(4)) 'leave nil) ) -) - - -(defun org-index-1 (&optional what search search-is-link) -"Do the actual worg for org-index; its optional arguments are: - - search : string to search for - what : symbol of the command to invoke - search-is-link : t, if argument search is actually a link - -An example would be: - - (org-index \"237\" 'head) ;; find heading with ref 237 -" - (let (within-node ; True, if we are within node of the index table - active-window-index ; active window with index table (if any) - below-cursor ; word below cursor - active-region ; active region (if any) - link-id ; link of starting node, if required - guarded-search ; with guard against additional digits - search-is-ref ; true, if search is a reference - commands ; currently active set of selectable commands - what-adjusted ; True, if we had to adjust what - what-input ; Input on what question (need not necessary be "what") - trailing-digits ; any digits, that are are appended to what-input - reorder-once ; Column to use for single time sorting - parts ; Parts of a typical reference number (which - ; need not be a plain number); these are: - head ; Any header before number (e.g. "R") - maxref ; Maximum number from reference table (e.g. "153") - tail ; Tail after number (e.g. "}" or "") - ref-regex ; Regular expression to match a reference - has-reuse ; True, if table contains a line for reuse - numcols ; Number of columns in index table - kill-new-text ; Text that will be appended to kill ring - message-text ; Text that will be issued as an explanation, - ; what we have done - initial-ref-or-link ; Initial position in index table - ) - - ;; - ;; Examine current buffer and location, before turning to index table - ;; - - (unless (boundp 'org-index-id) - (setq org-index-id nil) - (org-index--create-new-index - t - (format "No index table has been created yet." org-index-id))) - - ;; Bail out, if new index has been created - (catch 'created-new-index - - ;; Get the content of the active region or the word under cursor - (if (and transient-mark-mode - mark-active) - (setq active-region (buffer-substring (region-beginning) (region-end)))) - (setq below-cursor (thing-at-point 'symbol)) - - - ;; Find out, if we are within favable or not - (setq within-node (string= (org-id-get) org-index-id)) - - - ;; - ;; Get decoration of references and highest reference from index table - ;; - - - ;; Save initial ref or link - (if (and within-node - (org-at-table-p)) - (setq initial-ref-or-link - (or (org-index--get-field 'ref) - (org-index--get-field 'link)))) - - ;; Find node - (let ((marker (org-id-find org-index-id 'marker)) initial) - (if marker - (progn - (setq org-index--buffer (marker-buffer marker) - org-index--point (marker-position marker)) - (move-marker marker nil)) - (org-index--create-new-index - t - (format "Cannot find node with id \"%s\"" org-index-id)))) - - ;; Check and remember, if active window contains buffer with index table - (if (eq (window-buffer) org-index--buffer) - (setq active-window-index (selected-window))) - - ;; Get configuration of index table; catch errors - (let ((error-message - (catch 'content-error - - (with-current-buffer org-index--buffer - (unless org-index--point-before - (setq org-index--point-before (point))) - - (unless (string= (org-id-get) org-index-id) - (goto-char org-index--point)) - - ;; parse table while still within buffer - (setq parts (org-index--parse-and-adjust-table)) - - ;; go back - (goto-char org-index--point-before) - - nil)))) - - (when error-message - (org-pop-to-buffer-same-window org-index--buffer) - (org-reveal) - (error error-message))) - - ;; Give names to parts of configuration - (setq head (nth 0 parts)) - (setq maxref (nth 1 parts)) - (setq tail (nth 2 parts)) - (setq numcols (nth 3 parts)) - (setq ref-regex (nth 4 parts)) - (setq has-reuse (nth 5 parts)) - (setq org-index--ref-regex ref-regex) - (setq org-index--ref-format (concat head "%d" tail)) - - ;; - ;; Find out, what we are supposed to do - ;; - - ;; Set preferred action, that will be the default choice - (setq org-index--preferred-command - (if within-node - (if (memq org-index--last-action '(ref link)) - 'leave - 'goto) - (if active-region - 'ref - (if (and below-cursor (string-match ref-regex below-cursor)) - 'occur - nil)))) - - ;; Ask user, what to do - (unless what - (setq commands (copy-list org-index--commands-some)) - (while (let (completions starts-with-plus is-only-plus) - - (setq what-input - (org-completing-read - "Please choose: " - (mapcar 'symbol-name - ;; Construct unique list of commands with - ;; preferred one at front - (delq nil (delete-dups - (append - (list org-index--preferred-command) - (copy-list commands))))) - nil nil)) - - ;; if input ends in digits, save them away and do completions on head of input - ;; this allows input like "h224" to be accepted - (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input) - ;; remember digits - (setq trailing-digits (string-to-number (match-string 2 what-input))) - ;; and use non-digits-part to find match - (setq what-input (match-string 1 what-input))) - - ;; if input starts with "+", any command (not only some) may follow - ;; this allows input like "+sort" to be accepted - (when (string= (substring what-input 0 1) "+") - ;; make all commands available for selection - (setq commands (copy-list org-index--commands)) - (setq what-input (substring what-input 1)) - (setq starts-with-plus (> (length what-input) 0)) - (setq is-only-plus (not starts-with-plus))) - - ;; get list of possible completions for what-input; i.e. - ;; all commands, that start with what-input - (setq completions (delq nil (mapcar - (lambda (x) - (let ((where (search what-input (symbol-name x)))) - (if (and where - (= where 0)) - x - nil))) commands))) - - ;; if input starts with "+" and not just "+" - (when starts-with-plus - ;; use first completion, if unambigously - (if (= (length completions) 1) - (setq what-input (symbol-name (car completions))) - (if completions - (error "Input \"+%s\" matches multiple commands: %s" - what-input - (mapconcat 'symbol-name completions ", ")) - (error "Input \"+%s\" matches no commands" what-input)))) - - ;; if input ends in digits, use first completion, even if ambigous - ;; this allows input like "h224" to be accepted - (when (and trailing-digits completions) - ;; use first match as input, even if ambigously - (setq org-index--preferred-command (first completions)) - (setq what-input (number-to-string trailing-digits))) - - ;; convert to symbol - (setq what (intern what-input)) - (if is-only-plus (setq what '+)) - - ;; user is not required to input one of the commands; if - ;; not, take the first one and use the original input for - ;; next question - (if (memq what commands) - ;; input matched one element of list, dont need original - ;; input any more - (setq what-input nil) - ;; what-input will be used for next question, use first - ;; command for what - (setq what (or org-index--preferred-command - (first commands))) - ;; remove any trailing dot, that user might have added to - ;; disambiguate his input - (if (and (> (length what-input) 0) - (equal (substring what-input -1) ".")) - ;; but do this only, if dot was really necessary to - ;; disambiguate - (let ((shortened-what-input (substring what-input 0 -1))) - (unless (test-completion shortened-what-input - (mapcar 'symbol-name - commands)) - (setq what-input shortened-what-input))))) - - ;; ask for reorder in loop, because we have to ask for - ;; what right again - (if (eq what 'reorder) - (setq reorder-once - (intern - (org-icompleting-read - "Please choose column to reorder index table once: " - (mapcar 'symbol-name '(ref count last-accessed)) - nil t)))) - - ;; maybe ask initial question again - (memq what '(reorder +))))) - - - ;; - ;; Get search, if required - ;; - - ;; These actions need a search string: - (when (memq what '(goto occur head update)) - - ;; Maybe we've got a search string from the arguments - (unless search - (let (search-from-table - search-from-cursor) - - ;; Search string can come from several sources: - ;; From link or ref columns of table - (when within-node - (setq search-from-table (org-index--get-field 'link)) - (if search-from-table - (setq search-is-link t) - (setq search-from-table (org-index--get-field 'ref)))) - - ;; From string below cursor - (when (and (not within-node) - below-cursor - (string-match (concat "\\(" ref-regex "\\)") - below-cursor)) - (setq search-from-cursor (match-string 1 below-cursor))) - - ;; Depending on requested action, get search from one of the sources above - (cond ((eq what 'goto) - (setq search (or what-input search-from-cursor))) - ((memq what '(head occur)) - (setq search (or what-input search-from-table search-from-cursor)))))) - - - ;; If we still do not have a search string, ask user explicitly - (unless search - (unless (eq what 'occur) - - (if what-input - (setq search what-input) - (setq search (read-from-minibuffer - (cond ((eq what 'head) - "Text or reference number to search for: ") - ((eq what 'goto) - "Reference number to search for, or enter \".\" for id of current node: ") - ((eq what 'update) - "Reference number to update: "))))) - - (if (string-match "^\\s *[0-9]+\\s *$" search) - (setq search (format "%s%s%s" head (org-trim search) tail)))))) - - ;; Clean up and examine search string - (when search - (setq search (org-trim search)) - (if (string= search "") (setq search nil)) - (when search - (if (string-match "^[0-9]+$" search) - (setq search (concat head search tail))) - (setq search-is-ref (string-match ref-regex search)))) - - ;; Check for special case - (when (and (memq what '(head goto)) - (string= search ".")) - (setq search (org-id-get)) - (setq search-is-link t)) - - (when search-is-ref - (setq guarded-search (org-index--make-guarded-search search))) - - ;; - ;; Do some sanity checking before really starting - ;; - - ;; Correct requested action, if nothing to search - (when (and (not search) - (memq what '(search head))) - (setq what 'enter) - (setq what-adjusted t)) - - ;; For a proper reference as input, we do multi-occur - (if (and search - (string-match ref-regex search) - (eq what 'occur)) - (setq what 'multi-occur)) - - ;; Check for invalid combinations of arguments; try to be helpful - (when (and (memq what '(head goto)) - (not search-is-link) - (not search-is-ref)) - (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search)) - - - ;; - ;; Prepare - ;; - - ;; Get link if required before moving in - (if (eq what 'link) - (let ((org-id-link-to-org-use-id t)) - (setq link-id (org-id-get-create)))) - - ;; Move into table, if outside - - ;; These commands enter index table only temporarily - (when (memq what '(occur multi-occur statistics)) - - ;; Switch to index table - (set-buffer org-index--buffer) - (goto-char org-index--point) - - ;; sort index table - (org-index--sort-table reorder-once)) - - ;; These commands will leave user in index table after they are finished - (when (memq what '(enter ref link goto missing)) - - ;; Support orgmode-standard of going back (buffer and position) - (org-mark-ring-push) - - ;; Switch to index table - (org-pop-to-buffer-same-window org-index--buffer) - (goto-char org-index--point) - (show-subtree) - (org-show-context) - (setq org-index--point-before nil) ;; dont want to go back - - ;; sort index table - (org-index--sort-table reorder-once)) - - ;; Goto back to initial ref, because reformatting of table above might - ;; have moved point - (when initial-ref-or-link - (while (and (org-at-table-p) - (not (or - (string= initial-ref-or-link (org-index--get-field 'ref)) - (string= initial-ref-or-link (org-index--get-field 'link))))) - (forward-line)) - ;; did not find ref, go back to top - (if (not (org-at-table-p)) (goto-char org-index--point))) - - - ;; - ;; Actually do, what is requested - ;; - - (cond - - - ((eq what 'help) - - ;; bring up help-buffer for this function - (describe-function 'org-index)) - - - ((eq what 'multi-occur) - - ;; Conveniently position cursor on number to search for - (goto-char org-index--below-hline) - (let (found (initial (point))) - (while (and (not found) - (forward-line) - (org-at-table-p)) - (save-excursion - (setq found (string= search - (org-index--get-field 'ref))))) - (if found - (org-index--update-line nil) - (goto-char initial))) - - ;; Construct list of all org-buffers - (let (buff org-buffers) - (dolist (buff (buffer-list)) - (set-buffer buff) - (if (string= major-mode "org-mode") - (setq org-buffers (cons buff org-buffers)))) - - ;; Do multi-occur - (multi-occur org-buffers guarded-search) - (if (get-buffer "*Occur*") - (progn - (setq message-text (format "multi-occur for '%s'" search)) - (other-window 1) - (toggle-truncate-lines 1)) - (setq message-text (format "Did not find '%s'" search))))) - - - ((eq what 'head) - - (let (link) - ;; link either from table or passed in as argument - - ;; try to get link - (if search-is-link - (setq link (org-trim search)) - (if (and within-node - (org-at-table-p)) - (setq link (org-index--get-field 'link)))) - - ;; use link if available - (if (and link - (not (string= link ""))) - (progn - (org-index--update-line search) - (org-id-goto link) - (org-reveal) - (if (eq (current-buffer) org-index--buffer) - (setq org-index--point-before nil)) - (setq message-text "Followed link")) - - (message (format "Scanning headlines for '%s' ..." search)) - (org-index--update-line search) - (let (buffer point) - (if (catch 'found - (progn - ;; loop over all headlines, stop on first match - (org-map-entries - (lambda () - (when (looking-at (concat ".*" guarded-search)) - ;; If this is not an inlinetask ... - (when (< (org-element-property :level (org-element-at-point)) - org-inlinetask-min-level) - ;; ... remember location and bail out - (setq buffer (current-buffer)) - (setq point (point)) - (throw 'found t)))) - nil 'agenda) - nil)) - - (progn - (if (eq buffer org-index--buffer) - (setq org-index--point-before nil)) - (setq message-text (format "Found '%s'" search)) - (org-pop-to-buffer-same-window buffer) - (goto-char point) - (org-reveal)) - (setq message-text (format "Did not find '%s'" search))))))) - - - ((eq what 'leave) - - (setq kill-new-text org-index--text-to-yank) - (setq org-index--text-to-yank nil) - - ;; If "leave" has been called two times in succession, make - ;; org-mark-ring-goto believe it has been called two times too - (if (eq org-index--last-action 'leave) - (let ((this-command nil) (last-command nil)) - (org-mark-ring-goto 1)) - (org-mark-ring-goto))) - - - ((eq what 'goto) - - ;; Go downward in table to requested reference - (let (found (initial (point))) - (goto-char org-index--below-hline) - (while (and (not found) - (forward-line) - (org-at-table-p)) - (save-excursion - (setq found - (string= search - (org-index--get-field - (if search-is-link 'link 'ref)))))) - (if found - (progn - (setq message-text (format "Found '%s'" search)) - (org-index--update-line nil) - (org-table-goto-column (org-index--column-num 'ref)) - (if (looking-back " ") (backward-char)) - ;; remember string to copy - (setq org-index--text-to-yank - (org-trim (org-table-get-field (org-index--column-num 'copy))))) - (setq message-text (format "Did not find '%s'" search)) - (goto-char initial) - (forward-line) - (setq what 'missed)))) - - - ((eq what 'occur) - - (org-index--do-occur what-input)) - - - ((memq what '(ref link)) - - ;; add a new row (or reuse existing one) - (let (new) - - (when (eq what 'ref) - ;; go through table to find first entry to be reused - (when has-reuse - (goto-char org-index--below-hline) - ;; go through table - (while (and (org-at-table-p) - (not new)) - (when (string= - (org-index--get-field 'count) - ":reuse:") - (setq new (org-index--get-field 'ref)) - (if new (org-table-kill-row))) - (forward-line))) - - ;; no ref to reuse; construct new reference - (unless new - (setq new (format "%s%d%s" head (1+ maxref) tail))) - - ;; remember for org-mark-ring-goto - (setq org-index--text-to-yank new)) - - ;; insert ref or link as very first row - (goto-char org-index--below-hline) - (org-table-insert-row) - - ;; fill special columns with standard values - (when (eq what 'ref) - (org-table-goto-column (org-index--column-num 'ref)) - (insert new)) - (when (eq what 'link) - (org-table-goto-column (org-index--column-num 'link)) - (insert link-id)) - (org-table-goto-column (org-index--column-num 'created)) - (org-insert-time-stamp nil nil t) - (org-table-goto-column (org-index--column-num 'count)) - (insert "1") - - ;; goto copy-field or first empty one - (if (org-index--column-num 'copy) - (org-table-goto-column (org-index--column-num 'copy)) - (unless (catch 'empty - (dotimes (col numcols) - (org-table-goto-column (+ col 1)) - (if (string= (org-trim (org-table-get-field)) "") - (throw 'empty t)))) - ;; none found, goto first - (org-table-goto-column 1))) - - (org-table-align) - (if active-region (setq kill-new-text active-region)) - (if (eq what 'ref) - (setq message-text (format "Adding a new row with ref '%s'" new)) - (setq message-text (format "Adding a new row linked to '%s'" link-id))))) - - - ((eq what 'enter) - - ;; simply go into table - (goto-char org-index--below-hline) - (show-subtree) - (recenter) - (if what-adjusted - (setq message-text "Nothing to search for; at index table") - (setq message-text "At index table"))) - - - ((eq what 'fill) - - ;; check, if within index table - (unless (and within-node - (org-at-table-p)) - (error "Not within index table")) - - ;; applies to missing refs and missing links alike - (let ((ref (org-index--get-field 'ref)) - (link (org-index--get-field 'link))) - - (if (and (not ref) - (not link)) - ;; have already checked this during parse, check here anyway - (error "Columns ref and link are both empty in this line")) - - ;; fill in new ref - (if (not ref) - (progn - (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail)) - (org-index--get-field 'ref kill-new-text) - ;; remember for org-mark-ring-goto - (setq org-index--text-to-yank kill-new-text) - (org-id-goto link) - (setq message-text "Filled field of index table with new reference")) - - ;; fill in new link - (if (not link) - (progn - (setq guarded-search (org-index--make-guarded-search ref)) - (message (format "Scanning headlines for '%s' ..." ref)) - (let (link) - (if (catch 'found - (org-map-entries - (lambda () - (when (looking-at (concat ".*" guarded-search)) - (setq link (org-id-get-create)) - (throw 'found t))) - nil 'agenda) - nil) - - (progn - (org-index--get-field 'link link) - (setq message-text "Inserted link")) - - (setq message-text (format "Did not find reference '%s'" ref))))) - - ;; nothing is missing - (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do"))))) - - - ((eq what 'sort) - - ;; sort lines according to contained reference - (let (begin end where) - (catch 'aborted - ;; either active region or whole buffer - (if (and transient-mark-mode - mark-active) - ;; sort only region - (progn - (setq begin (region-beginning)) - (setq end (region-end)) - (setq where "region")) - ;; sort whole buffer - (setq begin (point-min)) - (setq end (point-max)) - (setq where "whole buffer") - ;; make sure - (unless (y-or-n-p "Sort whole buffer ") - (setq message-text "Sort aborted") - (throw 'aborted nil))) - - (save-excursion - (save-restriction - (goto-char (point-min)) - (narrow-to-region begin end) - (sort-subr nil 'forward-line 'end-of-line - (lambda () - (if (looking-at (concat ".*" - (org-index--make-guarded-search ref-regex 'dont-quote))) - (string-to-number (match-string 1)) - 0)))) - (highlight-regexp ref-regex 'isearch) - (setq message-text (format "Sorted %s from character %d to %d, %d lines" - where begin end - (count-lines begin end))))))) - - - ((eq what 'update) - - ;; simply update line in index table - (save-excursion - (let ((ref-or-link (if search-is-link "link" "reference"))) - (beginning-of-line) - (if (org-index--update-line search) - (setq message-text (format "Updated %s '%s'" ref-or-link search)) - (setq message-text (format "Did not find %s '%s'" ref-or-link search)))))) - - - ((eq what 'parse) - ;; Just parse the index table, which is already done, so nothing to do - ) - - - ((memq what '(highlight unhighlight)) - - (let ((where "buffer")) - (save-excursion - (save-restriction - (when (and transient-mark-mode - mark-active) - (narrow-to-region (region-beginning) (region-end)) - (setq where "region")) - - (if (eq what 'highlight) - (progn - (highlight-regexp ref-regex 'isearch) - (setq message-text (format "Highlighted references in %s" where))) - (unhighlight-regexp ref-regex) - (setq message-text (format "Removed highlights for references in %s" where))))))) - - - ((memq what '(missing statistics)) - - (goto-char org-index--below-hline) - (let (missing - ref-field - ref - min - max - (total 0)) - - ;; start with list of all references - (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) - (number-sequence 1 maxref))) - - ;; go through table and remove all refs, that we see - (while (and (forward-line) - (org-at-table-p)) - - ;; get ref-field and number - (setq ref-field (org-index--get-field 'ref)) - (if (and ref-field - (string-match ref-regex ref-field)) - (setq ref (string-to-number (match-string 1 ref-field)))) - - ;; remove existing refs from list - (if ref-field (setq missing (delete ref-field missing))) - - ;; record min and max - (if (or (not min) (< ref min)) (setq min ref)) - (if (or (not max) (> ref max)) (setq max ref)) - - ;; count - (setq total (1+ total))) - - ;; insert them, if requested - (forward-line -1) - (if (eq what 'statistics) - - (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. " - total - (format org-index--ref-format min) - (format org-index--ref-format max) - (length missing))) - - (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table" - (length missing))) - (let (type) - (setq type (org-icompleting-read - "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing"))) - (mapc (lambda (x) - (let (org-table-may-need-update) (org-table-insert-row t)) - (org-index--get-field 'ref x) - (org-index--get-field 'count (format ":%s:" type))) - missing) - (org-table-align) - (setq message-text (format "Inserted %d new lines for missing refernces" (length missing)))) - (setq message-text (format "%d missing references." (length missing))))))) - - - (t (error "This is a bug: unmatched case '%s'" what))) - - - ;; restore point in buffer or window with index table - (if org-index--point-before - ;; buffer displayed in window need to set point there first - (if (eq (window-buffer active-window-index) - org-index--buffer) - (set-window-point active-window-index org-index--point-before) - ;; set position in buffer in any case and second - (with-current-buffer org-index--buffer - (goto-char org-index--point-before) - (setq org-index--point-before nil)))) - - - ;; remember what we have done for next time - (setq org-index--last-action what) - - ;; tell, what we have done and what can be yanked - (if kill-new-text (setq kill-new-text - (substring-no-properties kill-new-text))) - (if (string= kill-new-text "") (setq kill-new-text nil)) - (let ((m (concat - message-text - (if (and message-text kill-new-text) - " and r" - (if kill-new-text "R" "")) - (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")))) - (unless (string= m "") (message m))) - (if kill-new-text (kill-new kill-new-text))))) - - - -(defun org-index--parse-and-adjust-table () - - (let ((maxref 0) - top - bottom - ref-field - link-field - parts - numcols - head - tail - ref-regex - has-reuse - initial-point) - - (setq initial-point (point)) - (org-index--go-below-hline) - (setq org-index--below-hline (point)) - (setq top (point)) - - ;; count columns - (org-table-goto-column 100) - (setq numcols (- (org-table-current-column) 1)) - - ;; get contents of columns - (forward-line -2) - (unless (org-at-table-p) - (org-index--create-new-index - nil - "Index table starts with a hline")) - - ;; check for optional line consisting solely of width specifications - (beginning-of-line) - (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$") - (forward-line -1)) - (org-table-goto-column 1) - - (setq org-index--columns (org-index--parse-headings numcols)) - - ;; Go beyond end of table - (while (org-at-table-p) (forward-line 1)) - - ;; Kill all empty rows at bottom - (while (progn - (forward-line -1) - (org-table-goto-column 1) - (and - (not (org-index--get-field 'ref)) - (not (org-index--get-field 'link)))) - (org-table-kill-row)) - (forward-line) - (setq bottom (point)) - (forward-line -1) - - ;; Retrieve any decorations around the number within the first nonempty ref-field - (goto-char top) - (while (and (org-at-table-p) - (not (setq ref-field (org-index--get-field 'ref)))) - (forward-line)) - - ;; Some Checking - (unless ref-field - (org-index--create-new-index - nil - "Reference column is empty")) - - (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field) - (org-index--create-new-index - nil - (format "First reference in index table ('%s') does not contain a number" ref-field))) - - - ;; These are the decorations used within the first ref of index - (setq head (match-string 1 ref-field)) - (setq tail (match-string 3 ref-field)) - (setq ref-regex (concat (regexp-quote head) - "\\([0-9]+\\)" - (regexp-quote tail))) - - ;; Go through table to find maximum number and do some checking - (let ((ref 0)) - - (while (org-at-table-p) - - (setq ref-field (org-index--get-field 'ref)) - (setq link-field (org-index--get-field 'link)) - - (if (and (not ref-field) - (not link-field)) - (throw 'content-error "Columns ref and link are both empty in this line")) - - (if ref-field - (if (string-match ref-regex ref-field) - ;; grab number - (setq ref (string-to-number (match-string 1 ref-field))) - (throw 'content-error "Column ref does not contain a number"))) - - ;; check, if higher ref - (if (> ref maxref) (setq maxref ref)) - - ;; check if ref is ment for reuse - (if (string= (org-index--get-field 'count) ":reuse:") - (setq has-reuse 1)) - - (forward-line 1))) - - ;; sort used to be here - - (setq parts (list head maxref tail numcols ref-regex has-reuse)) - - ;; go back to top of table - (goto-char top) - - parts)) - - - -(defun org-index--sort-table (sort-column) - - (unless sort-column (setq sort-column (org-index--column-num 'sort))) - - (let (top - bottom - ref-field - count-field - count-special) - - - ;; get boundaries of table - (goto-char org-index--below-hline) - (forward-line 0) - (setq top (point)) - (while (org-at-table-p) (forward-line)) - (setq bottom (point)) - - (save-restriction - (narrow-to-region top bottom) - (goto-char top) - (sort-subr t - 'forward-line - 'end-of-line - (lambda () - (let (ref - (ref-field (or (org-index--get-field 'ref) "")) - (count-field (or (org-index--get-field 'count) "")) - (count-special 0)) - - ;; get reference with leading zeroes, so it can be - ;; sorted as text - (string-match org-index--ref-regex ref-field) - (setq ref (format - "%06d" - (string-to-number - (or (match-string 1 ref-field) - "0")))) - - ;; find out, if special token in count-column - (setq count-special (format "%d" - (- 2 - (length (member count-field '(":missing:" ":reuse:")))))) - - ;; Construct different sort-keys according to - ;; requested sort column; prepend count-special to - ;; sort special entries at bottom of table, append ref - ;; as a secondary sort key - (cond - - ((eq sort-column 'count) - (concat count-special - (format - "%08d" - (string-to-number (or (org-index--get-field 'count) - ""))) - ref)) - - ((eq sort-column 'last-accessed) - (concat count-special - (org-index--get-field 'last-accessed) - " " - ref)) - - ((eq sort-column 'ref) - (concat count-special - ref)) - - (t (error "This is a bug: unmatched case '%s'" sort-column))))) - - nil 'string<))) - - ;; align table - (org-table-align)) - - -(defun org-index--go-below-hline () - - ;; go to heading of node - (while (not (org-at-heading-p)) (forward-line -1)) - (forward-line 1) - ;; go to table within node, but make sure we do not get into another node - (while (and (not (org-at-heading-p)) - (not (org-at-table-p)) - (not (eq (point) (point-max)))) - (forward-line 1)) - - ;; check, if there really is a table - (unless (org-at-table-p) - (org-index--create-new-index - t - (format "Cannot find index table within node %s" org-index-id))) - - ;; go to first hline - (while (and (not (org-at-table-hline-p)) - (org-at-table-p)) - (forward-line 1)) - - ;; and check - (unless (org-at-table-hline-p) - (org-index--create-new-index - nil - "Cannot find hline within index table")) - - (forward-line 1) - (org-table-goto-column 1)) - - - -(defun org-index--parse-headings (numcols) - - (let (columns) - - ;; Associate names of special columns with column-numbers - (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) - (count . 0) (sort . nil) (copy . nil)))) - - ;; For each column - (dotimes (col numcols) - (let* (field-flags ;; raw heading, consisting of file name and maybe - ;; flags (seperated by ";") - field ;; field name only - field-symbol ;; and as a symbol - flags ;; flags from field-flags - found) - - ;; parse field-flags into field and flags - (setq field-flags (org-trim (org-table-get-field (+ col 1)))) - (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags) - (progn - (setq field (downcase (or (match-string 1 field-flags) ""))) - ;; get flags as list of characters - (setq flags (mapcar 'string-to-char - (split-string - (downcase (match-string 2 field-flags)) - "" t)))) - ;; no flags - (setq field field-flags)) - - (unless (string= field "") (setq field-symbol (intern (downcase field)))) - - ;; Check, that no flags appear twice - (mapc (lambda (x) - (when (memq (car x) flags) - (if (cdr (assoc (cdr x) columns)) - (org-index--create-new-index - nil - (format "More than one heading is marked with flag '%c'" (car x)))))) - '((?s . sort) - (?c . copy))) - - ;; Process flags - (if (memq ?s flags) - (setcdr (assoc 'sort columns) field-symbol)) - (if (memq ?c flags) - (setcdr (assoc 'copy columns) (+ col 1))) - - ;; Store columns in alist - (setq found (assoc field-symbol columns)) - (when found - (if (> (cdr found) 0) - (org-index--create-new-index - nil - (format "'%s' appears two times as column heading" (downcase field)))) - (setcdr found (+ col 1))))) - - ;; check if all necessary informations have been specified - (mapc (lambda (col) - (unless (> (cdr (assoc col columns)) 0) - (org-index--create-new-index - nil - (format "column '%s' has not been set" col)))) - '(ref link count created last-accessed)) - - ;; use ref as a default sort-column - (unless (cdr (assoc 'sort columns)) - (setcdr (assoc 'sort columns) 'ref)) - columns)) - - - -(defun org-index--create-new-index (create-new-index reason) - "Create a new empty index table with detailed explanation." - (let (prompt buffer-name title firstref id) - - (setq prompt - (if create-new-index - (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?") - (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before proceeding. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?"))) - - (unless (y-or-n-p prompt) - (message "Cannot proceed without a valid index table: %s" reason) - ;; show existing index - (when (and org-index--buffer - org-index--point) - (org-pop-to-buffer-same-window org-index--buffer) - (goto-char org-index--point) - (org-show-context) - (show-subtree) - (recenter 1) - (delete-other-windows)) - (throw 'created-new-index nil)) - - (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil)) - - (setq title (read-from-minibuffer "Please enter the title of the index node: ")) - - (while (progn - (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: ")) - (if (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref) - nil - (let (desc) - ;; firstref not okay, report details - (setq desc - (cond ((string= firstref "") "is empty") - ((not (string-match "^[^0-9]+" firstref)) "starts with a digit") - ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number") - ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits"))) - (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again " firstref desc))) - t))) - - (with-current-buffer buffer-name - (goto-char (point-max)) - (insert (format "\n\n* %s %s\n" firstref title)) - (insert "\n\n Below you find your initial index table, which will grow over time.\n" - " Following that your may read its detailed explanation, which will help you,\n" - " to adopt org-index to your needs. This however is optional reading and not\n" - " required to start using org-index.\n\n") - - (setq id (org-id-get-create)) - (insert (format " - - | | | | | | comment | - | ref | link | created | count;s | last-accessed | ;c | - | | <4> | | | | | - |-----+------+---------+---------+---------------+---------| - | %s | %s | %s | | | %s | - -" - firstref - id - (with-temp-buffer (org-insert-time-stamp nil nil t)) - "This node")) - - - (insert " - - Detailed explanation: - - - The index table above has three lines of headings above the first - hline: - - - The first one is ignored by org-index, and you can use it to - give meaningful names to columns. In the table above only one - column has a name (\"comment\"). This line is optional. - - - The second line is the most important one, because it - contains the configuration information for org-index; please - read further below for its format. - - - The third line is again optional; it may only specify the - widths of the individual columns (e.g. <4>). - - The columns get their meaning by the second line of headings; - specifically by one of the keywords (e.g. \"ref\") or a flag - seperated by a semicolon (e.g. \";s\"). - - - - The keywords and flags are: - - - - ref: This contains the reference, which consists of a decorated - number, which is incremented for each new line. References are - meant to be used in org-mode headlines or outside of org´, - e.g. within folder names. - - - link: org-mode link pointing to the matching location within org. - - - created: When has this line been created ? - - - count: How many times has this line accessed ? The trailing - flag \"s\" makes the table beeing sorted after - this column, so that often used entries appear at the top of - the table. - - - last-accessed: When has this line ben accessed - - - The last column above has no keyword, only the flag \"c\", - which makes its content beeing copied under certain - conditions. It is typically used for comments. - - The sequence of columns does not matter. You may reorder them any - way you like. Columns are found by their name, which appears in - the second line of headings. - - You can add further columns or even remove the last column. All - other columns are required. - - - Finally: This node needs not be a top level node; its name is - completely at you choice; it is found through its ID only. - -") - - - (while (not (org-at-table-p)) (forward-line -1)) - (org-table-align) - (while (not (org-at-heading-p)) (forward-line -1)) - - ;; present results to user - (if (and (not create-new-index) - org-index--buffer - org-index--point) - - ;; we had an error with the existing table, so present old and new one - (progn - ;; show existing index - (org-pop-to-buffer-same-window org-index--buffer) - (goto-char org-index--point) - (org-show-context) - (show-subtree) - (recenter 1) - (delete-other-windows) - ;; show new index - (select-window (split-window-vertically)) - (org-pop-to-buffer-same-window buffer-name) - (org-id-goto id) - (org-show-context) - (show-subtree) - (recenter 1) - (message "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)) - - ;; Only show the new index - (org-pop-to-buffer-same-window buffer-name) - (delete-other-windows) - (org-id-goto id) - (org-show-context) - (show-subtree) - (recenter 1) - (setq org-index-id id) - (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ") - (progn - (customize-save-variable 'org-index-id id) - (message "Saved org-index-id '%s' to %s" org-index-id custom-file)) - (let (sq) - (setq sq (format "(setq org-index-id \"%s\")" org-index-id)) - (kill-new sq) - (message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))))) - ;; cannot handle this situation in higher code, but do not want to finish with an error - (throw 'created-new-index nil))) - - - - -(defun org-index--update-line (ref-or-link) - - (let (initial - found - count-field) - - (with-current-buffer org-index--buffer - - ;; search reference or link, if given (or assume, that we are already positioned right) - (when ref-or-link - (setq initial (point)) - (goto-char org-index--below-hline) - (while (and (org-at-table-p) - (not (or (string= ref-or-link (org-index--get-field 'ref)) - (string= ref-or-link (org-index--get-field 'link))))) - (forward-line))) - - (if (not (org-at-table-p)) - (error "Did not find reference or link '%s'" ref-or-link) - (setq count-field (org-index--get-field 'count)) - - ;; update count field only if number or empty; leave :missing: and :reuse: as is - (if (or (not count-field) - (string-match "^[0-9]+$" count-field)) - (org-index--get-field 'count - (number-to-string - (+ 1 (string-to-number (or count-field "0")))))) - - ;; update timestamp - (org-table-goto-column (org-index--column-num 'last-accessed)) - (org-table-blank-field) - (org-insert-time-stamp nil t t) - - (setq found t)) - - (if initial (goto-char initial)) - - found))) - - - -(defun org-index--get-field (key &optional value) - (let (field) - (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value))) - (if (string= field "") (setq field nil)) - - field)) - - -(defun org-index--column-num (key) - (cdr (assoc key org-index--columns))) - - -(defun org-index--make-guarded-search (ref &optional dont-quote) - (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b")) - - -(defun org-index-get-ref-regex-format () - "return cons-cell with regular expression and format for references" - (unless org-index--ref-regex - (org-index-1 'parse)) - (cons (org-index--make-guarded-search org-index--ref-regex 'dont-quote) org-index--ref-format)) - - -(defun org-index--do-occur (initial-search) - (let ( - (occur-buffer-name "*org-index-occur*") - (word "") ; last word to search for growing and shrinking on keystrokes - (prompt "Search for: ") - words ; list of other words that must match too - occur-buffer - lines-to-show ; number of lines to show in window - start-of-lines ; position, where lines begin - left-off-at ; stack of last positions in index table - after-inserted ; in occur-buffer - lines-visible ; in occur-buffer - below-hline-bol ; below-hline and at bol - exit-gracefully ; true if normal exit - in-c-backspace ; true while processing C-backspace - ret from to key) - - ;; clear buffer - (if (get-buffer "*org-index-occur*") - (kill-buffer occur-buffer-name)) - (setq occur-buffer (get-buffer-create "*org-index-occur*")) - - (with-current-buffer org-index--buffer - (let ((initial (point))) - (goto-char org-index--below-hline) - (forward-line 0) - (setq below-hline-bol (point)) - (goto-char initial))) - - (org-pop-to-buffer-same-window occur-buffer) - (toggle-truncate-lines 1) - - (unwind-protect ; to reset cursor-shape even in case of errors - (progn - - ;; fill in header - (erase-buffer) - (insert (concat "Incremental search, showing one window of matches.\n" - "Use DEL and C-DEL to erase, cursor keys to move, RET to find heading.\n\n")) - (setq start-of-lines (point)) - (setq cursor-type 'hollow) - - ;; get window size of occur-buffer as number of lines to be searched - (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1)) - - - ;; fill initially - (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol)) - (when (car ret) - (insert (cdr ret)) - (setq left-off-at (cons (car ret) nil)) - (setq after-inserted (cons (point) nil))) - - ;; read keys - (while - (progn - (goto-char start-of-lines) - (setq lines-visible 0) - - ;; use initial-search (if present) to simulate keyboard input - (if (and initial-search - (> (length initial-search) 0)) - (progn - (setq key (string-to-char (substring initial-search 0 1))) - (if (length initial-search) - (setq initial-search (substring initial-search 1)))) - (if in-c-backspace - (setq key 'backspace) - (setq key (read-event - (format "%s %s" - prompt - (mapconcat 'identity (reverse (cons word words)) ",")))) - - (setq exit-gracefully (memq key (list 'return 'up 'down 'left 'right))))) - - (not exit-gracefully)) - - (cond - - ((eq key 'C-backspace) - - (setq in-c-backspace t)) - - ((eq key 'backspace) ; erase last char - - (if (= (length word) 0) - - ;; nothing more to delete - (setq in-c-backspace nil) - - ;; unhighlight longer match - (let ((case-fold-search t)) - (unhighlight-regexp (regexp-quote word))) - - ;; chars left shorten word - (setq word (substring word 0 -1)) - (when (= (length word) 0) ; when nothing left, use next word from list - (setq word (car words)) - (setq words (cdr words)) - (setq in-c-backspace nil)) - - ;; remove everything, that has been added for char just deleted - (when (cdr after-inserted) - (setq after-inserted (cdr after-inserted)) - (goto-char (car after-inserted)) - (delete-region (point) (point-max))) - - ;; back up last position in index table too - (when (cdr left-off-at) - (setq left-off-at (cdr left-off-at))) - - ;; go through buffer and check, if any invisible line should now be shown - (goto-char start-of-lines) - (while (< (point) (point-max)) - (if (outline-invisible-p) - (progn - (setq from (line-beginning-position) - to (line-beginning-position 2)) - - ;; check for matches - (when (org-index--test-words (cons word words) (buffer-substring from to)) - (when (<= lines-visible lines-to-show) ; show, if more lines required - (outline-flag-region from to nil) - (incf lines-visible)))) - - ;; already visible, just count - (incf lines-visible)) - - (forward-line 1)) - - ;; highlight shorter word - (unless (= (length word) 0) - (let ((case-fold-search t)) - (highlight-regexp (regexp-quote word) 'isearch))))) - - - ((eq key ?,) ; comma: enter an additional search word - - ;; push current word and clear, no need to change display - (setq words (cons word words)) - (setq word "")) - - - ((and (characterp key) - (aref printable-chars key)) ; any other char: add to current search word - - - ;; unhighlight short word - (unless (= (length word) 0) - (let ((case-fold-search t)) - (unhighlight-regexp (regexp-quote word)))) - - ;; add to word - (setq word (concat word (downcase (string key)))) - - ;; hide lines, that do not match longer word any more - (while (< (point) (point-max)) - (unless (outline-invisible-p) - (setq from (line-beginning-position) - to (line-beginning-position 2)) - - ;; check for matches - (if (org-index--test-words (list word) (buffer-substring from to)) - (incf lines-visible) ; count as visible - (outline-flag-region from to t))) ; hide - - (forward-line 1)) - - ;; duplicate top of stacks; eventually overwritten below - (setq left-off-at (cons (car left-off-at) left-off-at)) - (setq after-inserted (cons (car after-inserted) after-inserted)) - - ;; get new lines from index table - (when (< lines-visible lines-to-show) - (setq ret (org-index--get-matching-lines (cons word words) - (- lines-to-show lines-visible) - (car left-off-at))) - - (when (car ret) - (insert (cdr ret)) - (setcar left-off-at (car ret)) - (setcar after-inserted (point)))) - - ;; highlight longer word - (let ((case-fold-search t)) - (highlight-regexp (regexp-quote word) 'isearch))))) - - ;; search is done collect and brush up results - ;; remove any lines, that are still invisible - (goto-char start-of-lines) - (while (< (point) (point-max)) - (if (outline-invisible-p) - (delete-region (line-beginning-position) (line-beginning-position 2)) - (forward-line 1))) - - ;; get all the rest - (message "Getting all matches ...") - (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at))) - (message "done.") - (insert (cdr ret))) - - ;; postprocessing even for non graceful exit - (setq cursor-type t) - ;; replace previous heading - (let ((numlines (count-lines (point) start-of-lines))) - (goto-char start-of-lines) - (forward-line -1) - (delete-region (point-min) (point)) - (insert (format (concat (if exit-gracefully - "Search is done; showing all %d matches.\n" - "Search aborted; showing only some matches.\n") - "Use cursor keys to move, press RET to find heading.\n") - numlines))) - (forward-line)) - - ;; install keyboard-shortcuts within occur-buffer - (let ((keymap (make-sparse-keymap)) - fun-on-ret) - (set-keymap-parent keymap text-mode-map) - - (setq fun-on-ret (lambda () (interactive) - (let ((ref (org-index--get-field 'ref)) - (link (org-index--get-field 'link))) - (org-index-1 'head - (or link ref) ;; prefer link - (if link t nil))))) - - (define-key keymap (kbd "RET") fun-on-ret) - (use-local-map keymap) - - ;; perform action according to last char - (cond - ((eq key 'return) - (funcall fun-on-ret)) - - ((eq key 'up) - (forward-line -1)) - - ((eq key 'down) - (forward-line 1)) - - ((eq key 'left) - (forward-char -1)) - - ((eq key 'right) - (forward-char 1)))))) - - -(defun org-index--get-matching-lines (words numlines start-from) - (let ((numfound 0) - pos - initial line lines) - - (with-current-buffer org-index--buffer - - ;; remember initial pos and start at requested - (setq initial (point)) - (goto-char start-from) - - ;; loop over buffer until we have found enough lines - (while (and (or (< numfound numlines) - (= numlines 0)) - (org-at-table-p)) - - ;; check each word - (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2))) - (when (org-index--test-words words line) - (setq lines (concat lines line)) - (incf numfound)) - (forward-line 1) - (setq pos (point))) - - ;; return to initial position - (goto-char initial)) - - (unless lines (setq lines "")) - (cons pos lines))) - - -(defun org-index--test-words (words line) - (let ((found-all t)) - (setq line (downcase line)) - (catch 'not-found - (dolist (w words) - (or (search w line) - (throw 'not-found nil))) - t))) - - -(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate) - "Make text from org-index available for yank." - (when org-index--text-to-yank - (kill-new org-index--text-to-yank) - (message (format "Ready to yank '%s'" org-index--text-to-yank)) - (setq org-index--text-to-yank nil))) - - -(provide 'org-index) - -;; Local Variables: -;; fill-column: 75 -;; comment-column: 50 -;; End: - -;;; org-index.el ends here +;;; org-index.el --- A personal index for org and beyond + +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. + +;; Author: Marc Ihm +;; Keywords: outlines, hypermedia, matching +;; Requires: org +;; Version: 2.3.2.1 + +;; This file is not part of GNU Emacs. + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: + +;; Purpose: +;; +;; Mark and find your favorite org-locations and other points of interest +;; easily; create and update a lookup table of references and links. When +;; searching, frequently used entries appear at the the top and entering +;; some keywords narrows down to matching entries only, so that the +;; right one can be spotted easily. +;; +;; References are essentially small numbers (e.g. "R237" or "-455-"), +;; which are created by this package; they are well suited to be used +;; outside org. Links are normal org-mode links. +;; +;; Setup: +;; +;; - Add these lines to your .emacs: +;; +;; (require 'org-index) +;; +;; ;; Optionally assign a key. Pick your own. +;; (global-set-key (kbd "C-+") 'org-index) +;; +;; - Invoke `org-index', which will assist you to create your +;; index table. +;; +;; - Do not forget to restart emacs to make these lines effective. +;; +;; +;; Further reading: +;; +;; See the documentation of `org-index', which can also be read +;; by invoking `org-index' and and choosing the help-command. +;; +;; For more documentation and working examples, see: +;; +;; http://orgmode.org/worg/org-contrib/org-index.html +;; + +;;; Change Log: + +;; [2013-10-04 Fr] Version 2.3.2: +;; - Bugfix: index-table created by assistant is found after +;; restart of emacs instead of invoking assistent again +;; +;; [2013-07-20 Sa] Version 2.3.0: +;; - Renamed from "org-favtable" to "org-index" +;; - Added an assistent to set up the index table +;; - occur is now incremental, searching as you type +;; - simplified the documentation and help-system +;; - Saving keystrokes, as "+g237" is now valid input +;; - Many bugfixes +;; +;; [2013-02-28 Th] Version 2.2.0: +;; - Allowed shortcuts like "h237" for command "head" with argument "237" +;; - Integrated with org-mark-ring-goto +;; +;; [2013-01-25 Fr] Version 2.1.0: +;; - Added full support for links +;; - New commands "missing" and "statistics" +;; - Renamed the package from "org-reftable" to "org-favtable" +;; - Additional columns are required (e.g. "link"). Error messages will +;; guide you +;; +;; [2012-12-07 Fr] Version 2.0.0: +;; - The format of the table of favorites has changed ! You need to bring +;; your existing table into the new format by hand (which however is +;; easy and explained below) +;; - Reference table can be sorted after usage count or date of last access +;; - Ask user explicitly, which command to invoke +;; - Renamed the package from "org-refer-by-number" to "org-reftable" + +;; [2012-09-22 Sa] Version 1.5.0: +;; - New command "sort" to sort a buffer or region by reference number +;; - New commands "highlight" and "unhighlight" to mark references + +;; [2012-07-13 Fr] Version 1.4.0: +;; - New command "head" to find a headline with a reference number + +;; [2012-04-28 Sa] Version 1.3.0: +;; - New commands occur and multi-occur +;; - All commands can now be invoked explicitly +;; - New documentation +;; - Many bugfixes + +;; [2011-12-10 Sa] Version 1.2.0: +;; - Fixed a bug, which lead to a loss of newly created reference numbers +;; - Introduced single and double prefix arguments +;; - Started this Change Log + +;;; Code: + +(require 'org-table) +(require 'cl) + +(defvar org-index--preferred-command nil) + +(defvar org-index--commands + '(occur head ref link leave enter goto help + reorder fill sort update highlight unhighlight missing statistics) + "List of commands known to org-index.") + +(defvar org-index--commands-some '(occur head ref link leave enter goto help +)) + + +(defvar org-index--columns nil) + +(defcustom org-index-id nil + "Id of the Org-mode node, which contains the index table." + :group 'org + :group 'org-index) + + +(defvar org-index--text-to-yank nil) +(defvar org-index--last-action nil) +(defvar org-index--ref-regex nil) +(defvar org-index--ref-format nil) +(defvar org-index--buffer nil "buffer of index table") +(defvar org-index--point nil "position at start of headline of index table") +(defvar org-index--below-hline nil "position of first cell in first line below hline") +(defvar org-index--point-before nil "point in buffer with index table") + + +(defun org-index (&optional ARG) + "Mark and find your favorite things and org-locations easily: +Create and update a lookup table of references and links. Often +used entries bubble to the top; entering some keywords narrows +down to matching entries only, so that the right one can be +spotted easily. + +References are essentially small numbers (e.g. \"R237\" or \"-455-\"), +which are created by this package; they are well suited to be used +outside of org. Links are normal org-mode links. + +This is version 2.3.2 of org-index. + +The function `org-index' operates on a dedicated table, the index +table, which lives within its own Org-mode node. The table and +its node will be created, when you first invoke org-index. + +Each line in the index table contains: + + - A reference + + - A link + + - A number; counting, how often each reference has been + used. This number is updated automatically and the table can + be sorted after it, so that most frequently used references + appear at the top of the table and can be spotted easily. + + - The creation date of the line. + + - Date and time of last access. This column can alternatively be + used to sort the table. + + - A column for your own comments, which allows lines to be selected by + keywords. + +The index table is found through the id of the containing +node; this id is stored within `org-index-id'. + + +The function `org-index' is the only interactive function of this +package and its sole entry point; it offers several commands to +create, find and look up these favorites (references and links). + +Commands known: + + occur: Incremental search, that after each keystroke shows + matching lines from index table. You may enter a list of words + seperated by comma (\",\"), to select lines that contain all + of the given words. + + If you supply a number (e.g. \"237\"): Apply emacs standard + multi-occur operation on all org-mode buffers to search for + this specific reference. + + You may also read the note at the end of this help on saving + the keystroke RET with this frequent default command. + + head: If invoked outside the index table, ask for a + reference number and search for a heading containing it. If + invoked within index table dont ask; rather use the reference or + link from the current line. + + ref: Create a new reference, copy any previously selected text. + If already within index table, fill in ref-column. + + link: Create a new line in index table with a link to the + current node. Do not populate the ref column; this can later + be populated by calling the \"fill\" command from within the + index table. + + leave: Leave the index table. If the last command has + been \"ref\", the new reference is copied and ready to yank. + This \"org-mark-ring-goto\" and can be called several times + in succession. If you invoke org-index with a prefix argument, + this command \"leave\" is executed without further questions. + + enter: Just enter the node with the index table. + + goto: Search for a specific reference within the index table. + + help: Show this text. + + +: Show all commands including the less frequently used ones + given below. If \"+\" is followd by enough letters of such a + command (e.g. \"+fi\"), then this command is invoked + directly. + + reorder: Temporarily reorder the index table, e.g. by + count, reference or last access. + + fill: If either ref or link is missing, fill it. + + sort: Sort a set of lines (either the active region or the + whole buffer) by the references found in each line. + + update: For the given reference, update the line in the + index table. + + highlight: Highlight references in region or buffer. + + unhighlight: Remove highlights. + + missing : Search for missing reference numbers (which do not + appear in the reference table). If requested, add additional + lines for them, so that the command \"ref\" is able to reuse + them. + + statistics : Show some statistics (e.g. minimum and maximum + reference) about index table. + + + +Two ways to save keystrokes: + +When prompting for a command, org-index puts the most likely +one (e.g. \"occur\" or \"ref\") in front of the list, so that +you may just type RET. + +If this command needs additional input (like e.g. \"occur\"), you +may supply this input right away, although you are still beeing +prompted for the command. So, to do an occur for the string +\"foo\", you can just enter \"foo\" RET, without even typing +\"occur\". + + +Another way to save keystrokes applies if you want to choose a +command, that requrires a reference number (and would normally +prompt for it): In that case you may just enter enough characters +from your command, so that it appears first in the list of +matches; then immediately enter the number of the reference you +are searching for. So the input \"h237\" would execute the +command \"head\" for reference \"237\" right away. + +" + + (interactive "P") + + (org-index-1 (if (equal ARG '(4)) 'leave nil) ) +) + + +(defun org-index-1 (&optional what search search-is-link) +"Do the actual worg for org-index; its optional arguments are: + + search : string to search for + what : symbol of the command to invoke + search-is-link : t, if argument search is actually a link + +An example would be: + + (org-index \"237\" 'head) ;; find heading with ref 237 +" + (let (within-node ; True, if we are within node of the index table + active-window-index ; active window with index table (if any) + below-cursor ; word below cursor + active-region ; active region (if any) + link-id ; link of starting node, if required + guarded-search ; with guard against additional digits + search-is-ref ; true, if search is a reference + commands ; currently active set of selectable commands + what-adjusted ; True, if we had to adjust what + what-input ; Input on what question (need not necessary be "what") + trailing-digits ; any digits, that are are appended to what-input + reorder-once ; Column to use for single time sorting + parts ; Parts of a typical reference number (which + ; need not be a plain number); these are: + head ; Any header before number (e.g. "R") + maxref ; Maximum number from reference table (e.g. "153") + tail ; Tail after number (e.g. "}" or "") + ref-regex ; Regular expression to match a reference + has-reuse ; True, if table contains a line for reuse + numcols ; Number of columns in index table + kill-new-text ; Text that will be appended to kill ring + message-text ; Text that will be issued as an explanation, + ; what we have done + initial-ref-or-link ; Initial position in index table + ) + + ;; + ;; Examine current buffer and location, before turning to index table + ;; + + (unless (boundp 'org-index-id) + (setq org-index-id nil) + (org-index--create-new-index + t + (format "No index table has been created yet." org-index-id))) + + ;; Bail out, if new index has been created + (catch 'created-new-index + + ;; Get the content of the active region or the word under cursor + (if (and transient-mark-mode + mark-active) + (setq active-region (buffer-substring (region-beginning) (region-end)))) + (setq below-cursor (thing-at-point 'symbol)) + + + ;; Find out, if we are within favable or not + (setq within-node (string= (org-id-get) org-index-id)) + + + ;; + ;; Get decoration of references and highest reference from index table + ;; + + + ;; Save initial ref or link + (if (and within-node + (org-at-table-p)) + (setq initial-ref-or-link + (or (org-index--get-field 'ref) + (org-index--get-field 'link)))) + + ;; Find node + (let ((marker (org-id-find org-index-id 'marker)) initial) + (if marker + (progn + (setq org-index--buffer (marker-buffer marker) + org-index--point (marker-position marker)) + (move-marker marker nil)) + (org-index--create-new-index + t + (format "Cannot find node with id \"%s\"" org-index-id)))) + + ;; Check and remember, if active window contains buffer with index table + (if (eq (window-buffer) org-index--buffer) + (setq active-window-index (selected-window))) + + ;; Get configuration of index table; catch errors + (let ((error-message + (catch 'content-error + + (with-current-buffer org-index--buffer + (unless org-index--point-before + (setq org-index--point-before (point))) + + (unless (string= (org-id-get) org-index-id) + (goto-char org-index--point)) + + ;; parse table while still within buffer + (setq parts (org-index--parse-and-adjust-table)) + + ;; go back + (goto-char org-index--point-before) + + nil)))) + + (when error-message + (org-pop-to-buffer-same-window org-index--buffer) + (org-reveal) + (error error-message))) + + ;; Give names to parts of configuration + (setq head (nth 0 parts)) + (setq maxref (nth 1 parts)) + (setq tail (nth 2 parts)) + (setq numcols (nth 3 parts)) + (setq ref-regex (nth 4 parts)) + (setq has-reuse (nth 5 parts)) + (setq org-index--ref-regex ref-regex) + (setq org-index--ref-format (concat head "%d" tail)) + + ;; + ;; Find out, what we are supposed to do + ;; + + ;; Set preferred action, that will be the default choice + (setq org-index--preferred-command + (if within-node + (if (memq org-index--last-action '(ref link)) + 'leave + 'goto) + (if active-region + 'ref + (if (and below-cursor (string-match ref-regex below-cursor)) + 'occur + nil)))) + + ;; Ask user, what to do + (unless what + (setq commands (copy-list org-index--commands-some)) + (while (let (completions starts-with-plus is-only-plus) + + (setq what-input + (org-completing-read + "Please choose: " + (mapcar 'symbol-name + ;; Construct unique list of commands with + ;; preferred one at front + (delq nil (delete-dups + (append + (list org-index--preferred-command) + (copy-list commands))))) + nil nil)) + + ;; if input ends in digits, save them away and do completions on head of input + ;; this allows input like "h224" to be accepted + (when (string-match "^\\([^0-9]+\\)\\([0-9]+\\)\\s *$" what-input) + ;; remember digits + (setq trailing-digits (string-to-number (match-string 2 what-input))) + ;; and use non-digits-part to find match + (setq what-input (match-string 1 what-input))) + + ;; if input starts with "+", any command (not only some) may follow + ;; this allows input like "+sort" to be accepted + (when (string= (substring what-input 0 1) "+") + ;; make all commands available for selection + (setq commands (copy-list org-index--commands)) + (setq what-input (substring what-input 1)) + (setq starts-with-plus (> (length what-input) 0)) + (setq is-only-plus (not starts-with-plus))) + + ;; get list of possible completions for what-input; i.e. + ;; all commands, that start with what-input + (setq completions (delq nil (mapcar + (lambda (x) + (let ((where (search what-input (symbol-name x)))) + (if (and where + (= where 0)) + x + nil))) commands))) + + ;; if input starts with "+" and not just "+" + (when starts-with-plus + ;; use first completion, if unambigously + (if (= (length completions) 1) + (setq what-input (symbol-name (car completions))) + (if completions + (error "Input \"+%s\" matches multiple commands: %s" + what-input + (mapconcat 'symbol-name completions ", ")) + (error "Input \"+%s\" matches no commands" what-input)))) + + ;; if input ends in digits, use first completion, even if ambigous + ;; this allows input like "h224" to be accepted + (when (and trailing-digits completions) + ;; use first match as input, even if ambigously + (setq org-index--preferred-command (first completions)) + (setq what-input (number-to-string trailing-digits))) + + ;; convert to symbol + (setq what (intern what-input)) + (if is-only-plus (setq what '+)) + + ;; user is not required to input one of the commands; if + ;; not, take the first one and use the original input for + ;; next question + (if (memq what commands) + ;; input matched one element of list, dont need original + ;; input any more + (setq what-input nil) + ;; what-input will be used for next question, use first + ;; command for what + (setq what (or org-index--preferred-command + (first commands))) + ;; remove any trailing dot, that user might have added to + ;; disambiguate his input + (if (and (> (length what-input) 0) + (equal (substring what-input -1) ".")) + ;; but do this only, if dot was really necessary to + ;; disambiguate + (let ((shortened-what-input (substring what-input 0 -1))) + (unless (test-completion shortened-what-input + (mapcar 'symbol-name + commands)) + (setq what-input shortened-what-input))))) + + ;; ask for reorder in loop, because we have to ask for + ;; what right again + (if (eq what 'reorder) + (setq reorder-once + (intern + (org-icompleting-read + "Please choose column to reorder index table once: " + (mapcar 'symbol-name '(ref count last-accessed)) + nil t)))) + + ;; maybe ask initial question again + (memq what '(reorder +))))) + + + ;; + ;; Get search, if required + ;; + + ;; These actions need a search string: + (when (memq what '(goto occur head update)) + + ;; Maybe we've got a search string from the arguments + (unless search + (let (search-from-table + search-from-cursor) + + ;; Search string can come from several sources: + ;; From link or ref columns of table + (when within-node + (setq search-from-table (org-index--get-field 'link)) + (if search-from-table + (setq search-is-link t) + (setq search-from-table (org-index--get-field 'ref)))) + + ;; From string below cursor + (when (and (not within-node) + below-cursor + (string-match (concat "\\(" ref-regex "\\)") + below-cursor)) + (setq search-from-cursor (match-string 1 below-cursor))) + + ;; Depending on requested action, get search from one of the sources above + (cond ((eq what 'goto) + (setq search (or what-input search-from-cursor))) + ((memq what '(head occur)) + (setq search (or what-input search-from-table search-from-cursor)))))) + + + ;; If we still do not have a search string, ask user explicitly + (unless search + (unless (eq what 'occur) + + (if what-input + (setq search what-input) + (setq search (read-from-minibuffer + (cond ((eq what 'head) + "Text or reference number to search for: ") + ((eq what 'goto) + "Reference number to search for, or enter \".\" for id of current node: ") + ((eq what 'update) + "Reference number to update: "))))) + + (if (string-match "^\\s *[0-9]+\\s *$" search) + (setq search (format "%s%s%s" head (org-trim search) tail)))))) + + ;; Clean up and examine search string + (when search + (setq search (org-trim search)) + (if (string= search "") (setq search nil)) + (when search + (if (string-match "^[0-9]+$" search) + (setq search (concat head search tail))) + (setq search-is-ref (string-match ref-regex search)))) + + ;; Check for special case + (when (and (memq what '(head goto)) + (string= search ".")) + (setq search (org-id-get)) + (setq search-is-link t)) + + (when search-is-ref + (setq guarded-search (org-index--make-guarded-search search))) + + ;; + ;; Do some sanity checking before really starting + ;; + + ;; Correct requested action, if nothing to search + (when (and (not search) + (memq what '(search head))) + (setq what 'enter) + (setq what-adjusted t)) + + ;; For a proper reference as input, we do multi-occur + (if (and search + (string-match ref-regex search) + (eq what 'occur)) + (setq what 'multi-occur)) + + ;; Check for invalid combinations of arguments; try to be helpful + (when (and (memq what '(head goto)) + (not search-is-link) + (not search-is-ref)) + (error "Can do '%s' only for a reference or link (not '%s'), try 'occur' to search for text" what search)) + + + ;; + ;; Prepare + ;; + + ;; Get link if required before moving in + (if (eq what 'link) + (let ((org-id-link-to-org-use-id t)) + (setq link-id (org-id-get-create)))) + + ;; Move into table, if outside + + ;; These commands enter index table only temporarily + (when (memq what '(occur multi-occur statistics)) + + ;; Switch to index table + (set-buffer org-index--buffer) + (goto-char org-index--point) + + ;; sort index table + (org-index--sort-table reorder-once)) + + ;; These commands will leave user in index table after they are finished + (when (memq what '(enter ref link goto missing)) + + ;; Support orgmode-standard of going back (buffer and position) + (org-mark-ring-push) + + ;; Switch to index table + (org-pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (show-subtree) + (org-show-context) + (setq org-index--point-before nil) ;; dont want to go back + + ;; sort index table + (org-index--sort-table reorder-once)) + + ;; Goto back to initial ref, because reformatting of table above might + ;; have moved point + (when initial-ref-or-link + (while (and (org-at-table-p) + (not (or + (string= initial-ref-or-link (org-index--get-field 'ref)) + (string= initial-ref-or-link (org-index--get-field 'link))))) + (forward-line)) + ;; did not find ref, go back to top + (if (not (org-at-table-p)) (goto-char org-index--point))) + + + ;; + ;; Actually do, what is requested + ;; + + (cond + + + ((eq what 'help) + + ;; bring up help-buffer for this function + (describe-function 'org-index)) + + + ((eq what 'multi-occur) + + ;; Conveniently position cursor on number to search for + (goto-char org-index--below-hline) + (let (found (initial (point))) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found (string= search + (org-index--get-field 'ref))))) + (if found + (org-index--update-line nil) + (goto-char initial))) + + ;; Construct list of all org-buffers + (let (buff org-buffers) + (dolist (buff (buffer-list)) + (set-buffer buff) + (if (string= major-mode "org-mode") + (setq org-buffers (cons buff org-buffers)))) + + ;; Do multi-occur + (multi-occur org-buffers guarded-search) + (if (get-buffer "*Occur*") + (progn + (setq message-text (format "multi-occur for '%s'" search)) + (other-window 1) + (toggle-truncate-lines 1)) + (setq message-text (format "Did not find '%s'" search))))) + + + ((eq what 'head) + + (let (link) + ;; link either from table or passed in as argument + + ;; try to get link + (if search-is-link + (setq link (org-trim search)) + (if (and within-node + (org-at-table-p)) + (setq link (org-index--get-field 'link)))) + + ;; use link if available + (if (and link + (not (string= link ""))) + (progn + (org-index--update-line search) + (org-id-goto link) + (org-reveal) + (if (eq (current-buffer) org-index--buffer) + (setq org-index--point-before nil)) + (setq message-text "Followed link")) + + (message (format "Scanning headlines for '%s' ..." search)) + (org-index--update-line search) + (let (buffer point) + (if (catch 'found + (progn + ;; loop over all headlines, stop on first match + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + ;; If this is not an inlinetask ... + (when (< (org-element-property :level (org-element-at-point)) + org-inlinetask-min-level) + ;; ... remember location and bail out + (setq buffer (current-buffer)) + (setq point (point)) + (throw 'found t)))) + nil 'agenda) + nil)) + + (progn + (if (eq buffer org-index--buffer) + (setq org-index--point-before nil)) + (setq message-text (format "Found '%s'" search)) + (org-pop-to-buffer-same-window buffer) + (goto-char point) + (org-reveal)) + (setq message-text (format "Did not find '%s'" search))))))) + + + ((eq what 'leave) + + (setq kill-new-text org-index--text-to-yank) + (setq org-index--text-to-yank nil) + + ;; If "leave" has been called two times in succession, make + ;; org-mark-ring-goto believe it has been called two times too + (if (eq org-index--last-action 'leave) + (let ((this-command nil) (last-command nil)) + (org-mark-ring-goto 1)) + (org-mark-ring-goto))) + + + ((eq what 'goto) + + ;; Go downward in table to requested reference + (let (found (initial (point))) + (goto-char org-index--below-hline) + (while (and (not found) + (forward-line) + (org-at-table-p)) + (save-excursion + (setq found + (string= search + (org-index--get-field + (if search-is-link 'link 'ref)))))) + (if found + (progn + (setq message-text (format "Found '%s'" search)) + (org-index--update-line nil) + (org-table-goto-column (org-index--column-num 'ref)) + (if (looking-back " ") (backward-char)) + ;; remember string to copy + (setq org-index--text-to-yank + (org-trim (org-table-get-field (org-index--column-num 'copy))))) + (setq message-text (format "Did not find '%s'" search)) + (goto-char initial) + (forward-line) + (setq what 'missed)))) + + + ((eq what 'occur) + + (org-index--do-occur what-input)) + + + ((memq what '(ref link)) + + ;; add a new row (or reuse existing one) + (let (new) + + (when (eq what 'ref) + ;; go through table to find first entry to be reused + (when has-reuse + (goto-char org-index--below-hline) + ;; go through table + (while (and (org-at-table-p) + (not new)) + (when (string= + (org-index--get-field 'count) + ":reuse:") + (setq new (org-index--get-field 'ref)) + (if new (org-table-kill-row))) + (forward-line))) + + ;; no ref to reuse; construct new reference + (unless new + (setq new (format "%s%d%s" head (1+ maxref) tail))) + + ;; remember for org-mark-ring-goto + (setq org-index--text-to-yank new)) + + ;; insert ref or link as very first row + (goto-char org-index--below-hline) + (org-table-insert-row) + + ;; fill special columns with standard values + (when (eq what 'ref) + (org-table-goto-column (org-index--column-num 'ref)) + (insert new)) + (when (eq what 'link) + (org-table-goto-column (org-index--column-num 'link)) + (insert link-id)) + (org-table-goto-column (org-index--column-num 'created)) + (org-insert-time-stamp nil nil t) + (org-table-goto-column (org-index--column-num 'count)) + (insert "1") + + ;; goto copy-field or first empty one + (if (org-index--column-num 'copy) + (org-table-goto-column (org-index--column-num 'copy)) + (unless (catch 'empty + (dotimes (col numcols) + (org-table-goto-column (+ col 1)) + (if (string= (org-trim (org-table-get-field)) "") + (throw 'empty t)))) + ;; none found, goto first + (org-table-goto-column 1))) + + (org-table-align) + (if active-region (setq kill-new-text active-region)) + (if (eq what 'ref) + (setq message-text (format "Adding a new row with ref '%s'" new)) + (setq message-text (format "Adding a new row linked to '%s'" link-id))))) + + + ((eq what 'enter) + + ;; simply go into table + (goto-char org-index--below-hline) + (show-subtree) + (recenter) + (if what-adjusted + (setq message-text "Nothing to search for; at index table") + (setq message-text "At index table"))) + + + ((eq what 'fill) + + ;; check, if within index table + (unless (and within-node + (org-at-table-p)) + (error "Not within index table")) + + ;; applies to missing refs and missing links alike + (let ((ref (org-index--get-field 'ref)) + (link (org-index--get-field 'link))) + + (if (and (not ref) + (not link)) + ;; have already checked this during parse, check here anyway + (error "Columns ref and link are both empty in this line")) + + ;; fill in new ref + (if (not ref) + (progn + (setq kill-new-text (format "%s%d%s" head (1+ maxref) tail)) + (org-index--get-field 'ref kill-new-text) + ;; remember for org-mark-ring-goto + (setq org-index--text-to-yank kill-new-text) + (org-id-goto link) + (setq message-text "Filled field of index table with new reference")) + + ;; fill in new link + (if (not link) + (progn + (setq guarded-search (org-index--make-guarded-search ref)) + (message (format "Scanning headlines for '%s' ..." ref)) + (let (link) + (if (catch 'found + (org-map-entries + (lambda () + (when (looking-at (concat ".*" guarded-search)) + (setq link (org-id-get-create)) + (throw 'found t))) + nil 'agenda) + nil) + + (progn + (org-index--get-field 'link link) + (setq message-text "Inserted link")) + + (setq message-text (format "Did not find reference '%s'" ref))))) + + ;; nothing is missing + (setq message-text "Columns 'ref' and 'link' are already filled; nothing to do"))))) + + + ((eq what 'sort) + + ;; sort lines according to contained reference + (let (begin end where) + (catch 'aborted + ;; either active region or whole buffer + (if (and transient-mark-mode + mark-active) + ;; sort only region + (progn + (setq begin (region-beginning)) + (setq end (region-end)) + (setq where "region")) + ;; sort whole buffer + (setq begin (point-min)) + (setq end (point-max)) + (setq where "whole buffer") + ;; make sure + (unless (y-or-n-p "Sort whole buffer ") + (setq message-text "Sort aborted") + (throw 'aborted nil))) + + (save-excursion + (save-restriction + (goto-char (point-min)) + (narrow-to-region begin end) + (sort-subr nil 'forward-line 'end-of-line + (lambda () + (if (looking-at (concat ".*" + (org-index--make-guarded-search ref-regex 'dont-quote))) + (string-to-number (match-string 1)) + 0)))) + (highlight-regexp ref-regex 'isearch) + (setq message-text (format "Sorted %s from character %d to %d, %d lines" + where begin end + (count-lines begin end))))))) + + + ((eq what 'update) + + ;; simply update line in index table + (save-excursion + (let ((ref-or-link (if search-is-link "link" "reference"))) + (beginning-of-line) + (if (org-index--update-line search) + (setq message-text (format "Updated %s '%s'" ref-or-link search)) + (setq message-text (format "Did not find %s '%s'" ref-or-link search)))))) + + + ((eq what 'parse) + ;; Just parse the index table, which is already done, so nothing to do + ) + + + ((memq what '(highlight unhighlight)) + + (let ((where "buffer")) + (save-excursion + (save-restriction + (when (and transient-mark-mode + mark-active) + (narrow-to-region (region-beginning) (region-end)) + (setq where "region")) + + (if (eq what 'highlight) + (progn + (highlight-regexp ref-regex 'isearch) + (setq message-text (format "Highlighted references in %s" where))) + (unhighlight-regexp ref-regex) + (setq message-text (format "Removed highlights for references in %s" where))))))) + + + ((memq what '(missing statistics)) + + (goto-char org-index--below-hline) + (let (missing + ref-field + ref + min + max + (total 0)) + + ;; start with list of all references + (setq missing (mapcar (lambda (x) (format "%s%d%s" head x tail)) + (number-sequence 1 maxref))) + + ;; go through table and remove all refs, that we see + (while (and (forward-line) + (org-at-table-p)) + + ;; get ref-field and number + (setq ref-field (org-index--get-field 'ref)) + (if (and ref-field + (string-match ref-regex ref-field)) + (setq ref (string-to-number (match-string 1 ref-field)))) + + ;; remove existing refs from list + (if ref-field (setq missing (delete ref-field missing))) + + ;; record min and max + (if (or (not min) (< ref min)) (setq min ref)) + (if (or (not max) (> ref max)) (setq max ref)) + + ;; count + (setq total (1+ total))) + + ;; insert them, if requested + (forward-line -1) + (if (eq what 'statistics) + + (setq message-text (format "Found %d references from %s to %s. %d references below highest do not appear in table. " + total + (format org-index--ref-format min) + (format org-index--ref-format max) + (length missing))) + + (if (y-or-n-p (format "Found %d missing references; do you wish to append them to the index table" + (length missing))) + (let (type) + (setq type (org-icompleting-read + "Insert new lines for reuse by command \"new\" or just as missing ? " '("reuse" "missing"))) + (mapc (lambda (x) + (let (org-table-may-need-update) (org-table-insert-row t)) + (org-index--get-field 'ref x) + (org-index--get-field 'count (format ":%s:" type))) + missing) + (org-table-align) + (setq message-text (format "Inserted %d new lines for missing refernces" (length missing)))) + (setq message-text (format "%d missing references." (length missing))))))) + + + (t (error "This is a bug: unmatched case '%s'" what))) + + + ;; restore point in buffer or window with index table + (if org-index--point-before + ;; buffer displayed in window need to set point there first + (if (eq (window-buffer active-window-index) + org-index--buffer) + (set-window-point active-window-index org-index--point-before) + ;; set position in buffer in any case and second + (with-current-buffer org-index--buffer + (goto-char org-index--point-before) + (setq org-index--point-before nil)))) + + + ;; remember what we have done for next time + (setq org-index--last-action what) + + ;; tell, what we have done and what can be yanked + (if kill-new-text (setq kill-new-text + (substring-no-properties kill-new-text))) + (if (string= kill-new-text "") (setq kill-new-text nil)) + (let ((m (concat + message-text + (if (and message-text kill-new-text) + " and r" + (if kill-new-text "R" "")) + (if kill-new-text (format "eady to yank '%s'" kill-new-text) "")))) + (unless (string= m "") (message m))) + (if kill-new-text (kill-new kill-new-text))))) + + + +(defun org-index--parse-and-adjust-table () + + (let ((maxref 0) + top + bottom + ref-field + link-field + parts + numcols + head + tail + ref-regex + has-reuse + initial-point) + + (setq initial-point (point)) + (org-index--go-below-hline) + (setq org-index--below-hline (point)) + (setq top (point)) + + ;; count columns + (org-table-goto-column 100) + (setq numcols (- (org-table-current-column) 1)) + + ;; get contents of columns + (forward-line -2) + (unless (org-at-table-p) + (org-index--create-new-index + nil + "Index table starts with a hline")) + + ;; check for optional line consisting solely of width specifications + (beginning-of-line) + (if (looking-at "\\s *|\\(\\(\\s *|\\)\\|\\(\\s *<[0-9]+>\\s *|\\)\\)+\\s *$") + (forward-line -1)) + (org-table-goto-column 1) + + (setq org-index--columns (org-index--parse-headings numcols)) + + ;; Go beyond end of table + (while (org-at-table-p) (forward-line 1)) + + ;; Kill all empty rows at bottom + (while (progn + (forward-line -1) + (org-table-goto-column 1) + (and + (not (org-index--get-field 'ref)) + (not (org-index--get-field 'link)))) + (org-table-kill-row)) + (forward-line) + (setq bottom (point)) + (forward-line -1) + + ;; Retrieve any decorations around the number within the first nonempty ref-field + (goto-char top) + (while (and (org-at-table-p) + (not (setq ref-field (org-index--get-field 'ref)))) + (forward-line)) + + ;; Some Checking + (unless ref-field + (org-index--create-new-index + nil + "Reference column is empty")) + + (unless (string-match "^\\([^0-9]*\\)\\([0-9]+\\)\\([^0-9]*\\)$" ref-field) + (org-index--create-new-index + nil + (format "First reference in index table ('%s') does not contain a number" ref-field))) + + + ;; These are the decorations used within the first ref of index + (setq head (match-string 1 ref-field)) + (setq tail (match-string 3 ref-field)) + (setq ref-regex (concat (regexp-quote head) + "\\([0-9]+\\)" + (regexp-quote tail))) + + ;; Go through table to find maximum number and do some checking + (let ((ref 0)) + + (while (org-at-table-p) + + (setq ref-field (org-index--get-field 'ref)) + (setq link-field (org-index--get-field 'link)) + + (if (and (not ref-field) + (not link-field)) + (throw 'content-error "Columns ref and link are both empty in this line")) + + (if ref-field + (if (string-match ref-regex ref-field) + ;; grab number + (setq ref (string-to-number (match-string 1 ref-field))) + (throw 'content-error "Column ref does not contain a number"))) + + ;; check, if higher ref + (if (> ref maxref) (setq maxref ref)) + + ;; check if ref is ment for reuse + (if (string= (org-index--get-field 'count) ":reuse:") + (setq has-reuse 1)) + + (forward-line 1))) + + ;; sort used to be here + + (setq parts (list head maxref tail numcols ref-regex has-reuse)) + + ;; go back to top of table + (goto-char top) + + parts)) + + + +(defun org-index--sort-table (sort-column) + + (unless sort-column (setq sort-column (org-index--column-num 'sort))) + + (let (top + bottom + ref-field + count-field + count-special) + + + ;; get boundaries of table + (goto-char org-index--below-hline) + (forward-line 0) + (setq top (point)) + (while (org-at-table-p) (forward-line)) + (setq bottom (point)) + + (save-restriction + (narrow-to-region top bottom) + (goto-char top) + (sort-subr t + 'forward-line + 'end-of-line + (lambda () + (let (ref + (ref-field (or (org-index--get-field 'ref) "")) + (count-field (or (org-index--get-field 'count) "")) + (count-special 0)) + + ;; get reference with leading zeroes, so it can be + ;; sorted as text + (string-match org-index--ref-regex ref-field) + (setq ref (format + "%06d" + (string-to-number + (or (match-string 1 ref-field) + "0")))) + + ;; find out, if special token in count-column + (setq count-special (format "%d" + (- 2 + (length (member count-field '(":missing:" ":reuse:")))))) + + ;; Construct different sort-keys according to + ;; requested sort column; prepend count-special to + ;; sort special entries at bottom of table, append ref + ;; as a secondary sort key + (cond + + ((eq sort-column 'count) + (concat count-special + (format + "%08d" + (string-to-number (or (org-index--get-field 'count) + ""))) + ref)) + + ((eq sort-column 'last-accessed) + (concat count-special + (org-index--get-field 'last-accessed) + " " + ref)) + + ((eq sort-column 'ref) + (concat count-special + ref)) + + (t (error "This is a bug: unmatched case '%s'" sort-column))))) + + nil 'string<))) + + ;; align table + (org-table-align)) + + +(defun org-index--go-below-hline () + + ;; go to heading of node + (while (not (org-at-heading-p)) (forward-line -1)) + (forward-line 1) + ;; go to table within node, but make sure we do not get into another node + (while (and (not (org-at-heading-p)) + (not (org-at-table-p)) + (not (eq (point) (point-max)))) + (forward-line 1)) + + ;; check, if there really is a table + (unless (org-at-table-p) + (org-index--create-new-index + t + (format "Cannot find index table within node %s" org-index-id))) + + ;; go to first hline + (while (and (not (org-at-table-hline-p)) + (org-at-table-p)) + (forward-line 1)) + + ;; and check + (unless (org-at-table-hline-p) + (org-index--create-new-index + nil + "Cannot find hline within index table")) + + (forward-line 1) + (org-table-goto-column 1)) + + + +(defun org-index--parse-headings (numcols) + + (let (columns) + + ;; Associate names of special columns with column-numbers + (setq columns (copy-tree '((ref . 0) (link . 0) (created . 0) (last-accessed . 0) + (count . 0) (sort . nil) (copy . nil)))) + + ;; For each column + (dotimes (col numcols) + (let* (field-flags ;; raw heading, consisting of file name and maybe + ;; flags (seperated by ";") + field ;; field name only + field-symbol ;; and as a symbol + flags ;; flags from field-flags + found) + + ;; parse field-flags into field and flags + (setq field-flags (org-trim (org-table-get-field (+ col 1)))) + (if (string-match "^\\([^;]*\\);\\([a-z]+\\)$" field-flags) + (progn + (setq field (downcase (or (match-string 1 field-flags) ""))) + ;; get flags as list of characters + (setq flags (mapcar 'string-to-char + (split-string + (downcase (match-string 2 field-flags)) + "" t)))) + ;; no flags + (setq field field-flags)) + + (unless (string= field "") (setq field-symbol (intern (downcase field)))) + + ;; Check, that no flags appear twice + (mapc (lambda (x) + (when (memq (car x) flags) + (if (cdr (assoc (cdr x) columns)) + (org-index--create-new-index + nil + (format "More than one heading is marked with flag '%c'" (car x)))))) + '((?s . sort) + (?c . copy))) + + ;; Process flags + (if (memq ?s flags) + (setcdr (assoc 'sort columns) field-symbol)) + (if (memq ?c flags) + (setcdr (assoc 'copy columns) (+ col 1))) + + ;; Store columns in alist + (setq found (assoc field-symbol columns)) + (when found + (if (> (cdr found) 0) + (org-index--create-new-index + nil + (format "'%s' appears two times as column heading" (downcase field)))) + (setcdr found (+ col 1))))) + + ;; check if all necessary informations have been specified + (mapc (lambda (col) + (unless (> (cdr (assoc col columns)) 0) + (org-index--create-new-index + nil + (format "column '%s' has not been set" col)))) + '(ref link count created last-accessed)) + + ;; use ref as a default sort-column + (unless (cdr (assoc 'sort columns)) + (setcdr (assoc 'sort columns) 'ref)) + columns)) + + + +(defun org-index--create-new-index (create-new-index reason) + "Create a new empty index table with detailed explanation." + (let (prompt buffer-name title firstref id) + + (setq prompt + (if create-new-index + (concat "There is this problem with the existing index table:\n\n " reason "\n\nThis assistant will guide you to create a new one.\n\nDo you want to proceed ?") + (concat "The existing index table contains this error:\n\n " reason "\n\nYou need to correct this error manually before proceeding. However, this assistant will help you to create an new initial index table with detailed comments, so that you may fix the errors in your existing table more easily.\n\nDo you want to proceed ?"))) + + (unless (y-or-n-p prompt) + (message "Cannot proceed without a valid index table: %s" reason) + ;; show existing index + (when (and org-index--buffer + org-index--point) + (org-pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (org-show-context) + (show-subtree) + (recenter 1) + (delete-other-windows)) + (throw 'created-new-index nil)) + + (setq buffer-name (org-completing-read "Please choose the buffer, where the new node for the index table should be created; the new node will be inserted at its end.\n\nBuffer: " (mapcar 'buffer-name (org-buffer-list)) nil nil)) + + (setq title (read-from-minibuffer "Please enter the title of the index node: ")) + + (while (progn + (setq firstref (read-from-minibuffer "Please enter your first reference-number. This is a number preceeded by some non-digit chars and optionally followed by some more non-digit chars, e.g. 'R1', '-1-' or '#1#' (and your initial number does not need to be '1'). The format of your reference-numbers only needs to make sense for yourself, so that you can spot it easily in your texts or write it on a piece of paper; it should however not already appear to frequently within your existing notes, to avoid too many false hits when searching.\n\nPlease choose: ")) + (if (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref) + nil + (let (desc) + ;; firstref not okay, report details + (setq desc + (cond ((string= firstref "") "is empty") + ((not (string-match "^[^0-9]+" firstref)) "starts with a digit") + ((not (string-match "^[^0-9]+[0-9]+" firstref)) "does not contain a number") + ((not (string-match "^[^0-9]+[0-9]+[^0-9]*$" firstref)) "contains more than one sequence of digits"))) + (read-from-minibuffer (format "Your input '%s' does not meet the requirements because it %s. Please hit RET and try again " firstref desc))) + t))) + + (with-current-buffer buffer-name + (goto-char (point-max)) + (insert (format "\n\n* %s %s\n" firstref title)) + (insert "\n\n Below you find your initial index table, which will grow over time.\n" + " Following that your may read its detailed explanation, which will help you,\n" + " to adopt org-index to your needs. This however is optional reading and not\n" + " required to start using org-index.\n\n") + + (setq id (org-id-get-create)) + (insert (format " + + | | | | | | comment | + | ref | link | created | count;s | last-accessed | ;c | + | | <4> | | | | | + |-----+------+---------+---------+---------------+---------| + | %s | %s | %s | | | %s | + +" + firstref + id + (with-temp-buffer (org-insert-time-stamp nil nil t)) + "This node")) + + + (insert " + + Detailed explanation: + + + The index table above has three lines of headings above the first + hline: + + - The first one is ignored by org-index, and you can use it to + give meaningful names to columns. In the table above only one + column has a name (\"comment\"). This line is optional. + + - The second line is the most important one, because it + contains the configuration information for org-index; please + read further below for its format. + + - The third line is again optional; it may only specify the + widths of the individual columns (e.g. <4>). + + The columns get their meaning by the second line of headings; + specifically by one of the keywords (e.g. \"ref\") or a flag + seperated by a semicolon (e.g. \";s\"). + + + + The keywords and flags are: + + + - ref: This contains the reference, which consists of a decorated + number, which is incremented for each new line. References are + meant to be used in org-mode headlines or outside of org´, + e.g. within folder names. + + - link: org-mode link pointing to the matching location within org. + + - created: When has this line been created ? + + - count: How many times has this line accessed ? The trailing + flag \"s\" makes the table beeing sorted after + this column, so that often used entries appear at the top of + the table. + + - last-accessed: When has this line ben accessed + + - The last column above has no keyword, only the flag \"c\", + which makes its content beeing copied under certain + conditions. It is typically used for comments. + + The sequence of columns does not matter. You may reorder them any + way you like. Columns are found by their name, which appears in + the second line of headings. + + You can add further columns or even remove the last column. All + other columns are required. + + + Finally: This node needs not be a top level node; its name is + completely at you choice; it is found through its ID only. + +") + + + (while (not (org-at-table-p)) (forward-line -1)) + (org-table-align) + (while (not (org-at-heading-p)) (forward-line -1)) + + ;; present results to user + (if (and (not create-new-index) + org-index--buffer + org-index--point) + + ;; we had an error with the existing table, so present old and new one + (progn + ;; show existing index + (org-pop-to-buffer-same-window org-index--buffer) + (goto-char org-index--point) + (org-show-context) + (show-subtree) + (recenter 1) + (delete-other-windows) + ;; show new index + (select-window (split-window-vertically)) + (org-pop-to-buffer-same-window buffer-name) + (org-id-goto id) + (org-show-context) + (show-subtree) + (recenter 1) + (message "Please compare your existing index (upper window) and a temporary new one (lower window) to correct the previous error (\"%s\"); the explanations following the new index table should help." reason)) + + ;; Only show the new index + (org-pop-to-buffer-same-window buffer-name) + (delete-other-windows) + (org-id-goto id) + (org-show-context) + (show-subtree) + (recenter 1) + (setq org-index-id id) + (if (y-or-n-p "This is your new index table; Do you want to save its id to make it permanent ? ") + (progn + (customize-save-variable 'org-index-id id) + (message "Saved org-index-id '%s' to %s" org-index-id custom-file)) + (let (sq) + (setq sq (format "(setq org-index-id \"%s\")" org-index-id)) + (kill-new sq) + (message "Did not make the id of the new index permamanent; you may want to put\n\n %s\n\ninto your own initialization; it is copied already, just yank it." sq))))) + ;; cannot handle this situation in higher code, but do not want to finish with an error + (throw 'created-new-index nil))) + + + + +(defun org-index--update-line (ref-or-link) + + (let (initial + found + count-field) + + (with-current-buffer org-index--buffer + + ;; search reference or link, if given (or assume, that we are already positioned right) + (when ref-or-link + (setq initial (point)) + (goto-char org-index--below-hline) + (while (and (org-at-table-p) + (not (or (string= ref-or-link (org-index--get-field 'ref)) + (string= ref-or-link (org-index--get-field 'link))))) + (forward-line))) + + (if (not (org-at-table-p)) + (error "Did not find reference or link '%s'" ref-or-link) + (setq count-field (org-index--get-field 'count)) + + ;; update count field only if number or empty; leave :missing: and :reuse: as is + (if (or (not count-field) + (string-match "^[0-9]+$" count-field)) + (org-index--get-field 'count + (number-to-string + (+ 1 (string-to-number (or count-field "0")))))) + + ;; update timestamp + (org-table-goto-column (org-index--column-num 'last-accessed)) + (org-table-blank-field) + (org-insert-time-stamp nil t t) + + (setq found t)) + + (if initial (goto-char initial)) + + found))) + + + +(defun org-index--get-field (key &optional value) + (let (field) + (setq field (org-trim (org-table-get-field (cdr (assoc key org-index--columns)) value))) + (if (string= field "") (setq field nil)) + + field)) + + +(defun org-index--column-num (key) + (cdr (assoc key org-index--columns))) + + +(defun org-index--make-guarded-search (ref &optional dont-quote) + (concat "\\b" (if dont-quote ref (regexp-quote ref)) "\\b")) + + +(defun org-index-get-ref-regex-format () + "return cons-cell with regular expression and format for references" + (unless org-index--ref-regex + (org-index-1 'parse)) + (cons (org-index--make-guarded-search org-index--ref-regex 'dont-quote) org-index--ref-format)) + + +(defun org-index--do-occur (initial-search) + (let ( + (occur-buffer-name "*org-index-occur*") + (word "") ; last word to search for growing and shrinking on keystrokes + (prompt "Search for: ") + words ; list of other words that must match too + occur-buffer + lines-to-show ; number of lines to show in window + start-of-lines ; position, where lines begin + left-off-at ; stack of last positions in index table + after-inserted ; in occur-buffer + lines-visible ; in occur-buffer + below-hline-bol ; below-hline and at bol + exit-gracefully ; true if normal exit + in-c-backspace ; true while processing C-backspace + ret from to key) + + ;; clear buffer + (if (get-buffer "*org-index-occur*") + (kill-buffer occur-buffer-name)) + (setq occur-buffer (get-buffer-create "*org-index-occur*")) + + (with-current-buffer org-index--buffer + (let ((initial (point))) + (goto-char org-index--below-hline) + (forward-line 0) + (setq below-hline-bol (point)) + (goto-char initial))) + + (org-pop-to-buffer-same-window occur-buffer) + (toggle-truncate-lines 1) + + (unwind-protect ; to reset cursor-shape even in case of errors + (progn + + ;; fill in header + (erase-buffer) + (insert (concat "Incremental search, showing one window of matches.\n" + "Use DEL and C-DEL to erase, cursor keys to move, RET to find heading.\n\n")) + (setq start-of-lines (point)) + (setq cursor-type 'hollow) + + ;; get window size of occur-buffer as number of lines to be searched + (setq lines-to-show (+ (- (window-body-height) (line-number-at-pos)) 1)) + + + ;; fill initially + (setq ret (org-index--get-matching-lines nil lines-to-show below-hline-bol)) + (when (car ret) + (insert (cdr ret)) + (setq left-off-at (cons (car ret) nil)) + (setq after-inserted (cons (point) nil))) + + ;; read keys + (while + (progn + (goto-char start-of-lines) + (setq lines-visible 0) + + ;; use initial-search (if present) to simulate keyboard input + (if (and initial-search + (> (length initial-search) 0)) + (progn + (setq key (string-to-char (substring initial-search 0 1))) + (if (length initial-search) + (setq initial-search (substring initial-search 1)))) + (if in-c-backspace + (setq key 'backspace) + (setq key (read-event + (format "%s %s" + prompt + (mapconcat 'identity (reverse (cons word words)) ",")))) + + (setq exit-gracefully (memq key (list 'return 'up 'down 'left 'right))))) + + (not exit-gracefully)) + + (cond + + ((eq key 'C-backspace) + + (setq in-c-backspace t)) + + ((eq key 'backspace) ; erase last char + + (if (= (length word) 0) + + ;; nothing more to delete + (setq in-c-backspace nil) + + ;; unhighlight longer match + (let ((case-fold-search t)) + (unhighlight-regexp (regexp-quote word))) + + ;; chars left shorten word + (setq word (substring word 0 -1)) + (when (= (length word) 0) ; when nothing left, use next word from list + (setq word (car words)) + (setq words (cdr words)) + (setq in-c-backspace nil)) + + ;; remove everything, that has been added for char just deleted + (when (cdr after-inserted) + (setq after-inserted (cdr after-inserted)) + (goto-char (car after-inserted)) + (delete-region (point) (point-max))) + + ;; back up last position in index table too + (when (cdr left-off-at) + (setq left-off-at (cdr left-off-at))) + + ;; go through buffer and check, if any invisible line should now be shown + (goto-char start-of-lines) + (while (< (point) (point-max)) + (if (outline-invisible-p) + (progn + (setq from (line-beginning-position) + to (line-beginning-position 2)) + + ;; check for matches + (when (org-index--test-words (cons word words) (buffer-substring from to)) + (when (<= lines-visible lines-to-show) ; show, if more lines required + (outline-flag-region from to nil) + (incf lines-visible)))) + + ;; already visible, just count + (incf lines-visible)) + + (forward-line 1)) + + ;; highlight shorter word + (unless (= (length word) 0) + (let ((case-fold-search t)) + (highlight-regexp (regexp-quote word) 'isearch))))) + + + ((eq key ?,) ; comma: enter an additional search word + + ;; push current word and clear, no need to change display + (setq words (cons word words)) + (setq word "")) + + + ((and (characterp key) + (aref printable-chars key)) ; any other char: add to current search word + + + ;; unhighlight short word + (unless (= (length word) 0) + (let ((case-fold-search t)) + (unhighlight-regexp (regexp-quote word)))) + + ;; add to word + (setq word (concat word (downcase (string key)))) + + ;; hide lines, that do not match longer word any more + (while (< (point) (point-max)) + (unless (outline-invisible-p) + (setq from (line-beginning-position) + to (line-beginning-position 2)) + + ;; check for matches + (if (org-index--test-words (list word) (buffer-substring from to)) + (incf lines-visible) ; count as visible + (outline-flag-region from to t))) ; hide + + (forward-line 1)) + + ;; duplicate top of stacks; eventually overwritten below + (setq left-off-at (cons (car left-off-at) left-off-at)) + (setq after-inserted (cons (car after-inserted) after-inserted)) + + ;; get new lines from index table + (when (< lines-visible lines-to-show) + (setq ret (org-index--get-matching-lines (cons word words) + (- lines-to-show lines-visible) + (car left-off-at))) + + (when (car ret) + (insert (cdr ret)) + (setcar left-off-at (car ret)) + (setcar after-inserted (point)))) + + ;; highlight longer word + (let ((case-fold-search t)) + (highlight-regexp (regexp-quote word) 'isearch))))) + + ;; search is done collect and brush up results + ;; remove any lines, that are still invisible + (goto-char start-of-lines) + (while (< (point) (point-max)) + (if (outline-invisible-p) + (delete-region (line-beginning-position) (line-beginning-position 2)) + (forward-line 1))) + + ;; get all the rest + (message "Getting all matches ...") + (setq ret (org-index--get-matching-lines (cons word words) 0 (car left-off-at))) + (message "done.") + (insert (cdr ret))) + + ;; postprocessing even for non graceful exit + (setq cursor-type t) + ;; replace previous heading + (let ((numlines (count-lines (point) start-of-lines))) + (goto-char start-of-lines) + (forward-line -1) + (delete-region (point-min) (point)) + (insert (format (concat (if exit-gracefully + "Search is done; showing all %d matches.\n" + "Search aborted; showing only some matches.\n") + "Use cursor keys to move, press RET to find heading.\n") + numlines))) + (forward-line)) + + ;; install keyboard-shortcuts within occur-buffer + (let ((keymap (make-sparse-keymap)) + fun-on-ret) + (set-keymap-parent keymap text-mode-map) + + (setq fun-on-ret (lambda () (interactive) + (let ((ref (org-index--get-field 'ref)) + (link (org-index--get-field 'link))) + (org-index-1 'head + (or link ref) ;; prefer link + (if link t nil))))) + + (define-key keymap (kbd "RET") fun-on-ret) + (use-local-map keymap) + + ;; perform action according to last char + (cond + ((eq key 'return) + (funcall fun-on-ret)) + + ((eq key 'up) + (forward-line -1)) + + ((eq key 'down) + (forward-line 1)) + + ((eq key 'left) + (forward-char -1)) + + ((eq key 'right) + (forward-char 1)))))) + + +(defun org-index--get-matching-lines (words numlines start-from) + (let ((numfound 0) + pos + initial line lines) + + (with-current-buffer org-index--buffer + + ;; remember initial pos and start at requested + (setq initial (point)) + (goto-char start-from) + + ;; loop over buffer until we have found enough lines + (while (and (or (< numfound numlines) + (= numlines 0)) + (org-at-table-p)) + + ;; check each word + (setq line (buffer-substring (line-beginning-position) (line-beginning-position 2))) + (when (org-index--test-words words line) + (setq lines (concat lines line)) + (incf numfound)) + (forward-line 1) + (setq pos (point))) + + ;; return to initial position + (goto-char initial)) + + (unless lines (setq lines "")) + (cons pos lines))) + + +(defun org-index--test-words (words line) + (let ((found-all t)) + (setq line (downcase line)) + (catch 'not-found + (dolist (w words) + (or (search w line) + (throw 'not-found nil))) + t))) + + +(defadvice org-mark-ring-goto (after org-index--advice-text-to-yank activate) + "Make text from org-index available for yank." + (when org-index--text-to-yank + (kill-new org-index--text-to-yank) + (message (format "Ready to yank '%s'" org-index--text-to-yank)) + (setq org-index--text-to-yank nil))) + + +(provide 'org-index) + +;; Local Variables: +;; fill-column: 75 +;; comment-column: 50 +;; End: + +;;; org-index.el ends here From 132994911ba1728a45b2d73ba3dc8877c016625e Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sat, 9 Nov 2013 17:47:59 +0100 Subject: [PATCH 069/166] org.el (org-align-tags-here): Fix bug: move to the correct position * org.el (org-align-tags-here): Fix bug: move to the correct position. Thanks to Reuben Garrett for reporting this bug. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 7042d69c7..b5eb285fb 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14416,7 +14416,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (insert (make-string (- ncol (current-column)) ?\ )) (setq ncol (current-column)) (when indent-tabs-mode (tabify p (point-at-eol))) - (org-move-to-column (min ncol col) t)) + (org-move-to-column (min ncol col) t nil t)) (goto-char pos)))) (defun org-set-tags-command (&optional arg just-align) From eca45d57282816c02444285c132b48537797433c Mon Sep 17 00:00:00 2001 From: Marc-Oliver Ihm Date: Sat, 9 Nov 2013 20:23:36 +0100 Subject: [PATCH 070/166] updated README in contrib-directory for org-index.el --- contrib/README | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/contrib/README b/contrib/README index bdbdb4704..15df87cc2 100644 --- a/contrib/README +++ b/contrib/README @@ -30,8 +30,8 @@ org-eval-light.el --- Evaluate in-buffer code on demand org-eval.el --- The tag, adapted from Muse org-expiry.el --- Expiry mechanism for Org entries org-export-generic.el --- Export framework for configurable backends -org-favtable.el --- Lookup table of favorite references and links org-git-link.el --- Provide org links to specific file version +org-index.el --- A personal index for org and beyond org-interactive-query.el --- Interactive modification of tags query org-invoice.el --- Help manage client invoices in OrgMode org-jira.el --- Add a jira:ticket protocol to Org From 84818415e85eafca93150f6dcbede49609c78b26 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 10 Nov 2013 10:18:17 +0100 Subject: [PATCH 071/166] org-element: Fix infloop * lisp/org-element.el (org-element-comment-parser): Fix infloop when a non-empty blank line follows a comment at the end of the buffer. * testing/lisp/test-org-element.el: Add test. --- lisp/org-element.el | 3 +-- testing/lisp/test-org-element.el | 13 +++++++++---- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index f70828a12..6d200245e 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -1633,8 +1633,7 @@ Assume point is at comment beginning." (point))) (end (progn (goto-char com-end) (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'comment (nconc (list :begin begin diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 12372885f..74c611aa2 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -368,15 +368,20 @@ Some other text (should (eq 1 (org-test-with-temp-text "#+keyword: value\n# comment\n#+keyword: value" - (length (org-element-map - (org-element-parse-buffer) 'comment 'identity))))) + (length (org-element-map (org-element-parse-buffer) 'comment + 'identity))))) (should (equal "comment" (org-test-with-temp-text "#+keyword: value\n# comment\n#+keyword: value" (org-element-property :value - (org-element-map - (org-element-parse-buffer) 'comment 'identity nil t)))))) + (org-element-map (org-element-parse-buffer) 'comment + 'identity nil t))))) + ;; Correctly handle non-empty blank lines at the end of buffer. + (should + (org-test-with-temp-text "# A\n " + (goto-char (org-element-property :end (org-element-at-point))) + (eobp)))) ;;;; Comment Block From ede82ccf93648ebefdaac896e875f5a17c148241 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 10 Nov 2013 11:28:14 +0100 Subject: [PATCH 072/166] org-element: Fix infloops * lisp/org-element.el (org-element-center-block-parser) (org-element-drawer-parser, org-element-dynamic-block-parser) (org-element-footnote-definition-parser) (org-element-inlinetask-parser, org-element-property-drawer-parser) (org-element-quote-block-parser, org-element-comment-block-parser) (org-element-diary-sexp-parser, org-element-example-block-parser) (org-element-keyword-parser, org-element-latex-environment-parser) (org-element-paragraph-parser, org-element-src-block-parser) (org-element-table-parser, org-element-verse-block-parser): Fix infloop when buffer ends with a non-empty blank line after the element. * testing/lisp/test-org-element.el: Add tests. --- lisp/org-element.el | 66 +++------ testing/lisp/test-org-element.el | 245 ++++++++++++++++++++----------- 2 files changed, 179 insertions(+), 132 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 6d200245e..55efb5008 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -514,9 +514,9 @@ Assume point is at the beginning of the block." (pos-before-blank (progn (goto-char block-end-line) (forward-line) (point))) - (end (save-excursion (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (end (save-excursion + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) (list 'center-block (nconc (list :begin begin @@ -569,8 +569,7 @@ Assume point is at beginning of drawer." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'drawer (nconc (list :begin begin @@ -629,8 +628,7 @@ Assume point is at beginning of dynamic block." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'dynamic-block (nconc (list :begin begin @@ -692,8 +690,7 @@ Assume point is at the beginning of the footnote definition." (contents-end (and contents-begin ending)) (end (progn (goto-char ending) (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'footnote-definition (nconc (list :label label @@ -972,8 +969,7 @@ Assume point is at beginning of the inline task." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position)))) + (if (eobp) (point) (line-beginning-position)))) (inlinetask (list 'inlinetask (nconc @@ -1323,8 +1319,7 @@ Assume point is at the beginning of the property drawer." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'property-drawer (nconc (list :begin begin @@ -1376,8 +1371,7 @@ Assume point is at the beginning of the block." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'quote-block (nconc (list :begin begin @@ -1466,8 +1460,7 @@ Assume point is at the beginning of the block." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'special-block (nconc (list :type type @@ -1523,8 +1516,7 @@ containing `:begin', `:end', `:info', `:post-blank' and (post-affiliated (point)) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'babel-call (nconc (list :begin begin @@ -1679,8 +1671,7 @@ Assume point is at comment block beginning." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position)))) + (if (eobp) (point) (line-beginning-position)))) (value (buffer-substring-no-properties contents-begin contents-end))) (list 'comment-block @@ -1720,8 +1711,7 @@ containing `:begin', `:end', `:value', `:post-blank' and (org-match-string-no-properties 1))) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'diary-sexp (nconc (list :value value @@ -1831,8 +1821,7 @@ keywords." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'example-block (nconc (list :begin begin @@ -1892,8 +1881,7 @@ Assume point is at export-block beginning." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position)))) + (if (eobp) (point) (line-beginning-position)))) (value (buffer-substring-no-properties contents-begin contents-end))) (list 'export-block @@ -1948,8 +1936,7 @@ Assume point is at the beginning of the fixed-width area." (forward-line)) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'fixed-width (nconc (list :begin begin @@ -1987,8 +1974,7 @@ keywords." (post-affiliated (point)) (post-hr (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'horizontal-rule (nconc (list :begin begin @@ -2025,8 +2011,7 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and (match-end 0) (point-at-eol)))) (pos-before-blank (progn (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'keyword (nconc (list :key key @@ -2073,8 +2058,7 @@ Assume point is at the beginning of the latex environment." (begin (car affiliated)) (value (buffer-substring-no-properties code-begin code-end)) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'latex-environment (nconc (list :begin begin @@ -2206,8 +2190,7 @@ Assume point is at the beginning of the paragraph." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'paragraph (nconc (list :begin begin @@ -2391,8 +2374,7 @@ Assume point is at the beginning of the block." (point))) ;; Get position after ending blank lines. (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'src-block (nconc (list :language language @@ -2468,8 +2450,7 @@ Assume point is at the beginning of the table." acc)) (pos-before-blank (point)) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'table (nconc (list :begin begin @@ -2570,8 +2551,7 @@ Assume point is at beginning of the block." (forward-line) (point))) (end (progn (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (if (bolp) (point) (line-end-position))))) + (if (eobp) (point) (line-beginning-position))))) (list 'verse-block (nconc (list :begin begin diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 74c611aa2..703a2db84 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -239,7 +239,11 @@ Some other text ;; Ignore case. (should (org-test-with-temp-text "#+call: test()" - (org-element-map (org-element-parse-buffer) 'babel-call 'identity)))) + (org-element-map (org-element-parse-buffer) 'babel-call 'identity))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+CALL: test()\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Bold @@ -279,13 +283,17 @@ Some other text (should (org-element-property :hiddenp - (org-element-map - (org-element-parse-buffer) 'center-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'center-block + 'identity nil t)))) ;; Ignore incomplete block. (should-not (org-test-with-temp-text "#+BEGIN_CENTER" - (org-element-map - (org-element-parse-buffer) 'center-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'center-block + 'identity nil t))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_CENTER\nC\n#+END_CENTER\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Clock @@ -379,9 +387,8 @@ Some other text 'identity nil t))))) ;; Correctly handle non-empty blank lines at the end of buffer. (should - (org-test-with-temp-text "# A\n " - (goto-char (org-element-property :end (org-element-at-point))) - (eobp)))) + (org-test-with-temp-text "# A\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Comment Block @@ -391,26 +398,28 @@ Some other text ;; Standard test. (should (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT" - (org-element-map - (org-element-parse-buffer) 'comment-block 'identity))) + (org-element-map (org-element-parse-buffer) 'comment-block 'identity))) ;; Ignore case. (should (org-test-with-temp-text "#+begin_comment\nText\n#+end_comment" - (org-element-map - (org-element-parse-buffer) 'comment-block 'identity))) + (org-element-map (org-element-parse-buffer) 'comment-block 'identity))) ;; Test folded block. (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT" (org-cycle) (should (org-element-property :hiddenp - (org-element-map - (org-element-parse-buffer) 'comment-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'comment-block + 'identity nil t)))) ;; Ignore incomplete block. (should-not (org-test-with-temp-text "#+BEGIN_COMMENT" - (org-element-map - (org-element-parse-buffer) 'comment-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'comment-block + 'identity nil t))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_COMMENT\nC\n#+END_COMMENT\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Diary Sexp @@ -427,7 +436,11 @@ Some other text (should-not (eq 'diary-sexp (org-test-with-temp-text " %%(org-bbdb-anniversaries)" - (org-element-type (org-element-at-point)))))) + (org-element-type (org-element-at-point))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "%%(org-bbdb-anniversaries)\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Drawer @@ -443,14 +456,16 @@ Some other text (should-not (let ((org-drawers '("PROPERTIES"))) (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'drawer 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'drawer 'identity nil t)))) ;; Ignore incomplete drawer. (should-not (let ((org-drawers '("TEST"))) (org-test-with-temp-text ":TEST:" - (org-element-map - (org-element-parse-buffer) 'drawer 'identity nil t))))) + (org-element-map (org-element-parse-buffer) 'drawer 'identity nil t)))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text ":TEST:\nC\n:END:\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Dynamic Block @@ -469,8 +484,8 @@ Some other text (should (org-element-property :hiddenp - (org-element-map - (org-element-parse-buffer) 'dynamic-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'dynamic-block + 'identity nil t)))) ;; Ignore case. (should (org-test-with-temp-text @@ -479,8 +494,12 @@ Some other text ;; Ignore incomplete block. (should-not (org-test-with-temp-text "#+BEGIN: myblock :param1 val1 :param2 val2" - (org-element-map - (org-element-parse-buffer) 'dynamic-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'dynamic-block + 'identity nil t))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN: myblock :param val1\nC\n#+END:\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Entity @@ -559,7 +578,11 @@ Some other text " L1\n L2\n" (org-test-with-temp-text " #+BEGIN_EXAMPLE\n L1\n L2\n #+END_EXAMPLE" (let ((org-src-preserve-indentation t)) - (org-element-property :value (org-element-at-point))))))) + (org-element-property :value (org-element-at-point)))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_EXAMPLE\nC\n#+END_EXAMPLE\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) (ert-deftest test-org-element/block-switches () "Test `example-block' and `src-block' switches parsing." @@ -681,12 +704,10 @@ Some other text "Test `export-block' parser." ;; Standard test. (should - (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX" - (org-element-map - (let ((org-element-block-name-alist - '(("LATEX" . org-element-export-block-parser)))) - (org-element-parse-buffer)) - 'export-block 'identity))) + (let ((org-element-block-name-alist + '(("LATEX" . org-element-export-block-parser)))) + (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX" + (org-element-map (org-element-parse-buffer) 'export-block 'identity)))) ;; Test folded block. (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX" (org-cycle) @@ -694,26 +715,29 @@ Some other text (org-element-property :hiddenp (org-element-map - (let ((org-element-block-name-alist - '(("LATEX" . org-element-export-block-parser)))) - (org-element-parse-buffer)) - 'export-block 'identity nil t)))) + (let ((org-element-block-name-alist + '(("LATEX" . org-element-export-block-parser)))) + (org-element-parse-buffer)) + 'export-block 'identity nil t)))) ;; Ignore case. (should - (org-test-with-temp-text "#+begin_latex\nText\n#+end_latex" - (org-element-map - (let ((org-element-block-name-alist - '(("LATEX" . org-element-export-block-parser)))) - (org-element-parse-buffer)) - 'export-block 'identity))) + (let ((org-element-block-name-alist + '(("LATEX" . org-element-export-block-parser)))) + (org-test-with-temp-text "#+begin_latex\nText\n#+end_latex" + (org-element-map (org-element-parse-buffer) 'export-block 'identity)))) ;; Ignore incomplete block. (should-not - (org-test-with-temp-text "#+BEGIN_LATEX" - (org-element-map - (let ((org-element-block-name-alist - '(("LATEX" . org-element-export-block-parser)))) - (org-element-parse-buffer)) - 'export-block 'identity nil t)))) + (let ((org-element-block-name-alist + '(("LATEX" . org-element-export-block-parser)))) + (org-test-with-temp-text "#+BEGIN_LATEX" + (org-element-map (org-element-parse-buffer) 'export-block + 'identity nil t)))) + ;; Handle non-empty blank line at the end of buffer. + (should + (let ((org-element-block-name-alist + '(("LATEX" . org-element-export-block-parser)))) + (org-test-with-temp-text "#+BEGIN_LATEX\nC\n#+END_LATEX\n " + (= (org-element-property :end (org-element-at-point)) (point-max)))))) ;;;; Export Snippet @@ -733,7 +757,7 @@ Some other text ;;;; Fixed Width -(ert-deftest test-org-element/fixed-width () +(ert-deftest test-org-element/fixed-width-parser () "Test fixed-width area parsing." ;; Preserve indentation. (should @@ -755,8 +779,11 @@ Some other text - Item : fixed-width inside : fixed-width outside" - (org-element-map - (org-element-parse-buffer) 'fixed-width 'identity)))))) + (org-element-map (org-element-parse-buffer) 'fixed-width 'identity))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text ": A\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Footnote Definition @@ -783,8 +810,11 @@ Some other text (should (= 9 (org-test-with-temp-text "[fn:1]\n\n Body" - (org-element-property :contents-begin - (org-element-at-point)))))) + (org-element-property :contents-begin (org-element-at-point))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "[fn:1] Definition\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Footnotes Reference. @@ -955,7 +985,11 @@ Some other text ;; 4 hyphens is too small. (should-not (org-test-with-temp-text "----" - (org-element-map (org-element-parse-buffer) 'horizontal-rule 'identity)))) + (org-element-map (org-element-parse-buffer) 'horizontal-rule 'identity))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "-----\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Inline Babel Call @@ -1054,7 +1088,11 @@ DEADLINE: <2012-03-29 thu.>" :END: *************** END" (forward-line) - (org-element-property :foo (org-element-at-point))))))) + (org-element-property :foo (org-element-at-point)))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "*************** Task\n*************** END\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))))) ;;;; Italic @@ -1113,9 +1151,8 @@ DEADLINE: <2012-03-29 thu.>" - [-] item 1 - [X] item 1.1 - [ ] item 1.2" - (org-element-map - (org-element-parse-buffer) 'item - (lambda (item) (org-element-property :checkbox item)))))) + (org-element-map (org-element-parse-buffer) 'item + (lambda (item) (org-element-property :checkbox item)))))) ;; Folded state. (org-test-with-temp-text "* Headline - item @@ -1131,14 +1168,13 @@ DEADLINE: <2012-03-29 thu.>" (should (equal '(("- item")) (org-test-with-temp-text "- - item" - (org-element-map - (org-element-parse-buffer) 'paragraph 'org-element-contents)))) + (org-element-map (org-element-parse-buffer) 'paragraph + 'org-element-contents)))) ;; Block in an item: ignore indentation within the block. (should (org-test-with-temp-text "- item\n #+begin_src emacs-lisp\n(+ 1 1)\n #+end_src" (forward-char) - (goto-char (org-element-property :end (org-element-at-point))) - (eobp)))) + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Keyword @@ -1164,7 +1200,11 @@ Paragraph" (org-element-map (org-element-parse-buffer) 'keyword 'identity))) (should-not (org-test-with-temp-text "#+BEGIN: my-fun\nBody\n#+END:" - (org-element-map (org-element-parse-buffer) 'keyword 'identity)))) + (org-element-map (org-element-parse-buffer) 'keyword 'identity))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+KEYWORD: value\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Latex Environment @@ -1205,7 +1245,11 @@ e^{i\\pi}+1=0 (should-not (eq 'latex-environment (org-test-with-temp-text "\\begin{env}{arg} something\nvalue\n\\end{env}" - (org-element-type (org-element-at-point)))))) + (org-element-type (org-element-at-point))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "\\begin{env}\n\\end{env}\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Latex Fragment @@ -1458,10 +1502,9 @@ e^{i\\pi}+1=0 (should (eq ?# (org-test-with-temp-text "Paragraph\n# Comment" - (org-element-map - (org-element-parse-buffer) 'paragraph - (lambda (p) (char-after (org-element-property :end p))) - nil t)))) + (org-element-map (org-element-parse-buffer) 'paragraph + (lambda (p) (char-after (org-element-property :end p))) + nil t)))) ;; Include ill-formed Keywords. (should (org-test-with-temp-text "#+wrong_keyword something" @@ -1502,7 +1545,11 @@ e^{i\\pi}+1=0 (let ((elem (progn (search-forward "item") (org-element-at-point)))) (and (eq (org-element-type elem) 'paragraph) (not (org-element-property :attr_latex elem)) - (/= (org-element-property :begin elem) 1)))))) + (/= (org-element-property :begin elem) 1))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_CENTER\nC\n#+END_CENTER\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Plain List @@ -1566,26 +1613,30 @@ Outside list" ;;;; Property Drawer -(ert-deftest test-org-element/property-drawer () +(ert-deftest test-org-element/property-drawer-parser () "Test `property-drawer' parser." ;; Standard test. (should (let ((org-drawers '("PROPERTIES"))) (org-test-with-temp-text ":PROPERTIES:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'property-drawer + 'identity nil t)))) ;; Do not mix property drawers and regular drawers. (should-not (let ((org-drawers '("TEST"))) (org-test-with-temp-text ":TEST:\n:prop: value\n:END:" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'property-drawer + 'identity nil t)))) ;; Ignore incomplete drawer. (should-not (let ((org-drawers '("PROPERTIES"))) (org-test-with-temp-text ":PROPERTIES:\n:prop: value" - (org-element-map - (org-element-parse-buffer) 'property-drawer 'identity nil t))))) + (org-element-map (org-element-parse-buffer) 'property-drawer + 'identity nil t)))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text ":PROPERTIES:\n:END:\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Quote Block @@ -1602,13 +1653,16 @@ Outside list" (should (org-element-property :hiddenp - (org-element-map - (org-element-parse-buffer) 'quote-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'quote-block + 'identity nil t)))) ;; Ignore incomplete block. (should-not (org-test-with-temp-text "#+BEGIN_QUOTE" - (org-element-map - (org-element-parse-buffer) 'quote-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'quote-block 'identity nil t))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_QUOTE\nC\n#+END_QUOTE\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Quote Section @@ -1694,7 +1748,11 @@ Outside list" (org-test-with-temp-text "#+BEGIN_SPECIAL*\nContents\n#+END_SPECIAL*" (let ((element (org-element-at-point))) (list (org-element-type element) - (org-element-property :type element))))))) + (org-element-property :type element)))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_SPECIAL\nC\n#+END_SPECIAL\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Src Block @@ -1740,7 +1798,11 @@ Outside list" " L1\n L2\n" (org-test-with-temp-text " #+BEGIN_SRC org\n L1\n L2\n #+END_SRC" (let ((org-src-preserve-indentation t)) - (org-element-property :value (org-element-at-point))))))) + (org-element-property :value (org-element-at-point)))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_SRC emacs-lisp\nC\n#+END_SRC\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Statistics Cookie @@ -1839,9 +1901,11 @@ Outside list" (length (org-element-property :tblfm (org-element-map - (org-element-parse-buffer) 'table 'identity nil t)))))) - ;; Do not error when parsing a table with trailing white spaces. - (should (org-test-with-temp-text "| a |\n " (org-element-parse-buffer)))) + (org-element-parse-buffer) 'table 'identity nil t)))))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "| a |\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Table Cell @@ -2005,16 +2069,19 @@ Outside list" (should (org-element-property :hiddenp - (org-element-map - (org-element-parse-buffer) 'verse-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'verse-block + 'identity nil t)))) ;; Parse objects in verse blocks. (org-test-with-temp-text "#+BEGIN_VERSE\nVerse \\alpha\n#+END_VERSE" (should (org-element-map (org-element-parse-buffer) 'entity 'identity))) ;; Ignore incomplete verse block. (should-not (org-test-with-temp-text "#+BEGIN_VERSE" - (org-element-map - (org-element-parse-buffer) 'verse-block 'identity nil t)))) + (org-element-map (org-element-parse-buffer) 'verse-block 'identity nil t))) + ;; Handle non-empty blank line at the end of buffer. + (should + (org-test-with-temp-text "#+BEGIN_VERSE\nC\n#+END_VERSE\n " + (= (org-element-property :end (org-element-at-point)) (point-max))))) From 6cc028bf741e2986ce8dd913f2de1c56de0ab11b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 11 Nov 2013 01:54:01 +0100 Subject: [PATCH 073/166] ox: Fix next/previous element getters * lisp/ox.el (org-export-get-previous-element, org-export-get-next-element): Fix return value for non plain text objects in a secondary string. * testing/lisp/test-ox.el: Add tests. --- lisp/ox.el | 26 ++++++++++---------------- testing/lisp/test-ox.el | 12 ++++++++++++ 2 files changed, 22 insertions(+), 16 deletions(-) diff --git a/lisp/ox.el b/lisp/ox.el index 72a7a056c..f7566945a 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -5151,14 +5151,11 @@ all of them." ;; to a secondary string. We check the latter option ;; first. (let ((parent (org-export-get-parent blob))) - (or (and (not (memq (org-element-type blob) - org-element-all-elements)) - (let ((sec-value - (org-element-property - (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)) - parent))) - (and (memq blob sec-value) sec-value))) + (or (let ((sec-value (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (and (memq blob sec-value) sec-value)) (org-element-contents parent)))) prev) (catch 'exit @@ -5186,14 +5183,11 @@ them." ;; An object can belong to the contents of its parent or to ;; a secondary string. We check the latter option first. (let ((parent (org-export-get-parent blob))) - (or (and (not (memq (org-element-type blob) - org-element-all-objects)) - (let ((sec-value - (org-element-property - (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)) - parent))) - (cdr (memq blob sec-value)))) + (or (let ((sec-value (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (cdr (memq blob sec-value))) (cdr (memq blob (org-element-contents parent)))))) next) (catch 'exit diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 7741e98fe..b81256759 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -2723,6 +2723,12 @@ Another text. (ref:text) (org-element-type (org-export-get-next-element (org-element-map tree 'plain-text 'identity info t) info))))) + (should + (eq 'verbatim + (org-test-with-parsed-data "* /italic/ =verb=" + (org-element-type + (org-export-get-next-element + (org-element-map tree 'italic 'identity info t) info))))) ;; Find next element in document keywords. (should (eq 'verbatim @@ -2783,6 +2789,12 @@ Another text. (ref:text) (org-element-type (org-export-get-previous-element (org-element-map tree 'plain-text 'identity info t) info))))) + (should + (eq 'verbatim + (org-test-with-parsed-data "* =verb= /italic/" + (org-element-type + (org-export-get-previous-element + (org-element-map tree 'italic 'identity info t) info))))) ;; Find previous element in document keywords. (should (eq 'verbatim From fb239ceb7ad71c2bcae2a64a50cf3cc50d8d0c3b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 11 Nov 2013 10:09:21 +0100 Subject: [PATCH 074/166] ox-texinfo: Fix incorrect @documentencoding * lisp/ox-texinfo.el (org-texinfo-supported-coding-systems): New variable. (org-texinfo-template): Find appropriate encoding among those supported. Reported-by: Suvayu Ali --- lisp/ox-texinfo.el | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index 29fbc077b..596797845 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -410,6 +410,13 @@ set `org-texinfo-logfiles-extensions'." this depth Texinfo will not recognize the nodes and will cause errors. Left as a constant in case this value ever changes.") +(defconst org-texinfo-supported-coding-systems + '("US-ASCII" "UTF-8" "ISO-8859-15" "ISO-8859-1" "ISO-8859-2" "koi8-r" "koi8-u") + "List of coding systems supported by Texinfo, as strings. +Specified coding system will be matched against these strings. +If two strings share the same prefix (e.g. \"ISO-8859-1\" and +\"ISO-8859-15\"), the most specific one has to be listed first.") + ;;; Internal Functions @@ -695,9 +702,7 @@ holding export options." ;; `.' in text. (dirspacing (- 29 (length dirtitle))) (menu (org-texinfo-make-menu info 'main)) - (detail-menu (org-texinfo-make-menu info 'detailed)) - (coding-system (or org-texinfo-coding-system - buffer-file-coding-system))) + (detail-menu (org-texinfo-make-menu info 'detailed))) (concat ;; Header header "\n" @@ -705,8 +710,17 @@ holding export options." ;; Filename and Title "@setfilename " info-filename "\n" "@settitle " title "\n" - (format "@documentencoding %s\n" - (upcase (symbol-name coding-system))) "\n" + ;; Coding system. + (format + "@documentencoding %s\n" + (catch 'coding-system + (let ((case-fold-search t) + (name (symbol-name (or org-texinfo-coding-system + buffer-file-coding-system)))) + (dolist (system org-texinfo-supported-coding-systems "UTF-8") + (when (org-string-match-p (regexp-quote system) name) + (throw 'coding-system system)))))) + "\n" (format "@documentlanguage %s\n" lang) "\n\n" "@c Version and Contact Info\n" From f1016634895b828d79f6ca09e4d9f75ad00261dd Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 11 Nov 2013 13:16:43 +0100 Subject: [PATCH 075/166] org-element: Interpret pseudo elements and objects * lisp/org-element.el (org-element-interpret-data): Change signature. One can now define pseudo elements and objects types. (org-element--interpret-data-1): New function. * testing/lisp/test-org-element.el: Add tests. * testing/lisp/test-ox.el: Update tests. A pseudo element or object is a new element or object type that is created and treated locally within an export back-end. The back-end provides a translator for it and it is ignored when interpreted back into Org syntax. --- lisp/org-element.el | 94 +++++++++++++++++++------------- testing/lisp/test-org-element.el | 26 ++++++--- testing/lisp/test-ox.el | 8 +-- 3 files changed, 80 insertions(+), 48 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 0d71a4622..5e252ea76 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4387,71 +4387,91 @@ beginning position." ;; `org-element--interpret-affiliated-keywords'. ;;;###autoload -(defun org-element-interpret-data (data &optional parent) +(defun org-element-interpret-data (data &optional pseudo-objects) "Interpret DATA as Org syntax. DATA is a parse tree, an element, an object or a secondary string to interpret. -Optional argument PARENT is used for recursive calls. It contains -the element or object containing data, or nil. +Optional argument PSEUDO-OBJECTS is a list of symbols defining +new types that should be treated as objects. An unknown type not +belonging to this list is seen as a pseudo-element instead. Both +pseudo-objects and pseudo-elements are transparent entities, i.e. +only their contents are interpreted. + +Return Org syntax as a string." + (org-element--interpret-data-1 data nil pseudo-objects)) + +(defun org-element--interpret-data-1 (data parent pseudo-objects) + "Interpret DATA as Org syntax. + +DATA is a parse tree, an element, an object or a secondary string +to interpret. PARENT is used for recursive calls. It contains +the element or object containing data, or nil. PSEUDO-OBJECTS +are list of symbols defining new element or object types. +Unknown types that don't belong to this list are treated as +pseudo-elements instead. Return Org syntax as a string." (let* ((type (org-element-type data)) + ;; Find interpreter for current object or element. If it + ;; doesn't exist (e.g. this is a pseudo object or element), + ;; return contents, if any. + (interpret + (let ((fun (intern (format "org-element-%s-interpreter" type)))) + (if (fboundp fun) fun (lambda (data contents) contents)))) (results (cond ;; Secondary string. ((not type) (mapconcat - (lambda (obj) (org-element-interpret-data obj parent)) + (lambda (obj) + (org-element--interpret-data-1 obj parent pseudo-objects)) data "")) ;; Full Org document. ((eq type 'org-data) (mapconcat - (lambda (obj) (org-element-interpret-data obj parent)) + (lambda (obj) + (org-element--interpret-data-1 obj parent pseudo-objects)) (org-element-contents data) "")) ;; Plain text: remove `:parent' text property from output. ((stringp data) (org-no-properties data)) - ;; Element/Object without contents. - ((not (org-element-contents data)) - (funcall (intern (format "org-element-%s-interpreter" type)) - data nil)) - ;; Element/Object with contents. + ;; Element or object without contents. + ((not (org-element-contents data)) (funcall interpret data nil)) + ;; Element or object with contents. (t - (let* ((greaterp (memq type org-element-greater-elements)) - (objectp (and (not greaterp) - (memq type org-element-recursive-objects))) - (contents - (mapconcat - (lambda (obj) (org-element-interpret-data obj data)) - (org-element-contents - (if (or greaterp objectp) data - ;; Elements directly containing objects must - ;; have their indentation normalized first. - (org-element-normalize-contents - data - ;; When normalizing first paragraph of an - ;; item or a footnote-definition, ignore - ;; first line's indentation. - (and (eq type 'paragraph) - (equal data (car (org-element-contents parent))) - (memq (org-element-type parent) - '(footnote-definition item)))))) - ""))) - (funcall (intern (format "org-element-%s-interpreter" type)) - data - (if greaterp (org-element-normalize-contents contents) - contents))))))) + (funcall interpret data + ;; Recursively interpret contents. + (mapconcat + (lambda (obj) + (org-element--interpret-data-1 obj data pseudo-objects)) + (org-element-contents + (if (not (memq type '(paragraph verse-block))) + data + ;; Fix indentation of elements containing + ;; objects. We ignore `table-row' elements + ;; as they are one line long anyway. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of an + ;; item or a footnote-definition, ignore + ;; first line's indentation. + (and (eq type 'paragraph) + (equal data (car (org-element-contents parent))) + (memq (org-element-type parent) + '(footnote-definition item)))))) + "")))))) (if (memq type '(org-data plain-text nil)) results ;; Build white spaces. If no `:post-blank' property is ;; specified, assume its value is 0. (let ((post-blank (or (org-element-property :post-blank data) 0))) - (if (memq type org-element-all-objects) - (concat results (make-string post-blank 32)) + (if (or (memq type org-element-all-objects) + (memq type pseudo-objects)) + (concat results (make-string post-blank ?\s)) (concat (org-element--interpret-affiliated-keywords data) (org-element-normalize-string results) - (make-string post-blank 10))))))) + (make-string post-blank ?\n))))))) (defun org-element--interpret-affiliated-keywords (element) "Return ELEMENT's affiliated keywords as Org syntax. diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index b38a2e88f..ad98199b5 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -1989,27 +1989,27 @@ Outside list" ;;; Test Interpreters. -(ert-deftest test-org-element/affiliated-keywords-interpreter () - "Test if affiliated keywords are correctly interpreted." - ;; Interpret simple keywords. +(ert-deftest test-org-element/interpret-data () + "Test `org-element-interpret-data' specifications." + ;; Interpret simple affiliated keywords. (should (equal (org-element-interpret-data '(org-data nil (paragraph (:name "para") "Paragraph"))) "#+NAME: para\nParagraph\n")) - ;; Interpret multiple keywords. + ;; Interpret multiple affiliated keywords. (should (equal (org-element-interpret-data '(org-data nil (paragraph (:attr_ascii ("line2" "line1")) "Paragraph"))) "#+ATTR_ASCII: line1\n#+ATTR_ASCII: line2\nParagraph\n")) - ;; Interpret parsed keywords. + ;; Interpret parsed affiliated keywords. (should (equal (org-element-interpret-data '(org-data nil (paragraph (:caption (("caption"))) "Paragraph"))) "#+CAPTION: caption\nParagraph\n")) - ;; Interpret dual keywords. + ;; Interpret dual affiliated keywords. (should (equal (org-element-interpret-data @@ -2021,7 +2021,19 @@ Outside list" (org-element-interpret-data '(org-data nil (paragraph (:caption ((("l2") "s2") (("l1") "s1"))) "Paragraph"))) - "#+CAPTION[s1]: l1\n#+CAPTION[s2]: l2\nParagraph\n"))) + "#+CAPTION[s1]: l1\n#+CAPTION[s2]: l2\nParagraph\n")) + ;; Pseudo objects and elements are transparent. + (should + (equal "A B\n" + (org-element-interpret-data + '(paragraph nil (pseudo-object (:post-blank 1) "A") "B") + '(pseudo-object)))) + (should + (equal "A\n\nB\n" + (org-element-interpret-data + '(center nil + (pseudo-element (:post-blank 1) (paragraph nil "A")) + (paragraph nil "B")))))) (ert-deftest test-org-element/center-block-interpreter () "Test center block interpreter." diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 47fc3d13f..b375f9c35 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -281,7 +281,7 @@ Paragraph" :transcoders '((template . (lambda (text info) (org-element-interpret-data - (plist-get info :title) info)))))) + (plist-get info :title))))))) (file-name-nondirectory (file-name-sans-extension (buffer-file-name))))))) ;; If no title is specified, and no file is associated to the @@ -296,7 +296,7 @@ Paragraph" :transcoders '((template . (lambda (text info) (org-element-interpret-data - (plist-get info :title) info)))))) + (plist-get info :title))))))) (buffer-name))))) ;; If a title is specified, use it. (should @@ -309,7 +309,7 @@ Paragraph" :transcoders '((template . (lambda (text info) (org-element-interpret-data - (plist-get info :title) info))))))))) + (plist-get info :title)))))))))) ;; If an empty title is specified, do not set it. (should (equal @@ -321,7 +321,7 @@ Paragraph" :transcoders '((template . (lambda (text info) (org-element-interpret-data - (plist-get info :title) info)))))))))) + (plist-get info :title))))))))))) (ert-deftest test-org-export/handle-options () "Test if export options have an impact on output." From 60db8b535bd7b626222373b738dd17d81a84f224 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 11 Nov 2013 16:59:19 +0100 Subject: [PATCH 076/166] README_maintainer: Fix erroneous statement * README_maintainer: Fix erroneous statement. --- README_maintainer | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/README_maintainer b/README_maintainer index fed9867b6..04dc2c087 100644 --- a/README_maintainer +++ b/README_maintainer @@ -136,10 +136,8 @@ So the way I have been doing things with Emacs is this: version in Emacs starts diverging from my own. Careful: Copy /org.texi/ and /orgcard.tex/ into the right places, - and also copy the lisp files with *two exceptions*: Do *not* copy - /org-colview-xemacs.el/ and /org-loaddefs.el/. The former does not - belong in Emacs. And the latter would actually be harmful because - Emacs generates its own autoloads. + and also copy the lisp files with *one exception*: Do *not* copy + /org-loaddefs.el/, Emacs generates its own autoloads. 4. Generate the ChangeLog entries From 086d502c91ba7e5c3a8a6a4a5f450cfea3175fdc Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 11 Nov 2013 17:01:21 +0100 Subject: [PATCH 077/166] org.el (org-todo): Tiny docstring enhancement * org.el (org-todo): Tiny docstring enhancement. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index ac245c608..63a27f4e3 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12145,7 +12145,7 @@ keywords (nextset). With a triple \\[universal-argument] prefix, circumvent any state blocking. With a numeric prefix arg of 0, inhibit note taking for the change. -For calling through lisp, arg is also interpreted in the following way: +When called through ELisp, arg is also interpreted in the following way: 'none -> empty state \"\"(empty string) -> switch to empty state 'done -> switch to DONE From cd35ad9314e3b2f06542c98c939cf6580b9e6eb5 Mon Sep 17 00:00:00 2001 From: Sebastien Vauban Date: Thu, 7 Nov 2013 16:24:53 +0100 Subject: [PATCH 078/166] Improve "Processing Org code block" message * ob-exp.el (org-babel-exp-src-block): Improve message by adding line number. --- lisp/ob-exp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index c8479e36d..387433825 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -110,12 +110,14 @@ none ---- do not display either code or results upon export Assume point is at the beginning of block's starting line." (interactive) - (unless noninteractive (message "org-babel-exp processing...")) (save-excursion (let* ((info (org-babel-get-src-block-info 'light)) + (line (org-current-line)) (lang (nth 0 info)) (raw-params (nth 2 info)) hash) ;; bail if we couldn't get any info from the block + (unless noninteractive + (message "Processing %s code block at line %d..." lang line)) (when info ;; if we're actually going to need the parameters (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) From 51638aed3e129ba1aec5f62674d3850640679765 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Mon, 11 Nov 2013 09:33:05 -0700 Subject: [PATCH 079/166] change wording of processing message * lisp/ob-exp.el (org-babel-exp-src-block): Tweak wording of processing message. --- lisp/ob-exp.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 387433825..24fe19c5f 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -117,7 +117,7 @@ Assume point is at the beginning of block's starting line." (raw-params (nth 2 info)) hash) ;; bail if we couldn't get any info from the block (unless noninteractive - (message "Processing %s code block at line %d..." lang line)) + (message "org-babel-exp process %s at line %d..." lang line)) (when info ;; if we're actually going to need the parameters (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) From 6a577a2b5aed5ea98f23b83965affe8888243ac8 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 11 Nov 2013 18:13:08 +0100 Subject: [PATCH 080/166] org.el (org-deadline, org-schedule): Fix bug * org.el (org-deadline, org-schedule): Fix bug: allow to update scheduled/deadline information anywhere in the subtree. --- lisp/org.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/org.el b/lisp/org.el index b5eb285fb..4a74d44fe 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12960,6 +12960,7 @@ can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (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) @@ -13030,6 +13031,7 @@ either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." (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) From e4984e2783d009476e31406417b76a1557ce5187 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Mon, 11 Nov 2013 12:16:32 -0700 Subject: [PATCH 081/166] fix tangle bug, checking empty headlines commented Thanks to Michael Brand for catching this bug. * lisp/ob-tangle.el (org-babel-under-commented-heading-p): robust to empty headlines. --- lisp/ob-tangle.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 6b7fa24a6..88528f304 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -361,8 +361,8 @@ that the appropriate major-mode is set. SPEC has the form: (defvar org-comment-string) ;; Defined in org.el (defun org-babel-under-commented-heading-p () "Return t if currently under a commented heading." - (if (string-match (concat "^" org-comment-string) - (nth 4 (org-heading-components))) + (if (let ((hd (nth 4 (org-heading-components)))) + (and hd (string-match (concat "^" org-comment-string) hd))) t (save-excursion (and (org-up-heading-safe) From f95641c443f5491858bd2a661fc0f31733e3a879 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 12 Nov 2013 20:57:31 +0100 Subject: [PATCH 082/166] Backport changes from Emacs revs 115081 and 115082 2013-11-12 Stefan Monnier Address some byte-compiler warnings. * ob-abc.el (org-babel-expand-body:abc): Use dolist. (org-babel-execute:abc): Fix regexp quoting. * ob-calc.el (org--var-syms): Rename from `var-syms'. * ob-lilypond.el (ly-compile-lilyfile): Remove redundant let-binding. * ob-table.el (sbe): Move debug declaration. * org-clock.el (org--msg-extra): Rename from `msg-extra'. * org.el (org-version): Avoid var name starting with _. (org-inhibit-startup, org-called-with-limited-levels) (org-link-search-inhibit-query, org-time-was-given) (org-end-time-was-given, org-def, org-defdecode, org-with-time): * org-colview.el (org-agenda-overriding-columns-format): * org-agenda.el (org-agenda-multi, org-depend-tag-blocked) (org-agenda-show-log-scoped): * ob-python.el (py-which-bufname, python-shell-buffer-name): * ob-haskell.el (org-export-copy-to-kill-ring): * ob-exp.el (org-link-search-inhibit-query): * ob-R.el (ess-eval-visibly-p): * ob-core.el (org-src-window-setup): Declare before use. (org-babel-expand-noweb-references): Remove unused `blocks-in-buffer'. * ox-odt.el (org-odt-hfy-face-to-css): * org-src.el (org-src-associate-babel-session, org-src-get-lang-mode): * org-bibtex.el (org-bibtex-get, org-bibtex-ask, org-bibtex) (org-bibtex-check): * ob-tangle.el (org-babel-tangle, org-babel-spec-to-string) (org-babel-tangle-single-block, org-babel-tangle-comment-links): * ob-table.el (sbe): * ob-sqlite.el (org-babel-sqlite-expand-vars): * ob-sql.el (org-babel-sql-expand-vars): * ob-shen.el (org-babel-execute:shen): * ob-sh.el (org-babel-execute:sh, org-babel-sh-evaluate): * ob-scala.el (org-babel-scala-evaluate): * ob-ruby.el (org-babel-ruby-table-or-string) (org-babel-ruby-evaluate): * ob-python.el (org-babel-python-table-or-string) (org-babel-python-evaluate-external-process) (org-babel-python-evaluate-session): * ob-picolisp.el (org-babel-execute:picolisp): * ob-perl.el (org-babel-perl-evaluate): * ob-maxima.el (org-babel-execute:maxima): * ob-lisp.el (org-babel-execute:lisp): * ob-java.el (org-babel-execute:java): * ob-io.el (org-babel-io-evaluate): * ob-haskell.el (org-babel-execute:haskell): * ob-fortran.el (org-babel-execute:fortran): * ob-exp.el (org-babel-exp-code): * ob-emacs-lisp.el (org-babel-execute:emacs-lisp): * ob-ditaa.el (org-babel-execute:ditaa): * ob-core.el (org-babel-execute-src-block, org-babel-sha1-hash) (org-babel-parse-header-arguments, org-babel-reassemble-table) (org-babel-goto-src-block-head, org-babel-mark-block) (org-babel-expand-noweb-references, org-babel-script-escape) (org-babel-process-file-name): * ob-clojure.el (org-babel-execute:clojure): * ob-calc.el (org-babel-execute:calc): * ob-awk.el (org-babel-execute:awk): * ob-abc.el (org-babel-execute:abc): * ob-R.el (org-babel-expand-body:R): * ob-C.el (org-babel-C-execute): Avoid deprecated ((lambda) ...). 2013-11-12 Glenn Morris * ox-html.el (org-html-scripts): Add 2013 to copyright years. (org-html-infojs-template): Copyright holder to FSF. --- lisp/ob-C.el | 29 ++-- lisp/ob-R.el | 33 ++--- lisp/ob-awk.el | 33 +++-- lisp/ob-calc.el | 43 +++--- lisp/ob-clojure.el | 34 ++--- lisp/ob-core.el | 300 +++++++++++++++++++++--------------------- lisp/ob-ditaa.el | 9 +- lisp/ob-emacs-lisp.el | 39 +++--- lisp/ob-exp.el | 4 +- lisp/ob-fortran.el | 28 ++-- lisp/ob-haskell.el | 13 +- lisp/ob-io.el | 11 +- lisp/ob-java.el | 25 ++-- lisp/ob-lilypond.el | 1 - lisp/ob-lisp.el | 35 ++--- lisp/ob-makefile.el | 2 +- lisp/ob-maxima.el | 28 ++-- lisp/ob-perl.el | 30 ++--- lisp/ob-picolisp.el | 105 +++++++-------- lisp/ob-python.el | 129 +++++++++--------- lisp/ob-ruby.el | 24 ++-- lisp/ob-scala.el | 11 +- lisp/ob-sh.el | 131 +++++++++--------- lisp/ob-shen.el | 16 +-- lisp/ob-sql.el | 24 ++-- lisp/ob-sqlite.el | 25 ++-- lisp/ob-table.el | 53 ++++---- lisp/ob-tangle.el | 74 +++++------ lisp/org-agenda.el | 6 +- lisp/org-bibtex.el | 50 +++---- lisp/org-clock.el | 14 +- lisp/org-colview.el | 8 +- lisp/org-macro.el | 2 + lisp/org-src.el | 10 +- lisp/org.el | 27 ++-- lisp/ox-ascii.el | 4 +- lisp/ox-beamer.el | 4 +- lisp/ox-html.el | 8 +- lisp/ox-icalendar.el | 4 +- lisp/ox-latex.el | 2 + lisp/ox-md.el | 4 +- lisp/ox-odt.el | 11 +- lisp/ox-org.el | 4 +- lisp/ox-texinfo.el | 2 +- lisp/ox.el | 4 +- 45 files changed, 740 insertions(+), 713 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index e9eec934d..ddceb14f6 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -103,20 +103,21 @@ or `org-babel-execute:C++'." (mapconcat 'identity (if (listp flags) flags (list flags)) " ") (org-babel-process-file-name tmp-src-file)) "")))) - ((lambda (results) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + (let ((results + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) + )) (defun org-babel-C-expand (body params) "Expand a block of C or C++ code with org-babel according to diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 74d7513df..58f553667 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -85,21 +85,22 @@ (or graphics-file (org-babel-R-graphical-output-file params)))) (mapconcat #'identity - ((lambda (inside) - (if graphics-file - (append - (list (org-babel-R-construct-graphics-device-call - graphics-file params)) - inside - (list "dev.off()")) - inside)) - (append - (when (cdr (assoc :prologue params)) - (list (cdr (assoc :prologue params)))) - (org-babel-variable-assignments:R params) - (list body) - (when (cdr (assoc :epilogue params)) - (list (cdr (assoc :epilogue params)))))) "\n"))) + (let ((inside + (append + (when (cdr (assoc :prologue params)) + (list (cdr (assoc :prologue params)))) + (org-babel-variable-assignments:R params) + (list body) + (when (cdr (assoc :epilogue params)) + (list (cdr (assoc :epilogue params))))))) + (if graphics-file + (append + (list (org-babel-R-construct-graphics-device-call + graphics-file params)) + inside + (list "dev.off()")) + inside)) + "\n"))) (defun org-babel-execute:R (body params) "Execute a block of R code. @@ -324,6 +325,8 @@ last statement in BODY, as elisp." column-names-p))) (output (org-babel-eval org-babel-R-command body)))) +(defvar ess-eval-visibly-p) + (defun org-babel-R-evaluate-session (session body result-type result-params column-names-p row-names-p) "Evaluate BODY in SESSION. diff --git a/lisp/ob-awk.el b/lisp/ob-awk.el index 373d5fd98..a9215d0b1 100644 --- a/lisp/ob-awk.el +++ b/lisp/ob-awk.el @@ -59,34 +59,33 @@ called by `org-babel-execute-src-block'" (cmd-line (cdr (assoc :cmd-line params))) (in-file (cdr (assoc :in-file params))) (full-body (org-babel-expand-body:awk body params)) - (code-file ((lambda (file) (with-temp-file file (insert full-body)) file) - (org-babel-temp-file "awk-"))) - (stdin ((lambda (stdin) + (code-file (let ((file (org-babel-temp-file "awk-"))) + (with-temp-file file (insert full-body)) file)) + (stdin (let ((stdin (cdr (assoc :stdin params)))) (when stdin (let ((tmp (org-babel-temp-file "awk-stdin-")) (res (org-babel-ref-resolve stdin))) (with-temp-file tmp (insert (org-babel-awk-var-to-awk res))) - tmp))) - (cdr (assoc :stdin params)))) + tmp)))) (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command "-f" code-file cmd-line in-file)) " "))) (org-babel-reassemble-table - ((lambda (results) - (when results - (org-babel-result-cond result-params - results - (let ((tmp (org-babel-temp-file "awk-results-"))) - (with-temp-file tmp (insert results)) - (org-babel-import-elisp-from-file tmp))))) - (cond - (stdin (with-temp-buffer - (call-process-shell-command cmd stdin (current-buffer)) - (buffer-string))) - (t (org-babel-eval cmd "")))) + (let ((results + (cond + (stdin (with-temp-buffer + (call-process-shell-command cmd stdin (current-buffer)) + (buffer-string))) + (t (org-babel-eval cmd ""))))) + (when results + (org-babel-result-cond result-params + results + (let ((tmp (org-babel-temp-file "awk-results-"))) + (with-temp-file tmp (insert results)) + (org-babel-import-elisp-from-file tmp))))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name diff --git a/lisp/ob-calc.el b/lisp/ob-calc.el index 766f6cebb..b4201a18a 100644 --- a/lisp/ob-calc.el +++ b/lisp/ob-calc.el @@ -42,13 +42,15 @@ (defun org-babel-expand-body:calc (body params) "Expand BODY according to PARAMS, return the expanded body." body) +(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc + (defun org-babel-execute:calc (body params) "Execute a block of calc code with Babel." (unless (get-buffer "*Calculator*") (save-window-excursion (calc) (calc-quit))) (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (var-syms (mapcar #'car vars)) - (var-names (mapcar #'symbol-name var-syms))) + (org--var-syms (mapcar #'car vars)) + (var-names (mapcar #'symbol-name org--var-syms))) (mapc (lambda (pair) (calc-push-list (list (cdr pair))) @@ -66,33 +68,32 @@ ;; complex expression (t (calc-push-list - (list ((lambda (res) - (cond - ((numberp res) res) - ((math-read-number res) (math-read-number res)) - ((listp res) (error "Calc error \"%s\" on input \"%s\"" - (cadr res) line)) - (t (replace-regexp-in-string - "'" "" - (calc-eval - (math-evaluate-expr - ;; resolve user variables, calc built in - ;; variables are handled automatically - ;; upstream by calc - (mapcar #'org-babel-calc-maybe-resolve-var - ;; parse line into calc objects - (car (math-read-exprs line))))))))) - (calc-eval line)))))))) + (list (let ((res (calc-eval line))) + (cond + ((numberp res) res) + ((math-read-number res) (math-read-number res)) + ((listp res) (error "Calc error \"%s\" on input \"%s\"" + (cadr res) line)) + (t (replace-regexp-in-string + "'" "" + (calc-eval + (math-evaluate-expr + ;; resolve user variables, calc built in + ;; variables are handled automatically + ;; upstream by calc + (mapcar #'org-babel-calc-maybe-resolve-var + ;; parse line into calc objects + (car (math-read-exprs line))))))))) + )))))) (mapcar #'org-babel-trim (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) (save-excursion (with-current-buffer (get-buffer "*Calculator*") (calc-eval (calc-top 1))))) -(defvar var-syms) ; Dynamically scoped from org-babel-execute:calc (defun org-babel-calc-maybe-resolve-var (el) (if (consp el) - (if (and (equal 'var (car el)) (member (cadr el) var-syms)) + (if (and (equal 'var (car el)) (member (cadr el) org--var-syms)) (progn (calc-recall (cadr el)) (prog1 (calc-top 1) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index bc2bbc0d0..25b39f7f7 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -24,17 +24,17 @@ ;;; Commentary: -;;; support for evaluating clojure code, relies on slime for all eval +;; Support for evaluating clojure code, relies on slime for all eval. ;;; Requirements: -;;; - clojure (at least 1.2.0) -;;; - clojure-mode -;;; - slime +;; - clojure (at least 1.2.0) +;; - clojure-mode +;; - slime -;;; By far, the best way to install these components is by following -;;; the directions as set out by Phil Hagelberg (Technomancy) on the -;;; web page: http://technomancy.us/126 +;; By far, the best way to install these components is by following +;; the directions as set out by Phil Hagelberg (Technomancy) on the +;; web page: http://technomancy.us/126 ;;; Code: (require 'ob) @@ -77,16 +77,16 @@ (require 'slime) (with-temp-buffer (insert (org-babel-expand-body:clojure body params)) - ((lambda (result) - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - result - (condition-case nil (org-babel-script-escape result) - (error result))))) - (slime-eval - `(swank:eval-and-grab-output - ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assoc :package params)))))) + (let ((result + (slime-eval + `(swank:eval-and-grab-output + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assoc :package params))))) + (let ((result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + result + (condition-case nil (org-babel-script-escape result) + (error result))))))) (provide 'ob-clojure) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index cc6b7a93d..0ec945d6a 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -632,15 +632,14 @@ block." (message "result silenced") (setq result nil)) (setq result - ((lambda (result) - (if (and (eq (cdr (assoc :result-type params)) - 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) result)) - (funcall cmd body params))) - ;; if non-empty result and :file then write to :file + (let ((result (funcall cmd body params))) + (if (and (eq (cdr (assoc :result-type params)) + 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) result))) + ;; If non-empty result and :file then write to :file. (when (cdr (assoc :file params)) (when result (with-temp-file (cdr (assoc :file params)) @@ -648,7 +647,7 @@ block." (org-babel-format-result result (cdr (assoc :sep (nth 2 info))))))) (setq result (cdr (assoc :file params)))) - ;; possibly perform post process provided its appropriate + ;; Possibly perform post process provided its appropriate. (when (cdr (assoc :post params)) (let ((*this* (if (cdr (assoc :file params)) (org-babel-result-to-file @@ -893,6 +892,8 @@ with a prefix argument then this is passed on to (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) +(defvar org-src-window-setup) + ;;;###autoload (defun org-babel-switch-to-session-with-code (&optional arg info) "Switch to code buffer and display session." @@ -1157,18 +1158,18 @@ the current subtree." (mapconcat #'identity (sort (funcall rm (split-string v)) #'string<) " ")) (t v))))))) - ((lambda (hash) - (when (org-called-interactively-p 'interactive) (message hash)) hash) - (let ((it (format "%s-%s" - (mapconcat - #'identity - (delq nil (mapcar (lambda (arg) - (let ((normalized (funcall norm arg))) - (when normalized - (format "%S" normalized)))) - (nth 2 info))) ":") - (nth 1 info)))) - (sha1 it)))))) + (let* ((it (format "%s-%s" + (mapconcat + #'identity + (delq nil (mapcar (lambda (arg) + (let ((normalized (funcall norm arg))) + (when normalized + (format "%S" normalized)))) + (nth 2 info))) ":") + (nth 1 info))) + (hash (sha1 it))) + (when (org-called-interactively-p 'interactive) (message hash)) + hash)))) (defun org-babel-current-result-hash () "Return the current in-buffer hash." @@ -1453,9 +1454,8 @@ instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." (cons (intern (match-string 1 arg)) (org-babel-read (org-babel-chomp (match-string 2 arg)))) (cons (intern (org-babel-chomp arg)) nil))) - ((lambda (raw) - (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw)))) - (org-babel-balanced-split arg-string '((32 9) . 58)))))))) + (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58)))) + (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))))))) (defun org-babel-parse-multiple-vars (header-arguments) "Expand multiple variable assignments behind a single :var keyword. @@ -1598,12 +1598,11 @@ of the vars, cnames and rnames." Given a TABLE and set of COLNAMES and ROWNAMES add the names to the table for reinsertion to org-mode." (if (listp table) - ((lambda (table) - (if (and colnames (listp (car table)) (= (length (car table)) - (length colnames))) - (org-babel-put-colnames table colnames) table)) - (if (and rownames (= (length table) (length rownames))) - (org-babel-put-rownames table rownames) table)) + (let ((table (if (and rownames (= (length table) (length rownames))) + (org-babel-put-rownames table rownames) table))) + (if (and colnames (listp (car table)) (= (length (car table)) + (length colnames))) + (org-babel-put-colnames table colnames) table)) table)) (defun org-babel-where-is-src-block-head () @@ -1640,9 +1639,8 @@ If the point is not on a source block then return nil." (defun org-babel-goto-src-block-head () "Go to the beginning of the current code block." (interactive) - ((lambda (head) - (if head (goto-char head) (error "Not currently in a code block"))) - (org-babel-where-is-src-block-head))) + (let ((head (org-babel-where-is-src-block-head))) + (if head (goto-char head) (error "Not currently in a code block")))) ;;;###autoload (defun org-babel-goto-named-src-block (name) @@ -1763,14 +1761,13 @@ With optional prefix argument ARG, jump backward ARG many source blocks." (defun org-babel-mark-block () "Mark current src block." (interactive) - ((lambda (head) - (when head - (save-excursion - (goto-char head) - (looking-at org-babel-src-block-regexp)) - (push-mark (match-end 5) nil t) - (goto-char (match-beginning 5)))) - (org-babel-where-is-src-block-head))) + (let ((head (org-babel-where-is-src-block-head))) + (when head + (save-excursion + (goto-char head) + (looking-at org-babel-src-block-regexp)) + (push-mark (match-end 5) nil t) + (goto-char (match-beginning 5))))) (defun org-babel-demarcate-block (&optional arg) "Wrap or split the code in the region or on the point. @@ -2450,7 +2447,7 @@ block but are passed literally to the \"example-block\"." (funcall (intern (concat lang "-mode"))) (comment-region (point) (progn (insert text) (point))) (org-babel-trim (buffer-string))))) - index source-name evaluate prefix blocks-in-buffer) + index source-name evaluate prefix) (with-temp-buffer (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) @@ -2469,119 +2466,118 @@ block but are passed literally to the \"example-block\"." (funcall nb-add (buffer-substring index (point))) (goto-char (match-end 0)) (setq index (point)) - (funcall nb-add - (with-current-buffer parent-buffer - (save-restriction - (widen) - (mapconcat ;; interpose PREFIX between every line - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (or - ;; retrieve from the library of babel - (nth 2 (assoc (intern source-name) - org-babel-library-of-babel)) - ;; return the contents of headlines literally - (save-excursion - (when (org-babel-ref-goto-headline-id source-name) + (funcall + nb-add + (with-current-buffer parent-buffer + (save-restriction + (widen) + (mapconcat ;; Interpose PREFIX between every line. + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (or + ;; Retrieve from the library of babel. + (nth 2 (assoc (intern source-name) + org-babel-library-of-babel)) + ;; Return the contents of headlines literally. + (save-excursion + (when (org-babel-ref-goto-headline-id source-name) (org-babel-ref-headline-body))) - ;; find the expansion of reference in this buffer - (let ((rx (concat rx-prefix source-name "[ \t\n]")) - expansion) - (save-excursion - (goto-char (point-min)) - (if org-babel-use-quick-and-dirty-noweb-expansion - (while (re-search-forward rx nil t) - (let* ((i (org-babel-get-src-block-info 'light)) - (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion (cons sep (cons full expansion))))) - (org-babel-map-src-blocks nil - (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) - (nth 4 i)) - source-name) - (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - ((lambda (cs) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - (org-babel-tangle-comment-links i)) - body))) - (setq expansion - (cons sep (cons full expansion))))))))) - (and expansion - (mapconcat #'identity (nreverse (cdr expansion)) ""))) - ;; possibly raise an error if named block doesn't exist - (if (member lang org-babel-noweb-error-langs) - (error "%s" (concat - (org-babel-noweb-wrap source-name) - "could not be resolved (see " - "`org-babel-noweb-error-langs')")) - ""))) - "[\n\r]") (concat "\n" prefix)))))) + ;; Find the expansion of reference in this buffer. + (let ((rx (concat rx-prefix source-name "[ \t\n]")) + expansion) + (save-excursion + (goto-char (point-min)) + (if org-babel-use-quick-and-dirty-noweb-expansion + (while (re-search-forward rx nil t) + (let* ((i (org-babel-get-src-block-info 'light)) + (body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + (let ((cs (org-babel-tangle-comment-links i))) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + body))) + (setq expansion (cons sep (cons full expansion))))) + (org-babel-map-src-blocks nil + (let ((i (org-babel-get-src-block-info 'light))) + (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (nth 4 i)) + source-name) + (let* ((body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + (let ((cs (org-babel-tangle-comment-links i))) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + body))) + (setq expansion + (cons sep (cons full expansion))))))))) + (and expansion + (mapconcat #'identity (nreverse (cdr expansion)) ""))) + ;; Possibly raise an error if named block doesn't exist. + (if (member lang org-babel-noweb-error-langs) + (error "%s" (concat + (org-babel-noweb-wrap source-name) + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))) + "[\n\r]") (concat "\n" prefix)))))) (funcall nb-add (buffer-substring index (point-max)))) new-body)) (defun org-babel-script-escape (str &optional force) "Safely convert tables into elisp lists." - (let (in-single in-double out) - ((lambda (escaped) (condition-case nil (org-babel-read escaped) (error escaped))) - (if (or force - (and (stringp str) - (> (length str) 2) - (or (and (string-equal "[" (substring str 0 1)) - (string-equal "]" (substring str -1))) - (and (string-equal "{" (substring str 0 1)) - (string-equal "}" (substring str -1))) - (and (string-equal "(" (substring str 0 1)) - (string-equal ")" (substring str -1)))))) - (org-babel-read - (concat - "'" - (progn - (mapc - (lambda (ch) - (setq - out - (case ch - (91 (if (or in-double in-single) ; [ - (cons 91 out) - (cons 40 out))) - (93 (if (or in-double in-single) ; ] - (cons 93 out) - (cons 41 out))) - (123 (if (or in-double in-single) ; { - (cons 123 out) - (cons 40 out))) - (125 (if (or in-double in-single) ; } - (cons 125 out) - (cons 41 out))) - (44 (if (or in-double in-single) ; , - (cons 44 out) (cons 32 out))) - (39 (if in-double ; ' - (cons 39 out) - (setq in-single (not in-single)) (cons 34 out))) - (34 (if in-single ; " - (append (list 34 32) out) - (setq in-double (not in-double)) (cons 34 out))) - (t (cons ch out))))) - (string-to-list str)) - (apply #'string (reverse out))))) - str)))) + (let ((escaped + (if (or force + (and (stringp str) + (> (length str) 2) + (or (and (string-equal "[" (substring str 0 1)) + (string-equal "]" (substring str -1))) + (and (string-equal "{" (substring str 0 1)) + (string-equal "}" (substring str -1))) + (and (string-equal "(" (substring str 0 1)) + (string-equal ")" (substring str -1)))))) + (org-babel-read + (concat + "'" + (let (in-single in-double out) + (mapc + (lambda (ch) + (setq + out + (case ch + (91 (if (or in-double in-single) ; [ + (cons 91 out) + (cons 40 out))) + (93 (if (or in-double in-single) ; ] + (cons 93 out) + (cons 41 out))) + (123 (if (or in-double in-single) ; { + (cons 123 out) + (cons 40 out))) + (125 (if (or in-double in-single) ; } + (cons 125 out) + (cons 41 out))) + (44 (if (or in-double in-single) ; , + (cons 44 out) (cons 32 out))) + (39 (if in-double ; ' + (cons 39 out) + (setq in-single (not in-single)) (cons 34 out))) + (34 (if in-single ; " + (append (list 34 32) out) + (setq in-double (not in-double)) (cons 34 out))) + (t (cons ch out))))) + (string-to-list str)) + (apply #'string (reverse out))))) + str))) + (condition-case nil (org-babel-read escaped) (error escaped)))) (defun org-babel-read (cell &optional inhibit-lisp-eval) "Convert the string value of CELL to a number if appropriate. @@ -2691,8 +2687,8 @@ name is removed, since in that case the process will be executing remotely. The file name is then processed by `expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, the file name is additionally processed by `shell-quote-argument'" - ((lambda (f) (if no-quote-p f (shell-quote-argument f))) - (expand-file-name (org-babel-local-file-name name)))) + (let ((f (expand-file-name (org-babel-local-file-name name)))) + (if no-quote-p f (shell-quote-argument f)))) (defvar org-babel-temporary-directory) (unless (or noninteractive (boundp 'org-babel-temporary-directory)) diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index 60ab8c598..36681d0ad 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -82,11 +82,10 @@ Do not leave leading or trailing spaces in this string." "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file ((lambda (el) - (or el - (error - "ditaa code block requires :file header argument"))) - (cdr (assoc :file params)))) + (out-file (let ((el (cdr (assoc :file params)))) + (or el + (error + "ditaa code block requires :file header argument")))) (cmdline (cdr (assoc :cmdline params))) (java (cdr (assoc :java params))) (in-file (org-babel-temp-file "ditaa-")) diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index 886645dc9..a30e369ec 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -54,25 +54,26 @@ (defun org-babel-execute:emacs-lisp (body params) "Execute a block of emacs-lisp code with Babel." (save-window-excursion - ((lambda (result) - (org-babel-result-cond (cdr (assoc :result-params params)) - (let ((print-level nil) - (print-length nil)) - (if (or (member "scalar" (cdr (assoc :result-params params))) - (member "verbatim" (cdr (assoc :result-params params)))) - (format "%S" result) - (format "%s" result))) - (org-babel-reassemble-table - result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) - (eval (read (format (if (member "output" - (cdr (assoc :result-params params))) - "(with-output-to-string %s)" - "(progn %s)") - (org-babel-expand-body:emacs-lisp body params))))))) + (let ((result + (eval (read (format (if (member "output" + (cdr (assoc :result-params params))) + "(with-output-to-string %s)" + "(progn %s)") + (org-babel-expand-body:emacs-lisp + body params)))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + (let ((print-level nil) + (print-length nil)) + (if (or (member "scalar" (cdr (assoc :result-params params))) + (member "verbatim" (cdr (assoc :result-params params)))) + (format "%S" result) + (format "%s" result))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))))) (provide 'ob-emacs-lisp) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index c8479e36d..d6d4566c2 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -69,6 +69,8 @@ be executed." ('otherwise (error "Requested export buffer when `org-current-export-file' is nil")))) +(defvar org-link-search-inhibit-query) + (defmacro org-babel-exp-in-export-file (lang &rest body) (declare (indent 1)) `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) @@ -372,7 +374,7 @@ replaced with its value." (cons (substring (symbol-name (car pair)) 1) (format "%S" (cdr pair)))) (nth 2 info)) - ("flags" . ,((lambda (f) (when f (concat " " f))) (nth 3 info))) + ("flags" . ,(let ((f (nth 3 info))) (when f (concat " " f)))) ("name" . ,(or (nth 4 info) ""))))) (defun org-babel-exp-results (info type &optional silent hash) diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index df7bfa00c..61cb19a56 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -60,20 +60,20 @@ (mapconcat 'identity (if (listp flags) flags (list flags)) " ") (org-babel-process-file-name tmp-src-file)) "")))) - ((lambda (results) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "f-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) + (let ((results + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "f-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) (defun org-babel-expand-body:fortran (body params) "Expand a block of fortran or fortran code with org-babel according to diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index a01271191..6c9fed14f 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -79,12 +79,12 @@ (cdr (member org-babel-haskell-eoe (reverse (mapcar #'org-babel-trim raw))))))) (org-babel-reassemble-table - ((lambda (result) - (org-babel-result-cond (cdr (assoc :result-params params)) - result (org-babel-haskell-table-or-string result))) - (case result-type - ('output (mapconcat #'identity (reverse (cdr results)) "\n")) - ('value (car results)))) + (let ((result + (case result-type + (output (mapconcat #'identity (reverse (cdr results)) "\n")) + (value (car results))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + result (org-babel-haskell-table-or-string result))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colname-names params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) @@ -148,6 +148,7 @@ specifying a variable of the same value." (format "%S" var))) (defvar org-src-preserve-indentation) +(defvar org-export-copy-to-kill-ring) (declare-function org-export-to-file "ox" (backend file &optional async subtreep visible-only body-only ext-plist)) diff --git a/lisp/ob-io.el b/lisp/ob-io.el index af18f7468..5368ff515 100644 --- a/lisp/ob-io.el +++ b/lisp/ob-io.el @@ -94,12 +94,11 @@ in BODY as elisp." (value (let* ((src-file (org-babel-temp-file "io-")) (wrapper (format org-babel-io-wrapper-method body))) (with-temp-file src-file (insert wrapper)) - ((lambda (raw) - (org-babel-result-cond result-params - raw - (org-babel-io-table-or-string raw))) - (org-babel-eval - (concat org-babel-io-command " " src-file) "")))))) + (let ((raw (org-babel-eval + (concat org-babel-io-command " " src-file) ""))) + (org-babel-result-cond result-params + raw + (org-babel-io-table-or-string raw))))))) (defun org-babel-prep-session:io (session params) diff --git a/lisp/ob-java.el b/lisp/ob-java.el index c0e9a5384..37ac8daea 100644 --- a/lisp/ob-java.el +++ b/lisp/ob-java.el @@ -55,19 +55,18 @@ ;; created package-name directories if missing (unless (or (not packagename) (file-exists-p packagename)) (make-directory packagename 'parents)) - ((lambda (results) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - (org-babel-eval (concat org-babel-java-command - " " cmdline " " classname) "")))) + (let ((results (org-babel-eval (concat org-babel-java-command + " " cmdline " " classname) ""))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) (provide 'ob-java) diff --git a/lisp/ob-lilypond.el b/lisp/ob-lilypond.el index 6080a5a7c..a58a443dc 100644 --- a/lisp/ob-lilypond.el +++ b/lisp/ob-lilypond.el @@ -200,7 +200,6 @@ FILE-NAME is full path to lilypond (.ly) file" (let ((arg-1 (ly-determine-ly-path)) ;program (arg-2 nil) ;infile (arg-3 "*lilypond*") ;buffer - (arg-4 t) ;display (arg-4 t) ;display (arg-5 (if ly-gen-png "--png" "")) ;&rest... (arg-6 (if ly-gen-html "--html" "")) diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 2bb1a25bf..c912fd9f0 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -75,23 +75,24 @@ current directory string." "Execute a block of Common Lisp code with Babel." (require 'slime) (org-babel-reassemble-table - ((lambda (result) - (org-babel-result-cond (cdr (assoc :result-params params)) - (car result) - (condition-case nil - (read (org-babel-lisp-vector-to-list (cadr result))) - (error (cadr result))))) - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) "(progn %s)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params))))) + (let ((result + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (slime-eval `(swank:eval-and-grab-output + ,(let ((dir (if (assoc :dir params) + (cdr (assoc :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assoc :package params)))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + (car result) + (condition-case nil + (read (org-babel-lisp-vector-to-list (cadr result))) + (error (cadr result))))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) diff --git a/lisp/ob-makefile.el b/lisp/ob-makefile.el index 7b0ff932c..517b5a683 100644 --- a/lisp/ob-makefile.el +++ b/lisp/ob-makefile.el @@ -1,6 +1,6 @@ ;;; ob-makefile.el --- org-babel functions for makefile evaluation -;; Copyright (C) 2009-2012 Free Software Foundation, Inc. +;; Copyright (C) 2009-2013 Free Software Foundation, Inc. ;; Author: Eric Schulte and Thomas S. Dye ;; Keywords: literate programming, reproducible research diff --git a/lisp/ob-maxima.el b/lisp/ob-maxima.el index 726d6863e..5be378ed6 100644 --- a/lisp/ob-maxima.el +++ b/lisp/ob-maxima.el @@ -65,8 +65,8 @@ "\n"))) (defun org-babel-execute:maxima (body params) - "Execute a block of Maxima entries with org-babel. This function is -called by `org-babel-execute-src-block'." + "Execute a block of Maxima entries with org-babel. +This function is called by `org-babel-execute-src-block'." (message "executing Maxima source code block") (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (result @@ -76,18 +76,18 @@ called by `org-babel-execute-src-block'." org-babel-maxima-command in-file cmdline))) (with-temp-file in-file (insert (org-babel-maxima-expand body params))) (message cmd) - ((lambda (raw) ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " - (mapconcat - #'identity - (delq nil - (mapcar (lambda (line) - (unless (or (string-match "batch" line) - (string-match "^rat: replaced .*$" line) - (string-match "^;;; Loading #P" line) - (= 0 (length line))) - line)) - (split-string raw "[\r\n]"))) "\n")) - (org-babel-eval cmd ""))))) + ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " + (let ((raw (org-babel-eval cmd ""))) + (mapconcat + #'identity + (delq nil + (mapcar (lambda (line) + (unless (or (string-match "batch" line) + (string-match "^rat: replaced .*$" line) + (string-match "^;;; Loading #P" line) + (= 0 (length line))) + line)) + (split-string raw "[\r\n]"))) "\n"))))) (if (org-babel-maxima-graphical-output-file params) nil (org-babel-result-cond result-params diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index 43ab9467c..d374e47eb 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -135,21 +135,21 @@ return the value of the last statement in BODY, as elisp." (tmp-file (org-babel-temp-file "perl-")) (tmp-babel-file (org-babel-process-file-name tmp-file 'noquote))) - ((lambda (results) - (when results - (org-babel-result-cond result-params - (org-babel-eval-read-file tmp-file) - (org-babel-import-elisp-from-file tmp-file '(16))))) - (case result-type - (output - (with-temp-file tmp-file - (insert - (org-babel-eval org-babel-perl-command body)) - (buffer-string))) - (value - (org-babel-eval org-babel-perl-command - (format org-babel-perl-wrapper-method - body tmp-babel-file))))))) + (let ((results + (case result-type + (output + (with-temp-file tmp-file + (insert + (org-babel-eval org-babel-perl-command body)) + (buffer-string))) + (value + (org-babel-eval org-babel-perl-command + (format org-babel-perl-wrapper-method + body tmp-babel-file)))))) + (when results + (org-babel-result-cond result-params + (org-babel-eval-read-file tmp-file) + (org-babel-import-elisp-from-file tmp-file '(16))))))) (provide 'ob-perl) diff --git a/lisp/ob-picolisp.el b/lisp/ob-picolisp.el index 1d1791926..279cd7b3f 100644 --- a/lisp/ob-picolisp.el +++ b/lisp/ob-picolisp.el @@ -99,16 +99,16 @@ called by `org-babel-execute-src-block'" (message "executing Picolisp source code block") (let* ( - ;; name of the session or "none" + ;; Name of the session or "none". (session-name (cdr (assoc :session params))) - ;; set the session if the session variable is non-nil + ;; Set the session if the session variable is non-nil. (session (org-babel-picolisp-initiate-session session-name)) - ;; either OUTPUT or VALUE which should behave as described above + ;; Either OUTPUT or VALUE which should behave as described above. (result-type (cdr (assoc :result-type params))) (result-params (cdr (assoc :result-params params))) - ;; expand the body with `org-babel-expand-body:picolisp' + ;; Expand the body with `org-babel-expand-body:picolisp'. (full-body (org-babel-expand-body:picolisp body params)) - ;; wrap body appropriately for the type of evaluation and results + ;; Wrap body appropriately for the type of evaluation and results. (wrapped-body (cond ((or (member "code" result-params) @@ -118,53 +118,54 @@ (format "(print (out \"/dev/null\" %s))" full-body)) ((member "value" result-params) (format "(out \"/dev/null\" %s)" full-body)) - (t full-body)))) - - ((lambda (result) - (org-babel-result-cond result-params - result - (read result))) - (if (not (string= session-name "none")) - ;; session based evaluation - (mapconcat ;; <- joins the list back together into a single string - #'identity - (butlast ;; <- remove the org-babel-picolisp-eoe line - (delq nil - (mapcar - (lambda (line) - (org-babel-chomp ;; remove trailing newlines - (when (> (length line) 0) ;; remove empty lines - (cond - ;; remove leading "-> " from return values - ((and (>= (length line) 3) - (string= "-> " (substring line 0 3))) - (substring line 3)) - ;; remove trailing "-> <>" on the - ;; last line of output - ((and (member "output" result-params) - (string-match-p "->" line)) - (substring line 0 (string-match "->" line))) - (t line) - ) - ;; (if (and (>= (length line) 3) ;; remove leading "<- " - ;; (string= "-> " (substring line 0 3))) - ;; (substring line 3) - ;; line) - ))) - ;; returns a list of the output of each evaluated expression - (org-babel-comint-with-output (session org-babel-picolisp-eoe) - (insert wrapped-body) (comint-send-input) - (insert "'" org-babel-picolisp-eoe) (comint-send-input))))) - "\n") - ;; external evaluation - (let ((script-file (org-babel-temp-file "picolisp-script-"))) - (with-temp-file script-file - (insert (concat wrapped-body "(bye)"))) - (org-babel-eval - (format "%s %s" - org-babel-picolisp-cmd - (org-babel-process-file-name script-file)) - "")))))) + (t full-body))) + (result + (if (not (string= session-name "none")) + ;; Session based evaluation. + (mapconcat ;; <- joins the list back into a single string + #'identity + (butlast ;; <- remove the org-babel-picolisp-eoe line + (delq nil + (mapcar + (lambda (line) + (org-babel-chomp ;; Remove trailing newlines. + (when (> (length line) 0) ;; Remove empty lines. + (cond + ;; Remove leading "-> " from return values. + ((and (>= (length line) 3) + (string= "-> " (substring line 0 3))) + (substring line 3)) + ;; Remove trailing "-> <>" on the + ;; last line of output. + ((and (member "output" result-params) + (string-match-p "->" line)) + (substring line 0 (string-match "->" line))) + (t line) + ) + ;;(if (and (>= (length line) 3);Remove leading "<-" + ;; (string= "-> " (substring line 0 3))) + ;; (substring line 3) + ;; line) + ))) + ;; Returns a list of the output of each evaluated exp. + (org-babel-comint-with-output + (session org-babel-picolisp-eoe) + (insert wrapped-body) (comint-send-input) + (insert "'" org-babel-picolisp-eoe) + (comint-send-input))))) + "\n") + ;; external evaluation + (let ((script-file (org-babel-temp-file "picolisp-script-"))) + (with-temp-file script-file + (insert (concat wrapped-body "(bye)"))) + (org-babel-eval + (format "%s %s" + org-babel-picolisp-cmd + (org-babel-process-file-name script-file)) + ""))))) + (org-babel-result-cond result-params + result + (read result)))) (defun org-babel-picolisp-initiate-session (&optional session-name) "If there is not a current inferior-process-buffer in SESSION diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 17da109ca..b8f8a6daa 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -143,13 +143,12 @@ specifying a variable of the same value." "Convert RESULTS into an appropriate elisp value. If the results look like a list or tuple, then convert them into an Emacs-lisp table, otherwise return the results as a string." - ((lambda (res) - (if (listp res) - (mapcar (lambda (el) (if (equal el 'None) - org-babel-python-None-to el)) - res) - res)) - (org-babel-script-escape results))) + (let ((res (org-babel-script-escape results))) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'None) + org-babel-python-None-to el)) + res) + res))) (defvar org-babel-python-buffers '((:default . "*Python*"))) @@ -172,6 +171,8 @@ Emacs-lisp table, otherwise return the results as a string." name))) (defvar py-default-interpreter) +(defvar py-which-bufname) +(defvar python-shell-buffer-name) (defun org-babel-python-initiate-session-by-key (&optional session) "Initiate a python session. If there is not a current inferior-process-buffer in SESSION @@ -252,34 +253,34 @@ open('%s', 'w').write( pprint.pformat(main()) )") If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." - ((lambda (raw) - (org-babel-result-cond result-params - raw - (org-babel-python-table-or-string (org-babel-trim raw)))) - (case result-type - (output (org-babel-eval org-babel-python-command - (concat (if preamble (concat preamble "\n") "") - body))) - (value (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-eval - org-babel-python-command - (concat - (if preamble (concat preamble "\n") "") - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - (org-babel-process-file-name tmp-file 'noquote)))) - (org-babel-eval-read-file tmp-file)))))) + (let ((raw + (case result-type + (output (org-babel-eval org-babel-python-command + (concat (if preamble (concat preamble "\n")) + body))) + (value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval + org-babel-python-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote)))) + (org-babel-eval-read-file tmp-file)))))) + (org-babel-result-cond result-params + raw + (org-babel-python-table-or-string (org-babel-trim raw))))) (defun org-babel-python-evaluate-session - (session body &optional result-type result-params) + (session body &optional result-type result-params) "Pass BODY to the Python process in SESSION. If RESULT-TYPE equals 'output then return standard output as a string. If RESULT-TYPE equals 'value then return the value of the @@ -296,39 +297,41 @@ last statement in BODY, as elisp." (format "open('%s', 'w').write(pprint.pformat(_))" (org-babel-process-file-name tmp-file 'noquote))) (list (format "open('%s', 'w').write(str(_))" - (org-babel-process-file-name tmp-file 'noquote))))))) + (org-babel-process-file-name tmp-file + 'noquote))))))) (input-body (lambda (body) (mapc (lambda (line) (insert line) (funcall send-wait)) (split-string body "[\r\n]")) - (funcall send-wait)))) - ((lambda (results) - (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) - (org-babel-result-cond result-params - results - (org-babel-python-table-or-string results)))) - (case result-type - (output - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-python-eoe-indicator t body) - (funcall input-body body) - (funcall send-wait) (funcall send-wait) - (insert org-babel-python-eoe-indicator) - (funcall send-wait)) - 2) "\n")) - (value - (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-comint-with-output - (session org-babel-python-eoe-indicator nil body) - (let ((comint-process-echoes nil)) - (funcall input-body body) - (funcall dump-last-value tmp-file (member "pp" result-params)) - (funcall send-wait) (funcall send-wait) - (insert org-babel-python-eoe-indicator) - (funcall send-wait))) - (org-babel-eval-read-file tmp-file))))))) + (funcall send-wait))) + (results + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (funcall input-body body) + (funcall send-wait) (funcall send-wait) + (insert org-babel-python-eoe-indicator) + (funcall send-wait)) + 2) "\n")) + (value + (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator nil body) + (let ((comint-process-echoes nil)) + (funcall input-body body) + (funcall dump-last-value tmp-file + (member "pp" result-params)) + (funcall send-wait) (funcall send-wait) + (insert org-babel-python-eoe-indicator) + (funcall send-wait))) + (org-babel-eval-read-file tmp-file)))))) + (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) + (org-babel-result-cond result-params + results + (org-babel-python-table-or-string results))))) (defun org-babel-python-read-string (string) "Strip 's from around Python string." diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index af5283143..fe1ee0ff0 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -139,13 +139,12 @@ specifying a variable of the same value." "Convert RESULTS into an appropriate elisp value. If RESULTS look like a table, then convert them into an Emacs-lisp table, otherwise return the results as a string." - ((lambda (res) - (if (listp res) - (mapcar (lambda (el) (if (equal el 'nil) - org-babel-ruby-nil-to el)) - res) - res)) - (org-babel-script-escape results))) + (let ((res (org-babel-script-escape results))) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'nil) + org-babel-ruby-nil-to el)) + res) + res))) (defun org-babel-ruby-initiate-session (&optional session params) "Initiate a ruby session. @@ -204,12 +203,11 @@ return the value of the last statement in BODY, as elisp." org-babel-ruby-pp-wrapper-method org-babel-ruby-wrapper-method) body (org-babel-process-file-name tmp-file 'noquote))) - ((lambda (raw) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-ruby-table-or-string raw))) - (org-babel-eval-read-file tmp-file))))) + (let ((raw (org-babel-eval-read-file tmp-file))) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-ruby-table-or-string raw)))))) ;; comint session evaluation (case result-type (output diff --git a/lisp/ob-scala.el b/lisp/ob-scala.el index 7cb3099c0..f77836194 100644 --- a/lisp/ob-scala.el +++ b/lisp/ob-scala.el @@ -100,12 +100,11 @@ in BODY as elisp." (let* ((src-file (org-babel-temp-file "scala-")) (wrapper (format org-babel-scala-wrapper-method body))) (with-temp-file src-file (insert wrapper)) - ((lambda (raw) - (org-babel-result-cond result-params - raw - (org-babel-scala-table-or-string raw))) - (org-babel-eval - (concat org-babel-scala-command " " src-file) "")))))) + (let ((raw (org-babel-eval + (concat org-babel-scala-command " " src-file) ""))) + (org-babel-result-cond result-params + raw + (org-babel-scala-table-or-string raw))))))) (defun org-babel-prep-session:scala (session params) diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index ec1306b3b..4984ff9bf 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -53,9 +53,9 @@ This will be passed to `shell-command-on-region'") This function is called by `org-babel-execute-src-block'." (let* ((session (org-babel-sh-initiate-session (cdr (assoc :session params)))) - (stdin ((lambda (stdin) (when stdin (org-babel-sh-var-to-string - (org-babel-ref-resolve stdin)))) - (cdr (assoc :stdin params)))) + (stdin (let ((stdin (cdr (assoc :stdin params)))) + (when stdin (org-babel-sh-var-to-string + (org-babel-ref-resolve stdin))))) (full-body (org-babel-expand-body:generic body params (org-babel-variable-assignments:sh params)))) (org-babel-reassemble-table @@ -135,68 +135,69 @@ Emacs-lisp table, otherwise return the results as a string." If RESULT-TYPE equals 'output then return a list of the outputs of the statements in BODY, if RESULT-TYPE equals 'value then return the value of the last statement in BODY." - ((lambda (results) - (when results - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - results - (let ((tmp-file (org-babel-temp-file "sh-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file)))))) - (cond - (stdin ; external shell script w/STDIN - (let ((script-file (org-babel-temp-file "sh-script-")) - (stdin-file (org-babel-temp-file "sh-stdin-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (string= "no" (cdr (assoc :padline params)))))) - (with-temp-file script-file - (when shebang (insert (concat shebang "\n"))) - (when padline (insert "\n")) - (insert body)) - (set-file-modes script-file #o755) - (with-temp-file stdin-file (insert stdin)) - (with-temp-buffer - (call-process-shell-command - (if shebang - script-file - (format "%s %s" org-babel-sh-command script-file)) - stdin-file - (current-buffer)) - (buffer-string)))) - (session ; session evaluation - (mapconcat - #'org-babel-sh-strip-weird-long-prompt - (mapcar - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (mapc - (lambda (line) - (insert line) - (comint-send-input nil t) - (while (save-excursion - (goto-char comint-last-input-end) - (not (re-search-forward - comint-prompt-regexp nil t))) - (accept-process-output (get-buffer-process (current-buffer))))) - (append - (split-string (org-babel-trim body) "\n") - (list org-babel-sh-eoe-indicator)))) - 2)) "\n")) - ('otherwise ; external shell script - (if (and (cdr (assoc :shebang params)) - (> (length (cdr (assoc :shebang params))) 0)) - (let ((script-file (org-babel-temp-file "sh-script-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (string= "no" (cdr (assoc :padline params)))))) - (with-temp-file script-file - (when shebang (insert (concat shebang "\n"))) - (when padline (insert "\n")) - (insert body)) - (set-file-modes script-file #o755) - (org-babel-eval script-file "")) - (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) + (let ((results + (cond + (stdin ; external shell script w/STDIN + (let ((script-file (org-babel-temp-file "sh-script-")) + (stdin-file (org-babel-temp-file "sh-stdin-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (with-temp-file stdin-file (insert stdin)) + (with-temp-buffer + (call-process-shell-command + (if shebang + script-file + (format "%s %s" org-babel-sh-command script-file)) + stdin-file + (current-buffer)) + (buffer-string)))) + (session ; session evaluation + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) + (comint-send-input nil t) + (while (save-excursion + (goto-char comint-last-input-end) + (not (re-search-forward + comint-prompt-regexp nil t))) + (accept-process-output + (get-buffer-process (current-buffer))))) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n")) + ('otherwise ; external shell script + (if (and (cdr (assoc :shebang params)) + (> (length (cdr (assoc :shebang params))) 0)) + (let ((script-file (org-babel-temp-file "sh-script-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (equal "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (org-babel-eval script-file "")) + (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) + (when results + (let ((result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))))))) (defun org-babel-sh-strip-weird-long-prompt (string) "Remove prompt cruft from a string of shell output." diff --git a/lisp/ob-shen.el b/lisp/ob-shen.el index dc6313dc2..68169da9a 100644 --- a/lisp/ob-shen.el +++ b/lisp/ob-shen.el @@ -66,14 +66,14 @@ This function is called by `org-babel-execute-src-block'" (let* ((result-type (cdr (assoc :result-type params))) (result-params (cdr (assoc :result-params params))) (full-body (org-babel-expand-body:shen body params))) - ((lambda (results) - (org-babel-result-cond result-params - results - (condition-case nil (org-babel-script-escape results) - (error results)))) - (with-temp-buffer - (insert full-body) - (call-interactively #'shen-eval-defun))))) + (let ((results + (with-temp-buffer + (insert full-body) + (call-interactively #'shen-eval-defun)))) + (org-babel-result-cond result-params + results + (condition-case nil (org-babel-script-escape results) + (error results)))))) (provide 'ob-shen) ;;; ob-shen.el ends here diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 658a54f1d..d17dd8a7f 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -186,19 +186,17 @@ This function is called by `org-babel-execute-src-block'." (lambda (pair) (setq body (replace-regexp-in-string - (format "\$%s" (car pair)) - ((lambda (val) - (if (listp val) - ((lambda (data-file) - (with-temp-file data-file - (insert (orgtbl-to-csv - val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) - data-file) - (org-babel-temp-file "sql-data-")) - (if (stringp val) val (format "%S" val)))) - (cdr pair)) + (format "\$%s" (car pair)) ;FIXME: "\$" == "$"! + (let ((val (cdr pair))) + (if (listp val) + (let ((data-file (org-babel-temp-file "sql-data-"))) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (if (stringp val) val (format "%S" val)))) body))) vars) body) diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index 84d4688ab..fcfdb8ebd 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -114,23 +114,22 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-sqlite-expand-vars (body vars) "Expand the variables held in VARS in BODY." + ;; FIXME: Redundancy with org-babel-sql-expand-vars! (mapc (lambda (pair) (setq body (replace-regexp-in-string - (format "\$%s" (car pair)) - ((lambda (val) - (if (listp val) - ((lambda (data-file) - (with-temp-file data-file - (insert (orgtbl-to-csv - val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) - data-file) - (org-babel-temp-file "sqlite-data-")) - (if (stringp val) val (format "%S" val)))) - (cdr pair)) + (format "\$%s" (car pair)) ;FIXME: "\$" == "$"! + (let ((val (cdr pair))) + (if (listp val) + (let ((data-file (org-babel-temp-file "sqlite-data-"))) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (if (stringp val) val (format "%S" val)))) body))) vars) body) diff --git a/lisp/ob-table.el b/lisp/ob-table.el index 8b3e36d73..c71bb8758 100644 --- a/lisp/ob-table.el +++ b/lisp/ob-table.el @@ -60,7 +60,7 @@ character and replace it with ellipses." (concat (substring string 0 (match-beginning 0)) (if (match-string 1 string) "...")) string)) -(defmacro sbe (source-block &rest variables) +(defmacro sbe (source-block &rest variables) ;FIXME: Namespace prefix! "Return the results of calling SOURCE-BLOCK with VARIABLES. Each element of VARIABLES should be a two element list, whose first element is the name of the variable and @@ -85,6 +85,7 @@ as shown in the example below. | 1 | 2 | :file nothing.png | nothing.png | #+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))" + (declare (debug (form form))) (let* ((header-args (if (stringp (car variables)) (car variables) "")) (variables (if (stringp (car variables)) (cdr variables) variables))) (let* (quote @@ -107,31 +108,31 @@ as shown in the example below. variables))) (unless (stringp source-block) (setq source-block (symbol-name source-block))) - ((lambda (result) - (org-babel-trim (if (stringp result) result (format "%S" result)))) - (if (and source-block (> (length source-block) 0)) - (let ((params - (eval `(org-babel-parse-header-arguments - (concat - ":var results=" - ,source-block - "[" ,header-args "]" - "(" - (mapconcat - (lambda (var-spec) - (if (> (length (cdr var-spec)) 1) - (format "%S='%S" - (car var-spec) - (mapcar #'read (cdr var-spec))) - (format "%S=%s" - (car var-spec) (cadr var-spec)))) - ',variables ", ") - ")"))))) - (org-babel-execute-src-block - nil (list "emacs-lisp" "results" params) - '((:results . "silent")))) - ""))))) -(def-edebug-spec sbe (form form)) + (let ((result + (if (and source-block (> (length source-block) 0)) + (let ((params + ;; FIXME: Why `eval'?!?!? + (eval `(org-babel-parse-header-arguments + (concat + ":var results=" + ,source-block + "[" ,header-args "]" + "(" + (mapconcat + (lambda (var-spec) + (if (> (length (cdr var-spec)) 1) + (format "%S='%S" + (car var-spec) + (mapcar #'read (cdr var-spec))) + (format "%S=%s" + (car var-spec) (cadr var-spec)))) + ',variables ", ") + ")"))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" params) + '((:results . "silent")))) + ""))) + (org-babel-trim (if (stringp result) result (format "%S" result))))))) (provide 'ob-table) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 9f0e2de7f..ffc74cb22 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -210,8 +210,8 @@ used to limit the exported source code blocks by language." (lambda (spec) (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) (let* ((tangle (funcall get-spec :tangle)) - (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) - (funcall get-spec :shebang))) + (she-bang (let ((sheb (funcall get-spec :shebang))) + (when (> (length sheb) 0) sheb))) (tangle-mode (funcall get-spec :tangle-mode)) (base-name (cond ((string= "yes" tangle) @@ -224,9 +224,9 @@ used to limit the exported source code blocks by language." (if (and ext (string= "yes" tangle)) (concat base-name "." ext) base-name)))) (when file-name - ;; possibly create the parent directories for file - (when ((lambda (m) (and m (not (string= m "no")))) - (funcall get-spec :mkdirp)) + ;; Possibly create the parent directories for file. + (when (let ((m (funcall get-spec :mkdirp))) + (and m (not (string= m "no")))) (make-directory (file-name-directory file-name) 'parents)) ;; delete any old versions of file (when (and (file-exists-p file-name) @@ -314,9 +314,8 @@ that the appropriate major-mode is set. SPEC has the form: (string= comments "yes") (string= comments "noweb"))) (link-data (mapcar (lambda (el) (cons (symbol-name el) - ((lambda (le) - (if (stringp le) le (format "%S" le))) - (eval el)))) + (let ((le (eval el))) + (if (stringp le) le (format "%S" le))))) '(start-line file link source-name))) (insert-comment (lambda (text) (when (and comments (not (string= comments "no")) @@ -402,11 +401,10 @@ list to be used by `org-babel-tangle' directly." (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) (match-string 1 extra)) org-coderef-label-format)) - (link ((lambda (link) - (and (string-match org-bracket-link-regexp link) - (match-string 1 link))) - (org-no-properties - (org-store-link nil)))) + (link (let ((link (org-no-properties + (org-store-link nil)))) + (and (string-match org-bracket-link-regexp link) + (match-string 1 link)))) (source-name (intern (or (nth 4 info) (format "%s:%d" @@ -418,28 +416,29 @@ list to be used by `org-babel-tangle' directly." (assignments-cmd (intern (concat "org-babel-variable-assignments:" src-lang))) (body - ((lambda (body) ;; Run the tangle-body-hook - (with-temp-buffer - (insert body) - (when (string-match "-r" extra) - (goto-char (point-min)) - (while (re-search-forward - (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) - (replace-match ""))) - (run-hooks 'org-babel-tangle-body-hook) - (buffer-string))) - ((lambda (body) ;; Expand the body in language specific manner - (if (assoc :no-expand params) - body - (if (fboundp expand-cmd) - (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params - (and (fboundp assignments-cmd) - (funcall assignments-cmd params)))))) - (if (org-babel-noweb-p params :tangle) - (org-babel-expand-noweb-references info) - (nth 1 info))))) + ;; Run the tangle-body-hook. + (let* ((body ;; Expand the body in language specific manner. + (if (org-babel-noweb-p params :tangle) + (org-babel-expand-noweb-references info) + (nth 1 info))) + (body + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params))))))) + (with-temp-buffer + (insert body) + (when (string-match "-r" extra) + (goto-char (point-min)) + (while (re-search-forward + (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) + (replace-match ""))) + (run-hooks 'org-babel-tangle-body-hook) + (buffer-string)))) (comment (when (or (string= "both" (cdr (assoc :comments params))) (string= "org" (cdr (assoc :comments params)))) @@ -474,9 +473,8 @@ list to be used by `org-babel-tangle' directly." (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) (link-data (mapcar (lambda (el) (cons (symbol-name el) - ((lambda (le) - (if (stringp le) le (format "%S" le))) - (eval el)))) + (let ((le (eval el))) + (if (stringp le) le (format "%S" le))))) '(start-line file link source-name)))) (list (org-fill-template org-babel-tangle-comment-format-beg link-data) (org-fill-template org-babel-tangle-comment-format-end link-data)))) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index fedbbe72e..3ecd49a81 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2840,6 +2840,8 @@ Pressing `<' twice means to restrict to the current subtree or region ((equal org-keys "!") (customize-variable 'org-stuck-projects)) (t (user-error "Invalid agenda key")))))) +(defvar org-agenda-multi) + (defun org-agenda-append-agenda () "Append another agenda view to the current one. This function allows interactive building of block agendas. @@ -3814,6 +3816,8 @@ generating a new one." 'org-priority)) (overlay-put ov 'org-type 'org-priority))))) +(defvar org-depend-tag-blocked) + (defun org-agenda-dim-blocked-tasks (&optional invisible) "Dim currently blocked TODO's in the agenda display. When INVISIBLE is non-nil, hide currently blocked TODO instead of @@ -3982,6 +3986,7 @@ This check for agenda markers in all agenda buffers currently active." ;;; Agenda timeline (defvar org-agenda-only-exact-dates nil) ; dynamically scoped +(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' (defun org-timeline (&optional dotodo) "Show a time-sorted view of the entries in the current org file. @@ -5762,7 +5767,6 @@ please use `org-class' instead." dayname skip-weeks))) (make-obsolete 'org-diary-class 'org-class "") -(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' (defalias 'org-get-closed 'org-agenda-get-progress) (defun org-agenda-get-progress () "Return the logged TODO entries for agenda display." diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index 1f71d91ae..526439948 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -293,12 +293,13 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." ;;; Utility functions (defun org-bibtex-get (property) - ((lambda (it) (when it (org-babel-trim it))) - (let ((org-special-properties - (delete "FILE" (copy-sequence org-special-properties)))) - (or - (org-entry-get (point) (upcase property)) - (org-entry-get (point) (concat org-bibtex-prefix (upcase property))))))) + (let ((it (let ((org-special-properties + (delete "FILE" (copy-sequence org-special-properties)))) + (or + (org-entry-get (point) (upcase property)) + (org-entry-get (point) (concat org-bibtex-prefix + (upcase property))))))) + (when it (org-babel-trim it)))) (defun org-bibtex-put (property value) (let ((prop (upcase (if (keywordp property) @@ -384,8 +385,8 @@ This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." (princ (cdr (assoc field org-bibtex-fields)))) (with-current-buffer buf-name (visual-line-mode 1)) (org-fit-window-to-buffer (get-buffer-window buf-name)) - ((lambda (result) (when (> (length result) 0) result)) - (read-from-minibuffer (format "%s: " name)))))) + (let ((result (read-from-minibuffer (format "%s: " name)))) + (when (> (length result) 0) result))))) (defun org-bibtex-autokey () "Generate an autokey for the current headline." @@ -539,20 +540,21 @@ Headlines are exported using `org-bibtex-export-headline'." "Bibtex file: " nil nil nil (file-name-nondirectory (concat (file-name-sans-extension (buffer-file-name)) ".bib"))))) - ((lambda (error-point) - (when error-point - (goto-char error-point) - (message "Bibtex error at %S" (nth 4 (org-heading-components))))) - (catch 'bib - (let ((bibtex-entries (remove nil (org-map-entries - (lambda () - (condition-case foo - (org-bibtex-headline) - (error (throw 'bib (point))))))))) - (with-temp-file filename - (insert (mapconcat #'identity bibtex-entries "\n"))) - (message "Successfully exported %d BibTeX entries to %s" - (length bibtex-entries) filename) nil)))) + (let ((error-point + (catch 'bib + (let ((bibtex-entries + (remove nil (org-map-entries + (lambda () + (condition-case foo + (org-bibtex-headline) + (error (throw 'bib (point))))))))) + (with-temp-file filename + (insert (mapconcat #'identity bibtex-entries "\n"))) + (message "Successfully exported %d BibTeX entries to %s" + (length bibtex-entries) filename) nil)))) + (when error-point + (goto-char error-point) + (message "Bibtex error at %S" (nth 4 (org-heading-components)))))) (defun org-bibtex-check (&optional optional) "Check the current headline for required fields. @@ -560,8 +562,8 @@ With prefix argument OPTIONAL also prompt for optional fields." (interactive "P") (save-restriction (org-narrow-to-subtree) - (let ((type ((lambda (name) (when name (intern (concat ":" name)))) - (org-bibtex-get org-bibtex-type-property-name)))) + (let ((type (let ((name (org-bibtex-get org-bibtex-type-property-name))) + (when name (intern (concat ":" name)))))) (when type (org-bibtex-fleshout type optional))))) (defun org-bibtex-check-all (&optional optional) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 9f2256286..0b2037d07 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1114,6 +1114,7 @@ so long." (defvar org-clock-current-task nil "Task currently clocked in.") (defvar org-clock-out-time nil) ; store the time of the last clock-out +(defvar org--msg-extra) ;;;###autoload (defun org-clock-in (&optional select start-time) @@ -1133,7 +1134,7 @@ make this the default behavior.)" (catch 'abort (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) (org-clocking-p))) - ts selected-task target-pos (msg-extra "") + ts selected-task target-pos (org--msg-extra "") (leftover (and (not org-clock-resolving-clocks) org-clock-leftover-time))) @@ -1305,7 +1306,7 @@ make this the default behavior.)" (setq org-clock-idle-timer nil)) (setq org-clock-idle-timer (run-with-timer 60 60 'org-resolve-clocks-if-idle)) - (message "Clock starts at %s - %s" ts msg-extra) + (message "Clock starts at %s - %s" ts org--msg-extra) (run-hooks 'org-clock-in-hook))))))) ;;;###autoload @@ -1351,7 +1352,6 @@ for a todo state to switch to, overriding the existing value (org-back-to-heading t) (move-marker org-clock-default-task (point)))) -(defvar msg-extra) (defun org-clock-get-sum-start () "Return the time from which clock times should be counted. This is for the currently running clock as it is displayed @@ -1364,10 +1364,10 @@ decides which time to use." (lr (org-entry-get nil "LAST_REPEAT"))) (cond ((equal cmt "current") - (setq msg-extra "showing time in current clock instance") + (setq org--msg-extra "showing time in current clock instance") (current-time)) ((equal cmt "today") - (setq msg-extra "showing today's task time.") + (setq org--msg-extra "showing today's task time.") (let* ((dt (decode-time (current-time)))) (setq dt (append (list 0 0 0) (nthcdr 3 dt))) (if org-extend-today-until @@ -1376,12 +1376,12 @@ decides which time to use." ((or (equal cmt "all") (and (or (not cmt) (equal cmt "auto")) (not lr))) - (setq msg-extra "showing entire task time.") + (setq org--msg-extra "showing entire task time.") nil) ((or (equal cmt "repeat") (and (or (not cmt) (equal cmt "auto")) lr)) - (setq msg-extra "showing task time since last repeat.") + (setq org--msg-extra "showing task time since last repeat.") (if (not lr) nil (org-time-string-to-time lr))) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 8790ad45f..523b42186 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -416,6 +416,10 @@ If yes, throw an error indicating that changing it does not make sense." (org-columns-next-allowed-value) (org-columns-edit-value "TAGS"))) +(defvar org-agenda-overriding-columns-format nil + "When set, overrides any other format definition for the agenda. +Don't set this, this is meant for dynamic scoping.") + (defun org-columns-edit-value (&optional key) "Edit the value of the property at point in column view. Where possible, use the standard interface for changing this line." @@ -901,10 +905,6 @@ display, or in the #+COLUMNS line of the current buffer." (insert-before-markers "#+COLUMNS: " fmt "\n"))) (org-set-local 'org-columns-default-format fmt)))))) -(defvar org-agenda-overriding-columns-format nil - "When set, overrides any other format definition for the agenda. -Don't set this, this is meant for dynamic scoping.") - (defun org-columns-get-autowidth-alist (s cache) "Derive the maximum column widths from the format and the cache." (let ((start 0) rtn) diff --git a/lisp/org-macro.el b/lisp/org-macro.el index fa74d8341..61e9243b8 100644 --- a/lisp/org-macro.el +++ b/lisp/org-macro.el @@ -5,6 +5,8 @@ ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/org-src.el b/lisp/org-src.el index 6ec3adc47..99038576f 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -844,8 +844,9 @@ with \",*\", \",#+\", \",,*\" and \",,#+\"." (let ((session (cdr (assoc :session (nth 2 info))))) (and session (not (string= session "none")) (org-babel-comint-buffer-livep session) - ((lambda (f) (and (fboundp f) (funcall f session))) - (intern (format "org-babel-%s-associate-session" (nth 0 info))))))) + (let ((f (intern (format "org-babel-%s-associate-session" + (nth 0 info))))) + (and (fboundp f) (funcall f session)))))) (defun org-src-babel-configure-edit-buffer () (when org-src-babel-info @@ -953,8 +954,9 @@ fontification of code blocks see `org-src-fontify-block' and LANG is a string, and the returned major mode is a symbol." (intern (concat - ((lambda (l) (if (symbolp l) (symbol-name l) l)) - (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode"))) + (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) + (if (symbolp l) (symbol-name l) l)) + "-mode"))) (provide 'org-src) diff --git a/lisp/org.el b/lisp/org.el index 4a74d44fe..8e23ec9f8 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -82,7 +82,7 @@ (require 'org-macs) (require 'org-compat) -;; `org-outline-regexp' ought to be a defconst but is let-binding in +;; `org-outline-regexp' ought to be a defconst but is let-bound in ;; some places -- e.g. see the macro `org-with-limited-levels'. ;; ;; In Org buffers, the value of `outline-regexp' is that of @@ -304,13 +304,13 @@ When MESSAGE is non-nil, display a message with the version." org-install-dir (concat "mixed installation! " org-install-dir " and " org-dir)) "org-loaddefs.el can not be found!"))) - (_version (if full version org-version))) + (version1 (if full version org-version))) (if (org-called-interactively-p 'interactive) (if here (insert version) (message version)) (if message (message _version)) - _version))) + version1))) (defconst org-version (org-version)) @@ -4804,6 +4804,8 @@ This can be turned on/off through `org-toggle-tags-groups'." :group 'org-startup :type 'boolean) +(defvar org-inhibit-startup nil) ; Dynamically-scoped param. + (defun org-toggle-tags-groups () "Toggle support for group tags. Support for group tags is controlled by the option @@ -5264,7 +5266,6 @@ This variable is set by `org-before-change-function'. "Every change indicates that a table might need an update." (setq org-table-may-need-update t)) (defvar org-mode-map) -(defvar org-inhibit-startup nil) ; Dynamically-scoped param. (defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. (defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. (defvar org-inhibit-logging nil) ; Dynamically-scoped param. @@ -6714,6 +6715,8 @@ in special contexts. (setq org-cycle-global-status 'overview) (run-hook-with-args 'org-cycle-hook 'overview))))) +(defvar org-called-with-limited-levels);Dyn-bound in ̀org-with-limited-levels'. + (defun org-cycle-internal-local () "Do the local cycling action." (let ((goal-column 0) eoh eol eos has-children children-skipped struct) @@ -7944,8 +7947,6 @@ even level numbers will become the next higher odd number." (define-obsolete-function-alias 'org-get-legal-level 'org-get-valid-level "23.1"))) -(defvar org-called-with-limited-levels nil) ;; Dynamically bound in -;; ̀org-with-limited-levels' (defun org-promote () "Promote the current heading higher up the tree. If the region is active in `transient-mark-mode', promote all headings @@ -10321,6 +10322,7 @@ Functions in this hook must return t if they identify and follow a link at point. If they don't find anything interesting at point, they must return nil.") +(defvar org-link-search-inhibit-query nil) ;; dynamically scoped (defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el (defun org-open-at-point (&optional arg reference-buffer) "Open link at or after point. @@ -10696,7 +10698,6 @@ the window configuration before `org-open-at-point' was called using: (set-window-configuration org-window-config-before-follow-link)") -(defvar org-link-search-inhibit-query nil) ;; dynamically scoped (defun org-link-search (s &optional type avoid-pos stealth) "Search for a link search option. If S is surrounded by forward slashes, it is interpreted as a @@ -13104,6 +13105,9 @@ nil." (delete-region (point-at-bol) (min (point-max) (1+ (point-at-eol)))))))))) +(defvar org-time-was-given) ; dynamically scoped parameter +(defvar org-end-time-was-given) ; dynamically scoped parameter + (defun org-add-planning-info (what &optional time &rest remove) "Insert new timestamp with keyword in the line directly after the headline. WHAT indicates what kind of time stamp to add. TIME indicates the time to use. @@ -16035,8 +16039,6 @@ Return the position where this entry starts, or nil if there is no such entry." (defvar org-last-changed-timestamp nil) (defvar org-last-inserted-timestamp nil "The last time stamp inserted with `org-insert-time-stamp'.") -(defvar org-time-was-given) ; dynamically scoped parameter -(defvar org-end-time-was-given) ; dynamically scoped parameter (defvar org-ts-what) ; dynamically scoped parameter (defun org-time-stamp (arg &optional inactive) @@ -16225,6 +16227,10 @@ So these are more for recording a certain time/date." map) "Keymap for minibuffer commands when using `org-read-date'.") +(defvar org-def) +(defvar org-defdecode) +(defvar org-with-time) + (defun org-read-date (&optional org-with-time to-time from-string prompt default-time default-input inactive) "Read a date, possibly a time, and make things smooth for the user. @@ -16371,9 +16377,6 @@ user." (nth 2 final) (nth 1 final)) (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) -(defvar org-def) -(defvar org-defdecode) -(defvar org-with-time) (defun org-read-date-display () "Display the current date prompt interpretation in the minibuffer." (when org-read-date-display-live diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 32262cc9a..430bc6e61 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -1,10 +1,12 @@ ;;; ox-ascii.el --- ASCII Back-End for Org Export Engine -;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/ox-beamer.el b/lisp/ox-beamer.el index c5074f681..2868944c9 100644 --- a/lisp/ox-beamer.el +++ b/lisp/ox-beamer.el @@ -1,11 +1,13 @@ ;;; ox-beamer.el --- Beamer Back-End for Org Export Engine -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. +;; Copyright (C) 2007-2013 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Nicolas Goaziou ;; Keywords: org, wp, tex +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/ox-html.el b/lisp/ox-html.el index c47cc8610..5aeaaf7bc 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -1,11 +1,13 @@ ;;; ox-html.el --- HTML Back-End for Org Export Engine -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. +;; Copyright (C) 2011-2013 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Jambunathan K ;; Keywords: outlines, hypermedia, calendar, wp +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or @@ -184,7 +186,7 @@ the headline itself.") @licstart The following is the entire license notice for the JavaScript code in this tag. -Copyright (C) 2012 Free Software Foundation, Inc. +Copyright (C) 2012-2013 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 @@ -381,7 +383,7 @@ means to use the maximum value consistent with other options." * @licstart The following is the entire license notice for the * JavaScript code in %SCRIPT_PATH. * - * Copyright (C) 2012-2013 Sebastian Rose + * Copyright (C) 2012-2013 Free Software Foundation, Inc. * * * The JavaScript code in this tag is free software: you can diff --git a/lisp/ox-icalendar.el b/lisp/ox-icalendar.el index 8dfe836c9..7c4b4bfbc 100644 --- a/lisp/ox-icalendar.el +++ b/lisp/ox-icalendar.el @@ -1,12 +1,14 @@ ;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine -;; Copyright (C) 2004-2012 Free Software Foundation, Inc. +;; Copyright (C) 2004-2013 Free Software Foundation, Inc. ;; Author: Carsten Dominik ;; Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 1da7f9bbc..4dc0fd073 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -5,6 +5,8 @@ ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 7d540787d..811c4e580 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -1,10 +1,12 @@ ;;; ox-md.el --- Markdown Back-End for Org Export Engine -;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: org, wp, markdown +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 07f6889ae..eb7856b29 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -3113,12 +3113,11 @@ and prefix with \"OrgSrc\". For example, `font-lock-function-name-face' is associated with \"OrgSrcFontLockFunctionNameFace\"." (let* ((css-list (hfy-face-to-style fn)) - (style-name ((lambda (fn) - (concat "OrgSrc" - (mapconcat - 'capitalize (split-string - (hfy-face-or-def-to-name fn) "-") - ""))) fn)) + (style-name (concat "OrgSrc" + (mapconcat + 'capitalize (split-string + (hfy-face-or-def-to-name fn) "-") + ""))) (color-val (cdr (assoc "color" css-list))) (background-color-val (cdr (assoc "background" css-list))) (style (and org-odt-create-custom-styles-for-srcblocks diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 41798b3e1..cecad5632 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -1,10 +1,12 @@ ;;; ox-org.el --- Org Back-End for Org Export Engine -;; Copyright (C) 2013 Free Software Foundation, Inc. +;; Copyright (C) 2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: org, wp +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index 596797845..dcc9b7907 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 -;; Copyright (C) 2012, 2013 Jonathan Leech-Pepin +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. ;; Author: Jonathan Leech-Pepin ;; Keywords: outlines, hypermedia, calendar, wp diff --git a/lisp/ox.el b/lisp/ox.el index f7566945a..69dca6854 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -1,10 +1,12 @@ ;;; ox.el --- Generic Export Engine for Org Mode -;; Copyright (C) 2012, 2013 Free Software Foundation, Inc. +;; Copyright (C) 2012-2013 Free Software Foundation, Inc. ;; Author: Nicolas Goaziou ;; Keywords: outlines, hypermedia, calendar, wp +;; This file is part of GNU Emacs. + ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or From 487057fc2643e2fd9dc135b6219d4b58e4674023 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 12 Nov 2013 21:11:23 +0100 Subject: [PATCH 083/166] Fix conflicts from previous merge --- lisp/ob-C.el | 19 +---------------- lisp/ob-clojure.el | 28 ------------------------ lisp/ob-core.el | 10 +-------- lisp/ob-lisp.el | 53 ++++++++++++---------------------------------- lisp/org-clock.el | 10 +-------- 5 files changed, 17 insertions(+), 103 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index e155b4cb5..ecc08c882 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -103,29 +103,13 @@ or `org-babel-execute:C++'." (mapconcat 'identity (if (listp flags) flags (list flags)) " ") (org-babel-process-file-name tmp-src-file)) "")))) -<<<<<<< HEAD - ((lambda (results) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results t) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) -======= (let ((results (org-babel-trim (org-babel-eval (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) (org-babel-reassemble-table (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) + (org-babel-read results t) (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file))) @@ -134,7 +118,6 @@ or `org-babel-execute:C++'." (org-babel-pick-name (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) )) ->>>>>>> maint (defun org-babel-C-expand (body params) "Expand a block of C or C++ code with org-babel according to diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index b2794dbcb..d797a3f76 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -24,18 +24,13 @@ ;;; Commentary: -<<<<<<< HEAD ;; Support for evaluating clojure code, relies either on Slime or ;; on Nrepl.el for all eval. -======= -;; Support for evaluating clojure code, relies on slime for all eval. ->>>>>>> maint ;; Requirements: ;; - clojure (at least 1.2.0) ;; - clojure-mode -<<<<<<< HEAD ;; - either cider or nrepl.el or SLIME ;; For cider, see https://github.com/clojure-emacs/cider @@ -47,13 +42,6 @@ ;; For nREPL: ;; get clojure with https://github.com/technomancy/leiningen ;; get nrepl from MELPA (clojure-mode is a dependency). -======= -;; - slime - -;; By far, the best way to install these components is by following -;; the directions as set out by Phil Hagelberg (Technomancy) on the -;; web page: http://technomancy.us/126 ->>>>>>> maint ;;; Code: (require 'ob) @@ -108,7 +96,6 @@ (defun org-babel-execute:clojure (body params) "Execute a block of Clojure code with Babel." -<<<<<<< HEAD (let ((expanded (org-babel-expand-body:clojure body params))) (case org-babel-clojure-backend (cider @@ -140,21 +127,6 @@ `(swank:eval-and-grab-output ,(buffer-substring-no-properties (point-min) (point-max))) (cdr (assoc :package params))))))))) -======= - (require 'slime) - (with-temp-buffer - (insert (org-babel-expand-body:clojure body params)) - (let ((result - (slime-eval - `(swank:eval-and-grab-output - ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assoc :package params))))) - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - result - (condition-case nil (org-babel-script-escape result) - (error result))))))) ->>>>>>> maint (provide 'ob-clojure) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 12c3c2b7d..497293b4d 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -2740,16 +2740,8 @@ name is removed, since in that case the process will be executing remotely. The file name is then processed by `expand-file-name'. Unless second argument NO-QUOTE-P is non-nil, the file name is additionally processed by `shell-quote-argument'" -<<<<<<< HEAD - ((lambda (f) (if no-quote-p f (shell-quote-argument f))) - ;; We must apply `expand-file-name' on the whole filename. If we - ;; would apply it on the local filename only, undesired effects - ;; like prepending a drive letter on MS Windows could happen. - (org-babel-local-file-name (expand-file-name name)))) -======= - (let ((f (expand-file-name (org-babel-local-file-name name)))) + (let ((f (org-babel-local-file-name (expand-file-name name)))) (if no-quote-p f (shell-quote-argument f)))) ->>>>>>> maint (defvar org-babel-temporary-directory) (unless (or noninteractive (boundp 'org-babel-temporary-directory)) diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 6bc53f8ef..3f156d025 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -75,51 +75,26 @@ current directory string." "Execute a block of Common Lisp code with Babel." (require 'slime) (org-babel-reassemble-table -<<<<<<< HEAD - ((lambda (result) - (org-babel-result-cond (cdr (assoc :result-params params)) - result - (condition-case nil - (if (member "output" (cdr (assoc :result-params params))) - ;; read printed output using normal org table parsing - (let ((tmp-file (org-babel-temp-file "lisp-output-"))) - (with-temp-file tmp-file (insert result)) - (org-babel-import-elisp-from-file tmp-file)) - ;; read valued output as lisp - (read (org-babel-lisp-vector-to-list result))) - (error result)))) - (funcall (if (member "output" (cdr (assoc :result-params params))) - #'car #'cadr) - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format (format org-babel-lisp-dir-fmt dir) - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params)))))) -======= (let ((result - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) - "(progn %s)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params)))))) + (funcall (if (member "output" (cdr (assoc :result-params params))) + #'car #'cadr) + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (slime-eval `(swank:eval-and-grab-output + ,(let ((dir (if (assoc :dir params) + (cdr (assoc :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assoc :package params))))))) (org-babel-result-cond (cdr (assoc :result-params params)) (car result) (condition-case nil (read (org-babel-lisp-vector-to-list (cadr result))) (error (cadr result))))) ->>>>>>> maint (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index f588a101c..88213e37f 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1367,21 +1367,13 @@ decides which time to use." (setq org--msg-extra "showing time in current clock instance") (current-time)) ((equal cmt "today") -<<<<<<< HEAD - (setq msg-extra "showing today's task time.") + (setq org--msg-extra "showing today's task time.") (let* ((dt (decode-time (current-time))) (hour (nth 2 dt)) (day (nth 3 dt))) (if (< hour org-extend-today-until) (setf (nth 3 dt) (1- day))) (setf (nth 2 dt) org-extend-today-until) (setq dt (append (list 0 0) (nthcdr 2 dt))) -======= - (setq org--msg-extra "showing today's task time.") - (let* ((dt (decode-time (current-time)))) - (setq dt (append (list 0 0 0) (nthcdr 3 dt))) - (if org-extend-today-until - (setf (nth 2 dt) org-extend-today-until)) ->>>>>>> maint (apply 'encode-time dt))) ((or (equal cmt "all") (and (or (not cmt) (equal cmt "auto")) From f49654aeff17bac75ecbf1e3c1130dac2acc06c5 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 12 Nov 2013 21:12:28 +0100 Subject: [PATCH 084/166] org-agenda.el (org-agenda-set-restriction-lock): Autoload * org-agenda.el (org-agenda-set-restriction-lock): Autoload. --- lisp/org-agenda.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 3ecd49a81..3af1947bd 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7084,6 +7084,7 @@ their type." 'help-echo "Agendas are currently limited to this subtree.") (org-detach-overlay org-agenda-restriction-lock-overlay) +;;;###autoload (defun org-agenda-set-restriction-lock (&optional type) "Set restriction lock for agenda, to current subtree or file. Restriction will be the file if TYPE is `file', or if type is the From 4d7293e2d0ce604ba42027734debbe4a2dd3875a Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 12 Nov 2013 21:24:32 +0100 Subject: [PATCH 085/166] ox-html.el (org-html-text-markup-alist): Fix version * ox-html.el (org-html-text-markup-alist): Fix version. Thanks to Jambunathan for reporting this. --- lisp/ox-html.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 5aeaaf7bc..ad5597482 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -544,6 +544,8 @@ a formatting string to wrap fontified text with. If no association can be found for a given markup, text will be returned as-is." :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") :type '(alist :key-type (symbol :tag "Markup type") :value-type (string :tag "Format string")) :options '(bold code italic strike-through underline verbatim)) From d2ba43c4965820a391370ae8c1141f2f5a369667 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 13 Nov 2013 07:27:10 +0100 Subject: [PATCH 086/166] ox-html.el: Add version and package-version to some options * ox-html.el (org-html-format-drawer-function) (org-html-format-headline-function) (org-html-format-inlinetask-function) (org-html-creator-string): Add version and package-version. Thanks to Jambunathan for reporting problems in this area. --- lisp/ox-html.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index ad5597482..f013293e4 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -583,6 +583,8 @@ in order to mimic default behaviour: \"Format a drawer element for HTML export.\" contents\)" :group 'org-export-html + :version "8.0" + :package-version '(Org . "8.0") :type 'function) ;;;; Footnotes @@ -636,6 +638,8 @@ TAGS the tags (string or nil). The function result will be used in the section format string." :group 'org-export-html + :version "8.0" + :package-version '(Org . "8.0") :type 'function) ;;;; HTML-specific @@ -664,6 +668,8 @@ The function must accept six parameters: The function should return the string to be exported." :group 'org-export-html + :version "8.0" + :package-version '(Org . "8.0") :type 'function) ;;;; LaTeX @@ -1121,6 +1127,8 @@ like that: \"%%\"." "Information about the creator of the HTML document. This option can also be set on with the CREATOR keyword." :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") :type '(string :tag "Creator string")) ;;;; Template :: Preamble From 369f70ac288099b9e2c8158ffa4b4dd2871ecba3 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 13 Nov 2013 07:35:57 +0100 Subject: [PATCH 087/166] ox-odt.el: Add version and package-version to some options * ox-odt.el (org-odt-inline-formula-rules) (org-odt-inline-image-rules, org-odt-use-date-fields): Add version and package-version. --- lisp/ox-odt.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index eb7856b29..a450c7e38 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -746,6 +746,8 @@ 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 "8.0" + :package-version '(Org . "8.0") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -757,6 +759,8 @@ 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 "8.0" + :package-version '(Org . "8.0") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -929,6 +933,8 @@ the application UI or through a custom styles file. See `org-odt--build-date-styles' for implementation details." :group 'org-export-odt + :version "8.0" + :package-version '(Org . "8.0") :type 'boolean) From 757eb6e0fb4bd62de6e945bd157e3004ffb75019 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 13 Nov 2013 08:46:01 +0100 Subject: [PATCH 088/166] Fix previous commits Thanks to Jambunathan for pointing this. --- lisp/ox-html.el | 6 +++--- lisp/ox-odt.el | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index f013293e4..fed8dcd42 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -583,7 +583,7 @@ in order to mimic default behaviour: \"Format a drawer element for HTML export.\" contents\)" :group 'org-export-html - :version "8.0" + :version "24.4" :package-version '(Org . "8.0") :type 'function) @@ -638,7 +638,7 @@ TAGS the tags (string or nil). The function result will be used in the section format string." :group 'org-export-html - :version "8.0" + :version "24.4" :package-version '(Org . "8.0") :type 'function) @@ -668,7 +668,7 @@ The function must accept six parameters: The function should return the string to be exported." :group 'org-export-html - :version "8.0" + :version "24.4" :package-version '(Org . "8.0") :type 'function) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index a450c7e38..bfef3c395 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -746,7 +746,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 "8.0" + :version "24.4" :package-version '(Org . "8.0") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -759,7 +759,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 "8.0" + :version "24.4" :package-version '(Org . "8.0") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -933,7 +933,7 @@ the application UI or through a custom styles file. See `org-odt--build-date-styles' for implementation details." :group 'org-export-odt - :version "8.0" + :version "24.4" :package-version '(Org . "8.0") :type 'boolean) From 7230133f8d5eb2727fea88f16c3f664d4d16a8c2 Mon Sep 17 00:00:00 2001 From: Mark Edgington Date: Wed, 13 Nov 2013 07:32:01 -0500 Subject: [PATCH 089/166] org-collector: enable specifying a default table-value as a parameter * contrib/lisp/org-collector.el (org-dblock-write:propview): if a 'defaultval' property has been set, then use this in place of org-propview-default-value. TINYCHANGE --- contrib/lisp/org-collector.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/contrib/lisp/org-collector.el b/contrib/lisp/org-collector.el index 60b906982..d62a46234 100644 --- a/contrib/lisp/org-collector.el +++ b/contrib/lisp/org-collector.el @@ -121,6 +121,7 @@ preceeding the dblock, then update the contents of the dblock." (scope (plist-get params :scope)) (noquote (plist-get params :noquote)) (colnames (plist-get params :colnames)) + (defaultval (plist-get params :defaultval)) (content-lines (org-split-string (plist-get params :content) "\n")) id table line pos) (save-excursion @@ -133,9 +134,10 @@ preceeding the dblock, then update the contents of the dblock." (t (error "Cannot find entry with :ID: %s" id)))) (unless (eq id 'global) (org-narrow-to-subtree)) (setq stringformat (if noquote "%s" "%S")) - (setq table (org-propview-to-table - (org-propview-collect cols stringformat conds match scope inherit - (if colnames colnames cols)) stringformat)) + (let ((org-propview-default-value (if defaultval defaultval org-propview-default-value))) + (setq table (org-propview-to-table + (org-propview-collect cols stringformat conds match scope inherit + (if colnames colnames cols)) stringformat))) (widen)) (setq pos (point)) (when content-lines From 1eb03c8c87de9ccd0506ed90c4938240f5eb9fc2 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 13 Nov 2013 13:56:12 +0100 Subject: [PATCH 090/166] org.el: Allow C--1 C-c C-t to set repeated tasks to a done state * org.el (org-cancel-repeater): New function. (org-todo): Use the new function to cancel a repeater when called with a numeric arg of -1. Thanks to Kenneth Jacker for requesting a similar feature. --- lisp/org.el | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 3f677d628..689a362e8 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12125,6 +12125,21 @@ nil or a string to be used for the todo mark." ) (defvar org-block-entry-blocking "" "First entry preventing the TODO state change.") +(defun org-cancel-repeater () + "Cancel a repeater by setting its numeric value to zero." + (interactive) + (save-excursion + (org-back-to-heading t) + (let ((bound1 (point)) + (bound0 (save-excursion (outline-next-heading) (point)))) + (when (re-search-forward + (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" + org-deadline-time-regexp "\\)\\|\\(" + org-ts-regexp "\\)") + bound0 t) + (if (re-search-backward "[ \t]+\\(?:[.+]\\)?\\+\\([0-9]+\\)[hdwmy]" bound1 t) + (replace-match "0" t nil nil 1)))))) + (defun org-todo (&optional arg) "Change the TODO state of an item. The state of an item is given by a keyword at the start of the heading, @@ -12145,6 +12160,7 @@ With a double \\[universal-argument] prefix, switch to the next set of TODO \ keywords (nextset). With a triple \\[universal-argument] prefix, circumvent any state blocking. With a numeric prefix arg of 0, inhibit note taking for the change. +With a numeric prefix arg of -1, cancel repeater to allow marking as DONE. When called through ELisp, arg is also interpreted in the following way: 'none -> empty state @@ -12164,6 +12180,7 @@ When called through ELisp, arg is also interpreted in the following way: org-loop-over-headlines-in-active-region cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) (if (equal arg '(16)) (setq arg 'nextset)) + (when (equal arg -1) (org-cancel-repeater) (setq arg nil)) (let ((org-blocker-hook org-blocker-hook) commentp case-fold-search) @@ -12829,7 +12846,7 @@ This function is run automatically after each state change to a DONE state." (org-log-done nil) (org-todo-log-states nil) re type n what ts time to-state) - (when repeat + (when (and repeat (not (zerop (string-to-number repeat)))) (if (eq org-log-repeat t) (setq org-log-repeat 'state)) (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") org-todo-repeat-to-state)) From 6255cbb3fed241d611032fd79d0fc21e0e2bb803 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 13 Nov 2013 14:00:09 +0100 Subject: [PATCH 091/166] org.texi (Repeated tasks): Document marking repeating tasks as done * org.texi (Repeated tasks): Document marking repeating tasks as done. --- doc/org.texi | 3 +++ 1 file changed, 3 insertions(+) diff --git a/doc/org.texi b/doc/org.texi index 9e64c52af..748f3ea24 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -6241,6 +6241,9 @@ switch the date like this: DEADLINE: <2005-11-01 Tue +1m> @end example +To mark a task with a repeater as @code{DONE}, use @kbd{C-- 1 C-c C-t} +(i.e., @code{org-todo} with a numeric prefix argument of -1.) + @vindex org-log-repeat A timestamp@footnote{You can change this using the option @code{org-log-repeat}, or the @code{#+STARTUP} options @code{logrepeat}, From 6a39355eeea427f4675d58d18f58321266328637 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 13 Nov 2013 14:03:21 +0100 Subject: [PATCH 092/166] org.el: Name indirect buffer after the subtree's heading * org.el (org-get-indirect-buffer): New optional argument `heading'. Use it to name the indirect buffer after the heading the subtree, if any. (org-tree-to-indirect-buffer): Use the new argument. Thanks to Karl Voit for suggesting this. --- lisp/org.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 689a362e8..4e352d03e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7477,7 +7477,7 @@ frame is not changed." (not (eq org-indirect-buffer-display 'new-frame)) (not arg)) (kill-buffer org-last-indirect-buffer)) - (setq ibuf (org-get-indirect-buffer cbuf) + (setq ibuf (org-get-indirect-buffer cbuf heading) org-last-indirect-buffer ibuf) (cond ((or (eq org-indirect-buffer-display 'new-frame) @@ -7508,11 +7508,15 @@ frame is not changed." (run-hook-with-args 'org-cycle-hook 'all) (and (window-live-p cwin) (select-window cwin)))) -(defun org-get-indirect-buffer (&optional buffer) +(defun org-get-indirect-buffer (&optional buffer heading) (setq buffer (or buffer (current-buffer))) (let ((n 1) (base (buffer-name buffer)) bname) (while (buffer-live-p - (get-buffer (setq bname (concat base "-" (number-to-string n))))) + (get-buffer + (setq bname + (concat base "-" + (if heading (concat heading "-" (number-to-string n)) + (number-to-string n)))))) (setq n (1+ n))) (condition-case nil (make-indirect-buffer buffer bname 'clone) From b6448c4225bc83299da1bd08c2d2e8b77e0bcd13 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Tue, 12 Nov 2013 21:55:53 +0100 Subject: [PATCH 093/166] ob-ref: Fix "Marker points into wrong buffer" error * lisp/ob-ref.el (org-babel-ref-parse): If `org-babel-current-src-block-location' is a marker, it can be from another buffer, use marker-position instead in this case. Introduced with r114064 on Emacs trunk. Not sure if this is a bug in Org or Emacs, but the patch restores the previous behaviour. --- lisp/ob-ref.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index 5a3c8ba2e..251fa557a 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -85,7 +85,9 @@ the variable." (cons (intern var) (let ((out (save-excursion (when org-babel-current-src-block-location - (goto-char org-babel-current-src-block-location)) + (goto-char (if (markerp org-babel-current-src-block-location) + (marker-position org-babel-current-src-block-location) + org-babel-current-src-block-location))) (org-babel-read ref)))) (if (equal out ref) (if (string-match "^\".*\"$" ref) From 1877652ce0234cf333fa103b5ada08fbf5946ab1 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Wed, 13 Nov 2013 11:42:40 -0700 Subject: [PATCH 094/166] allow reference to named call lines * lisp/ob-ref.el (org-babel-ref-resolve): Look for call lines when resolving references. --- lisp/ob-ref.el | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index 251fa557a..b8ee9f82b 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -186,6 +186,11 @@ the variable." (or (looking-at org-babel-src-block-regexp) (looking-at org-babel-multi-line-header-regexp)))) (setq type 'source-block)) + ((and (looking-at org-babel-src-name-regexp) + (save-excursion + (forward-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (setq type 'call-line)) (t (while (not (setq type (org-babel-ref-at-ref-p))) (forward-line 1) (beginning-of-line) @@ -201,6 +206,10 @@ the variable." (source-block (org-babel-execute-src-block nil nil (if org-babel-update-intermediate nil params))) + (call-line (save-excursion + (forward-line 1) + (org-babel-lob-execute + (org-babel-lob-get-info)))) (lob (org-babel-execute-src-block nil lob-info params)) (id (org-babel-ref-headline-body))))) From 396b2172e49390c329c4a4d74cf457b39c2cf0bd Mon Sep 17 00:00:00 2001 From: Michael Brand Date: Wed, 13 Nov 2013 20:10:56 +0100 Subject: [PATCH 095/166] Improve manual and ERT for table formulas * doc/org.texi (Field coordinates in formulas): Rephrase and add an example with a Lisp formula to copy from remote table. * testing/lisp/test-org-table.el (Comments): Adapt comment. (test-org-table/copy-field): Add reference to `test-org-table/remote-reference-access'. (test-org-table/remote-reference-access): Add reference to `test-org-table/copy-field'. Differentiate between Lisp formula to copy and Calc (or Lisp) formula to calculate. --- doc/org.texi | 33 ++++++++++++++++++++------------- testing/lisp/test-org-table.el | 27 ++++++++++++++++----------- 2 files changed, 36 insertions(+), 24 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 748f3ea24..4aeae70e7 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -2547,21 +2547,28 @@ for Calc}. @cindex row, of field coordinates @cindex column, of field coordinates -For Calc formulas and Lisp formulas @code{@@#} and @code{$#} can be used to -get the row or column number of the field where the formula result goes. -The traditional Lisp formula equivalents are @code{org-table-current-dline} -and @code{org-table-current-column}. Examples: +One of the very first actions during evaluation of Calc formulas and Lisp +formulas is to substitute @code{@@#} and @code{$#} in the formula with the +row or column number of the field where the current result will go to. The +traditional Lisp formula equivalents are @code{org-table-current-dline} and +@code{org-table-current-column}. Examples: -@example -if(@@# % 2, $#, string("")) @r{column number on odd lines only} -$3 = remote(FOO, @@@@#$2) @r{copy column 2 from table FOO into} - @r{column 3 of the current table} -@end example +@table @code +@item if(@@# % 2, $#, string("")) +Insert column number on odd rows, set field to empty on even rows. +@item $2 = '(identity remote(FOO, @@@@#$1)) +Copy text or values of each row of column 1 of the table named @code{FOO} +into column 2 of the current table. +@item @@3 = 2 * remote(FOO, @@1$$#) +Insert the doubled value of each column of row 1 of the table named +@code{FOO} into row 3 of the current table. +@end table -@noindent For the second example, table FOO must have at least as many rows -as the current table. Note that this is inefficient@footnote{The computation time scales as -O(N^2) because table FOO is parsed for each field to be copied.} for large -number of rows. +@noindent For the second/third example, the table named @code{FOO} must have +at least as many rows/columns as the current table. Note that this is +inefficient@footnote{The computation time scales as O(N^2) because the table +named @code{FOO} is parsed for each field to be read.} for large number of +rows/columns. @subsubheading Named references @cindex named references diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el index e78e56ba0..edb51c42d 100644 --- a/testing/lisp/test-org-table.el +++ b/testing/lisp/test-org-table.el @@ -20,10 +20,9 @@ ;;;; Comments: -;; Template test file for Org-mode tests. First the tests that are -;; also a howto example collection as a user documentation, more or -;; less all those using `org-test-table-target-expect'. Then the -;; internal and more abstract tests. See also the doc string of +;; Template test file for Org-mode tests. Many tests are also a howto +;; example collection as a user documentation, more or less all those +;; using `org-test-table-target-expect'. See also the doc string of ;; `org-test-table-target-expect'. ;;; Code: @@ -553,7 +552,8 @@ reference (with row). Mode string N." )) (ert-deftest test-org-table/copy-field () - "Experiments on how to copy one field into another field." + "Experiments on how to copy one field into another field. +See also `test-org-table/remote-reference-access'." (let ((target " | 0 | replace | @@ -772,21 +772,26 @@ reference (with row). Mode string N." ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)")))) (ert-deftest test-org-table/remote-reference-access () - "Access to remote reference." + "Access to remote reference. +See also `test-org-table/copy-field'." (org-test-table-target-expect " #+NAME: table -| | 42 | +| | x 42 | | -| replace | | +| replace | replace | " " #+NAME: table -| | 42 | +| | x 42 | | -| 42 | | +| x 42 | 84 x | " - 1 "#+TBLFM: $1 = remote(table, @1$2)")) + 1 (concat "#+TBLFM: " + ;; Copy text without calculation: Use Lisp formula + "$1 = '(identity remote(table, @1$2)) :: " + ;; Do a calculation: Use Calc (or Lisp ) formula + "$2 = 2 * remote(table, @1$2)"))) (ert-deftest test-org-table/org-at-TBLFM-p () (org-test-with-temp-text-in-file From 6f6d90a363e4c59914f0078d1dbe978d59d04748 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Thu, 14 Nov 2013 00:53:43 +0100 Subject: [PATCH 096/166] org.el (org-refile-check-position): Enhance error message * org.el (org-refile-check-position): Enhance error message. --- lisp/org.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 4e352d03e..b29636a5c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11755,7 +11755,9 @@ this is used for the GOTO interface." (pos (nth 3 refile-pointer)) buffer) (if (and (not (markerp pos)) (not file)) - (user-error "Please save the buffer to a file before refiling") + (if file + (user-error "Please save the buffer to a file before refiling") + (user-error "Please indicate a target file in the refile path")) (when (org-string-nw-p re) (setq buffer (if (markerp pos) (marker-buffer pos) From c67e3cda155e0a15534b5e0dfa29a1d87216d132 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Wed, 13 Nov 2013 16:26:26 -0700 Subject: [PATCH 097/166] default to preserving hlines in call lines * lisp/ob-core.el (org-babel-default-inline-header-args): Added (:hlines "yes") to the default value. --- lisp/ob-core.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 497293b4d..2e140d721 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -530,7 +530,8 @@ For the format of SAFE-LIST, see `org-babel-safe-header-args'." (org-babel-header-args-safe-fn org-babel-safe-header-args)) (defvar org-babel-default-inline-header-args - '((:session . "none") (:results . "replace") (:exports . "results")) + '((:session . "none") (:results . "replace") + (:exports . "results") (:hlines . "yes")) "Default arguments to use when evaluating an inline source block.") (put 'org-babel-default-inline-header-args 'safe-local-variable (org-babel-header-args-safe-fn org-babel-safe-header-args)) From d840b84bbcea08facb3b6731b7b56de681f15394 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Wed, 13 Nov 2013 16:31:17 -0700 Subject: [PATCH 098/166] Don't skip call lines searching for results This fixes a bug noticed by Rick Frankel in which two subsequent #+call: lines will both update the same results. Before this commit both of the following call lines would update the same result. #+name: call-me #+BEGIN_SRC emacs-lisp :var v="nil" v #+END_SRC #+call: call-me("one") #+call: call-me(v="two") #+RESULTS: : one Now both lines are given their own result. #+name: call-me #+BEGIN_SRC emacs-lisp :var v="nil" v #+END_SRC #+call: call-me("one") #+RESULTS: : one #+call: call-me(v="two") #+RESULTS: : two --- lisp/ob-core.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 2e140d721..85bd27dc0 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1929,7 +1929,10 @@ following the source block." (cond ((looking-at (concat org-babel-result-regexp "\n")) (throw 'non-comment t)) - ((looking-at "^[ \t]*#") (end-of-line 1)) + ((and (looking-at "^[ \t]*#") + (not (looking-at + org-babel-lob-one-liner-regexp))) + (end-of-line 1)) (t (throw 'non-comment nil)))))) (let ((this-hash (match-string 5))) (prog1 (point) From 8c5406d9620216fe703fe282f1a7b1ce94f52427 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Thu, 14 Nov 2013 09:54:35 +0100 Subject: [PATCH 099/166] ox-odt.el (org-odt-display-outline-level): Fix version * ox-odt.el (org-odt-display-outline-level): Fix version. --- lisp/ox-odt.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index bfef3c395..3e5be2292 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -498,7 +498,8 @@ a per-file basis. For example, (defcustom org-odt-display-outline-level 2 "Outline levels considered for enumerating captioned entities." :group 'org-export-odt - :version "24.2" + :version "24.4" + :package-version '(Org . "8.0") :type 'integer) ;;;; Document conversion From adcebf38f8ba4f5053757529dd0ef0ecb0b78781 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Thu, 14 Nov 2013 14:05:18 +0100 Subject: [PATCH 100/166] Fix errors reported by cus-test.el * ox.el (org-export-async-init-file): Use :set to set the default value. * ox-texinfo.el (org-texinfo-filename): Fix default value. (org-texinfo-format-headline-function): Use 'ignore as the default value. (org-texinfo-format-drawer-function): Use a function as the default value. Update docstring. (org-texinfo-drawer): Always use `org-texinfo-format-drawer-function' as it is now a function by default. (org-texinfo-headline): Compare `org-texinfo-format-headline-function' against 'ignore. (org-texinfo-inlinetask): Compare `org-texinfo-format-inlinetask-function' against 'ignore. * ox-odt.el (org-odt-format-drawer-function): Use a function as the default value. Update docstring. (org-odt-format-headline-function) (org-odt-format-inlinetask-function): Fix default value. (org-odt-with-latex): Use :set to set the default value. (org-odt-drawer): Always use `org-odt-format-drawer-function' as it is now a function by default. (org-odt-format-headline--wrap): Compare `org-odt-format-headline-function' against 'ignore. * ox-latex.el (org-latex-format-drawer-function): Use a function as the default value. Update docstring. (org-latex-format-inlinetask-function): Fix default value. (org-latex-drawer): Always use `org-latex-format-drawer-function' as it is now a function by default. (org-latex-inlinetask): Compare `org-latex-format-inlinetask-function' against 'ignore. * ox-html.el (org-html-format-drawer-function): Use a function as the default value. Update docstring. (org-html-format-headline-function) (org-html-format-inlinetask-function): Fix default value. (org-html-with-latex): Use :set to set the default value. (org-html--format-toc-headline) (org-html-format-headline--wrap): Compare `org-html-format-headline-function' against 'ignore. (org-html-inlinetask): Compare `org-html-format-inlinetask-function' against 'ignore. * ox-ascii.el (org-ascii-format-drawer-function): Use a function as the default value. Update docstring. (org-ascii-drawer): Always use `org-ascii-format-drawer-function' as it is now a function by default. (org-ascii-format-inlinetask-default): New function. (org-ascii-format-inlinetask-function): Use `org-ascii-format-inlinetask-default' as the default. * org.el (org-mouse-1-follows-link): Use :set to set the default value. Update custom type. (org-log-note-headings): Fix order or list items in the custom type. (orgstruct-heading-prefix-regexp): Use an empty string as the default value. Use 'regexp as the custom type. (orgstruct-make-binding): Tiny docstring enhancement. Assume `orgstruct-heading-prefix-regexp' is a string. * org-agenda.el (org-agenda-search-view-max-outline-level): Set default value to 0. Update docstring. (org-agenda-deadline-leaders): Fix custom type. (org-search-view): Assume `org-agenda-search-view-max-outline-level' is a number. * ob-ruby.el (org-babel-ruby-nil-to): Fix custom type. * ob-python.el (org-babel-python-mode): Use :set to set the default value. (org-babel-python-None-to): Fix custom type. * ob-plantuml.el (org-plantuml-jar-path): Fix default value. (org-babel-execute:plantuml): Assume `org-plantuml-jar-path' is a string. * ob-latex.el (org-babel-latex-htlatex): Fix default value. (org-babel-latex-htlatex-packages): Fix custom type. (org-babel-execute:latex): Assume `org-babel-latex-htlatex' is a string. Thanks to Glenn Morris for reporting this. --- lisp/ob-latex.el | 6 +- lisp/ob-plantuml.el | 4 +- lisp/ob-python.el | 10 +-- lisp/ob-ruby.el | 4 +- lisp/org-agenda.el | 18 ++--- lisp/org.el | 36 +++++----- lisp/ox-ascii.el | 161 ++++++++++++++++++-------------------------- lisp/ox-html.el | 22 +++--- lisp/ox-latex.el | 24 +++---- lisp/ox-odt.el | 35 ++++------ lisp/ox-texinfo.el | 32 ++++----- lisp/ox.el | 3 +- 12 files changed, 156 insertions(+), 199 deletions(-) diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index edc9fe881..85918e60b 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -50,7 +50,7 @@ '((:results . "latex") (:exports . "results")) "Default arguments to use when evaluating a LaTeX source block.") -(defcustom org-babel-latex-htlatex nil +(defcustom org-babel-latex-htlatex "" "The htlatex command to enable conversion of latex to SVG or HTML." :group 'org-babel :type 'string) @@ -59,7 +59,7 @@ '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}") "Packages to use for htlatex export." :group 'org-babel - :type '(list string)) + :type '(list (string))) (defun org-babel-expand-body:latex (body params) "Expand BODY according to PARAMS, return the expanded body." @@ -141,7 +141,7 @@ This function is called by `org-babel-execute-src-block'." (delete-file transient-pdf-file)))))) ((and (or (string-match "\\.svg$" out-file) (string-match "\\.html$" out-file)) - org-babel-latex-htlatex) + (not (string= "" org-babel-latex-htlatex))) (with-temp-file tex-file (insert (concat "\\documentclass[preview]{standalone} diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index c17d4448a..f992d04da 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -40,7 +40,7 @@ '((:results . "file") (:exports . "results")) "Default arguments for evaluating a plantuml source block.") -(defcustom org-plantuml-jar-path nil +(defcustom org-plantuml-jar-path "" "Path to the plantuml.jar file." :group 'org-babel :version "24.1" @@ -55,7 +55,7 @@ This function is called by `org-babel-execute-src-block'." (cmdline (cdr (assoc :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) (java (or (cdr (assoc :java params)) "")) - (cmd (if (not org-plantuml-jar-path) + (cmd (if (string= "" org-plantuml-jar-path) (error "`org-plantuml-jar-path' is not set") (concat "java " java " -jar " (shell-quote-argument diff --git a/lisp/ob-python.el b/lisp/ob-python.el index b8f8a6daa..fc7b9e2d1 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -47,14 +47,16 @@ :group 'org-babel :type 'string) -(defcustom org-babel-python-mode - (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) +(defcustom org-babel-python-mode 'python "Preferred python mode for use in running python interactively. This will typically be either 'python or 'python-mode." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :type 'function) + :set (lambda (var val) + (set-default var (if (or (featurep 'xemacs) (featurep 'python-mode)) + 'python-mode 'python))) + :type 'symbol) (defvar org-src-preserve-indentation) @@ -70,7 +72,7 @@ This will typically be either 'python or 'python-mode." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :type 'string) + :type 'symbol) (defun org-babel-execute:python (body params) "Execute a block of Python code with Babel. diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index fe1ee0ff0..34b9eaf47 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -62,9 +62,7 @@ :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :type 'string) - - + :type 'symbol) (defun org-babel-execute:ruby (body params) "Execute a block of Ruby code with Babel. diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 3af1947bd..42b0f0cb1 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1419,13 +1419,14 @@ When nil, they may also match part of a word." :version "24.1" :type 'boolean) -(defcustom org-agenda-search-view-max-outline-level nil +(defcustom org-agenda-search-view-max-outline-level 0 "Maximum outline level to display in search view. E.g. when this is set to 1, the search view will only -show headlines of level 1." +show headlines of level 1. When set to 0, the default +value, don't limit agenda view by outline level." :group 'org-agenda-search-view :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "8.3") :type 'integer) (defgroup org-agenda-time-grid nil @@ -1746,10 +1747,9 @@ to capture the number of days." :version "24.4" :package-version '(Org . "8.0") :type '(list - (string :tag "Deadline today ") - (choice :tag "Deadline relative" - (string :tag "Format string") - (function)))) + (string :tag "Deadline today ") + (string :tag "Deadline in the future ") + (string :tag "Deadline in the past "))) (defcustom org-agenda-remove-times-when-in-prefix t "Non-nil means remove duplicate time specifications in agenda items. @@ -4583,7 +4583,7 @@ in `org-agenda-text-search-extra-files'." (goto-char (max (point-min) (1- (point)))) (while (re-search-forward regexp nil t) (org-back-to-heading t) - (while (and org-agenda-search-view-max-outline-level + (while (and (not (zerop org-agenda-search-view-max-outline-level)) (> (org-reduced-level (org-outline-level)) org-agenda-search-view-max-outline-level) (forward-line -1) @@ -4593,7 +4593,7 @@ in `org-agenda-text-search-extra-files'." beg1 (point) end (progn (outline-next-heading) - (while (and org-agenda-search-view-max-outline-level + (while (and (not (zerop org-agenda-search-view-max-outline-level)) (> (org-reduced-level (org-outline-level)) org-agenda-search-view-max-outline-level) (forward-line 1) diff --git a/lisp/org.el b/lisp/org.el index 8e23ec9f8..3f6af07e8 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1725,13 +1725,20 @@ In tables, the special behavior of RET has precedence." :group 'org-link-follow :type 'boolean) -(defcustom org-mouse-1-follows-link - (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) +(defcustom org-mouse-1-follows-link 450 "Non-nil means mouse-1 on a link will follow the link. A longer mouse click will still set point. Does not work on XEmacs. Needs to be set before org.el is loaded." :group 'org-link-follow - :type 'boolean) + :version "24.4" + :package-version '(Org . "8.3") + :set (lambda (var val) + (set-default var (if (boundp 'mouse-1-click-follows-link) + mouse-1-click-follows-link t))) + :type '(choice + (const :tag "A double click follows the link" 'double) + (const :tag "Unconditionally follow the link with mouse-1" t) + (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))) (defcustom org-mark-ring-length 4 "Number of different positions to be recorded in the ring. @@ -2663,12 +2670,12 @@ agenda log mode depends on the format of these entries." "Heading when changing todo state (todo sequence only)" state) string) (cons (const :tag "Heading when just taking a note" note) string) - (cons (const :tag "Heading when clocking out" clock-out) string) - (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) (cons (const :tag "Heading when rescheduling" reschedule) string) + (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) (cons (const :tag "Heading when changing deadline" redeadline) string) (cons (const :tag "Heading when deleting a deadline" deldeadline) string) - (cons (const :tag "Heading when refiling" refile) string))) + (cons (const :tag "Heading when refiling" refile) string) + (cons (const :tag "Heading when clocking out" clock-out) string))) (unless (assq 'note org-log-note-headings) (push '(note . "%t") org-log-note-headings)) @@ -8850,13 +8857,13 @@ If WITH-CASE is non-nil, the sorting will be case-sensitive." ;; command. There might be problems if any of the keys is otherwise ;; used as a prefix key. -(defcustom orgstruct-heading-prefix-regexp nil +(defcustom orgstruct-heading-prefix-regexp "" "Regexp that matches the custom prefix of Org headlines in orgstruct(++)-mode." :group 'org :version "24.4" - :package-version '(Org . "8.0") - :type 'string) + :package-version '(Org . "8.3") + :type 'regexp) ;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) (defcustom orgstruct-setup-hook nil @@ -9017,8 +9024,8 @@ buffer. It will also recognize item context in multiline items." "Create a function for binding in the structure minor mode. FUN is the command to call inside a table. KEY is the key that should be checked in for a command to execute outside of tables. -Non-nil DISABLE-WHEN-HEADING-PREFIX means to disable the command -if `orgstruct-heading-prefix-regexp' is non-nil." +Non-nil `disable-when-heading-prefix' means to disable the command +if `orgstruct-heading-prefix-regexp' is not empty." (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) (let ((nname name) (i 0)) @@ -9044,14 +9051,13 @@ if `orgstruct-heading-prefix-regexp' is non-nil." (key-description key) "'." (when disable-when-heading-prefix (concat - "\nIf `orgstruct-heading-prefix-regexp' is non-nil, this command will always fall\n" + "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" "back to the default binding due to limitations of Org's implementation of\n" "`" (symbol-name fun) "'."))) (interactive "p") (let* ((disable - ,(when disable-when-heading-prefix - '(and orgstruct-heading-prefix-regexp - (not (string= orgstruct-heading-prefix-regexp ""))))) + ,(and disable-when-heading-prefix + '(not (string= orgstruct-heading-prefix-regexp "")))) (fallback (or disable (not diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 430bc6e61..b2a38d55f 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -336,7 +336,8 @@ Otherwise, place it right after it." :package-version '(Org . "8.0") :type 'string) -(defcustom org-ascii-format-drawer-function nil +(defcustom org-ascii-format-drawer-function + (lambda (name contents width) contents) "Function called to format a drawer in ASCII. The function must accept three parameters: @@ -347,63 +348,32 @@ The function must accept three parameters: The function should return either the string to be exported or nil to ignore the drawer. -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-ascii-format-drawer-default (name contents width) - \"Format a drawer element for ASCII export.\" - contents)" +The default value simply returns the value of CONTENTS." :group 'org-export-ascii :version "24.4" :package-version '(Org . "8.0") :type 'function) -(defcustom org-ascii-format-inlinetask-function nil +(defcustom org-ascii-format-inlinetask-function + 'org-ascii-format-inlinetask-default "Function called to format an inlinetask in ASCII. -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. +The function must accept nine parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + WIDTH the width of the inlinetask, as a number. + INLINETASK the inlinetask itself. + INFO the info channel. The function should return either the string to be exported or -nil to ignore the inline task. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-ascii-format-inlinetask-default - \(todo type priority name tags contents\) - \"Format an inline task element for ASCII export.\" - \(let* \(\(utf8p \(eq \(plist-get info :ascii-charset\) 'utf-8\)\) - \(width org-ascii-inlinetask-width\) - \(org-ascii--indent-string - \(concat - ;; Top line, with an additional blank line if not in UTF-8. - \(make-string width \(if utf8p ?━ ?_\)\) \"\\n\" - \(unless utf8p \(concat \(make-string width ? \) \"\\n\"\)\) - ;; Add title. Fill it if wider than inlinetask. - \(let \(\(title \(org-ascii--build-title inlinetask info width\)\)\) - \(if \(<= \(length title\) width\) title - \(org-ascii--fill-string title width info\)\)\) - \"\\n\" - ;; If CONTENTS is not empty, insert it along with - ;; a separator. - \(when \(org-string-nw-p contents\) - \(concat \(make-string width \(if utf8p ?─ ?-\)\) \"\\n\" contents\)\) - ;; Bottom line. - \(make-string width \(if utf8p ?━ ?_\)\)\) - ;; Flush the inlinetask to the right. - \(- \(plist-get info :ascii-width\) - \(plist-get info :ascii-margin\) - \(plist-get info :ascii-inner-margin\) - \(org-ascii--current-text-width inlinetask info\)\)" +nil to ignore the inline task." :group 'org-export-ascii :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "8.3") :type 'function) @@ -1071,11 +1041,7 @@ CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((name (org-element-property :drawer-name drawer)) (width (org-ascii--current-text-width drawer info))) - (if (functionp org-ascii-format-drawer-function) - (funcall org-ascii-format-drawer-function name contents width) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) + (funcall org-ascii-format-drawer-function name contents width))) ;;;; Dynamic Block @@ -1228,55 +1194,58 @@ contextual information." ;;;; Inlinetask +(defun org-ascii-format-inlinetask-default + (todo type priority name tags contents width inlinetask info) + "Format an inline task element for ASCII export. +See `org-ascii-format-inlinetask-function' for a description +of the paramaters." + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (width (or width org-ascii-inlinetask-width))) + (org-ascii--indent-string + (concat + ;; Top line, with an additional blank line if not in UTF-8. + (make-string width (if utf8p ?━ ?_)) "\n" + (unless utf8p (concat (make-string width ? ) "\n")) + ;; Add title. Fill it if wider than inlinetask. + (let ((title (org-ascii--build-title inlinetask info width))) + (if (<= (length title) width) title + (org-ascii--fill-string title width info))) + "\n" + ;; If CONTENTS is not empty, insert it along with + ;; a separator. + (when (org-string-nw-p contents) + (concat (make-string width (if utf8p ?─ ?-)) "\n" contents)) + ;; Bottom line. + (make-string width (if utf8p ?━ ?_))) + ;; Flush the inlinetask to the right. + (- org-ascii-text-width org-ascii-global-margin + (if (not (org-export-get-parent-headline inlinetask)) 0 + org-ascii-inner-margin) + (org-ascii--current-text-width inlinetask info))))) + (defun org-ascii-inlinetask (inlinetask contents info) "Transcode an INLINETASK element from Org to ASCII. CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let ((width (org-ascii--current-text-width inlinetask info))) - ;; If `org-ascii-format-inlinetask-function' is provided, call it - ;; with appropriate arguments. - (if (functionp org-ascii-format-inlinetask-function) - (funcall org-ascii-format-inlinetask-function - ;; todo. - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property - :todo-keyword inlinetask))) - (and todo (org-export-data todo info)))) - ;; todo-type - (org-element-property :todo-type inlinetask) - ;; priority - (and (plist-get info :with-priority) - (org-element-property :priority inlinetask)) - ;; title - (org-export-data (org-element-property :title inlinetask) info) - ;; tags - (and (plist-get info :with-tags) - (org-element-property :tags inlinetask)) - ;; contents and width - contents width) - ;; Otherwise, use a default template. - (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (org-ascii--indent-string - (concat - ;; Top line, with an additional blank line if not in UTF-8. - (make-string width (if utf8p ?━ ?_)) "\n" - (unless utf8p (concat (make-string width ? ) "\n")) - ;; Add title. Fill it if wider than inlinetask. - (let ((title (org-ascii--build-title inlinetask info width))) - (if (<= (length title) width) title - (org-ascii--fill-string title width info))) - "\n" - ;; If CONTENTS is not empty, insert it along with - ;; a separator. - (when (org-string-nw-p contents) - (concat (make-string width (if utf8p ?─ ?-)) "\n" contents)) - ;; Bottom line. - (make-string width (if utf8p ?━ ?_))) - ;; Flush the inlinetask to the right. - (- org-ascii-text-width org-ascii-global-margin - (if (not (org-export-get-parent-headline inlinetask)) 0 - org-ascii-inner-margin) - (org-ascii--current-text-width inlinetask info))))))) + (funcall org-ascii-format-inlinetask-function + ;; todo. + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property + :todo-keyword inlinetask))) + (and todo (org-export-data todo info)))) + ;; todo-type + (org-element-property :todo-type inlinetask) + ;; priority + (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)) + ;; title + (org-export-data (org-element-property :title inlinetask) info) + ;; tags + (and (plist-get info :with-tags) + (org-element-property :tags inlinetask)) + ;; contents and width + contents width inlinetask info))) ;;;; Italic diff --git a/lisp/ox-html.el b/lisp/ox-html.el index fed8dcd42..524568083 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -567,7 +567,8 @@ Warning: non-nil may break indentation of source code blocks." ;;;; Drawers -(defcustom org-html-format-drawer-function nil +(defcustom org-html-format-drawer-function + (lambda (name contents) contents) "Function called to format a drawer in HTML code. The function must accept two parameters: @@ -579,9 +580,7 @@ The function should return the string to be exported. For example, the variable could be set to the following function in order to mimic default behaviour: -\(defun org-html-format-drawer-default \(name contents\) - \"Format a drawer element for HTML export.\" - contents\)" +The default value simply returns the value of CONTENTS." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") @@ -626,7 +625,7 @@ document title." :group 'org-export-html :type 'integer) -(defcustom org-html-format-headline-function nil +(defcustom org-html-format-headline-function 'ignore "Function to format headline text. This function will be called with 5 arguments: @@ -655,7 +654,7 @@ attributes, when appropriate." ;;;; Inlinetasks -(defcustom org-html-format-inlinetask-function nil +(defcustom org-html-format-inlinetask-function 'ignore "Function called to format an inlinetask in HTML code. The function must accept six parameters: @@ -674,7 +673,7 @@ The function should return the string to be exported." ;;;; LaTeX -(defcustom org-html-with-latex org-export-with-latex +(defcustom org-html-with-latex t "Non-nil means process LaTeX math snippets. When set, the exporter will process LaTeX environments and @@ -695,6 +694,7 @@ t Synonym for `mathjax'." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") + :set (lambda (var val) (set-default var org-export-with-latex)) :type '(choice (const :tag "Do not process math in any way" nil) (const :tag "Use dvipng to make images" dvipng) @@ -2009,7 +2009,7 @@ INFO is a plist used as a communication channel." #'number-to-string (org-export-get-headline-number headline info) "-")))) - (apply (if (functionp org-html-format-headline-function) + (apply (if (not (eq org-html-format-headline-function 'ignore)) (lambda (todo todo-type priority text tags &rest ignore) (funcall org-html-format-headline-function todo todo-type priority text tags)) @@ -2254,7 +2254,7 @@ holding contextual information." headline-number "-")))) (format-function (cond ((functionp format-function) format-function) - ((functionp org-html-format-headline-function) + ((not (eq org-html-format-headline-function 'ignore)) (lambda (todo todo-type priority text tags &rest ignore) (funcall org-html-format-headline-function todo todo-type priority text tags))) @@ -2381,9 +2381,9 @@ contextual information." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (cond - ;; If `org-html-format-inlinetask-function' is provided, call it + ;; If `org-html-format-inlinetask-function' is not 'ignore, call it ;; with appropriate arguments. - ((functionp org-html-format-inlinetask-function) + ((not (eq org-html-format-inlinetask-function 'ignore)) (let ((format-function (function* (lambda (todo todo-type priority text tags diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 4dc0fd073..014ed266a 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -556,7 +556,8 @@ returned as-is." ;;;; Drawers -(defcustom org-latex-format-drawer-function nil +(defcustom org-latex-format-drawer-function + (lambda (name contents) contents) "Function called to format a drawer in LaTeX code. The function must accept two parameters: @@ -565,19 +566,16 @@ The function must accept two parameters: The function should return the string to be exported. -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-latex-format-drawer-default \(name contents\) - \"Format a drawer element for LaTeX export.\" - contents\)" +The default function simply returns the value of CONTENTS." :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.3") :type 'function) ;;;; Inlinetasks -(defcustom org-latex-format-inlinetask-function nil +(defcustom org-latex-format-inlinetask-function 'ignore "Function called to format an inlinetask in LaTeX code. The function must accept six parameters: @@ -1212,12 +1210,8 @@ channel." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-latex-format-drawer-function) - (funcall org-latex-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) + (output (funcall org-latex-format-drawer-function + name contents))) (org-latex--wrap-label drawer output))) @@ -1502,7 +1496,7 @@ holding contextual information." (org-element-property :priority inlinetask)))) ;; If `org-latex-format-inlinetask-function' is provided, call it ;; with appropriate arguments. - (if (functionp org-latex-format-inlinetask-function) + (if (not (eq org-latex-format-inlinetask-function 'ignore)) (funcall org-latex-format-inlinetask-function todo todo-type priority title tags contents) ;; Otherwise, use a default template. diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 3e5be2292..6f63a6b9a 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -646,7 +646,8 @@ values. See Info node `(emacs) File Variables'." ;;;; Drawers -(defcustom org-odt-format-drawer-function nil +(defcustom org-odt-format-drawer-function + (lambda (name contents) contents) "Function called to format a drawer in ODT code. The function must accept two parameters: @@ -655,21 +656,16 @@ The function must accept two parameters: The function should return the string to be exported. -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-odt-format-drawer-default \(name contents\) - \"Format a drawer element for ODT export.\" - contents\)" +The default value simply returns the value of CONTENTS." :group 'org-export-odt :version "24.4" - :package-version '(Org . "8.0") + :package-version '(Org . "8.3") :type 'function) ;;;; Headline -(defcustom org-odt-format-headline-function nil +(defcustom org-odt-format-headline-function 'ignore "Function to format headline text. This function will be called with 5 arguments: @@ -688,7 +684,7 @@ The function result will be used as headline text." ;;;; Inlinetasks -(defcustom org-odt-format-inlinetask-function nil +(defcustom org-odt-format-inlinetask-function 'ignore "Function called to format an inlinetask in ODT code. The function must accept six parameters: @@ -708,7 +704,7 @@ The function should return the string to be exported." ;;;; LaTeX -(defcustom org-odt-with-latex org-export-with-latex +(defcustom org-odt-with-latex t "Non-nil means process LaTeX math snippets. When set, the exporter will process LaTeX environments and @@ -729,6 +725,7 @@ t Synonym for `mathjax'." :group 'org-export-odt :version "24.4" :package-version '(Org . "8.0") + :set (lambda (var val) (set-default var org-export-with-latex)) :type '(choice (const :tag "Do not process math in any way" nil) (const :tag "Use dvipng to make images" dvipng) @@ -1626,12 +1623,8 @@ channel." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-odt-format-drawer-function) - (funcall org-odt-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) + (output (funcall org-odt-format-drawer-function + name contents))) output)) @@ -1812,10 +1805,10 @@ INFO is a plist holding contextual information." headline-number "-"))) (format-function (cond ((functionp format-function) format-function) - ((functionp org-odt-format-headline-function) + ((not (eq org-odt-format-headline-function 'ignore)) (function* (lambda (todo todo-type priority text tags - &allow-other-keys) + &allow-other-keys) (funcall org-odt-format-headline-function todo todo-type priority text tags)))) (t 'org-odt-format-headline)))) @@ -1938,9 +1931,9 @@ contextual information." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (cond - ;; If `org-odt-format-inlinetask-function' is provided, call it + ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it ;; with appropriate arguments. - ((functionp org-odt-format-inlinetask-function) + ((not (eq org-odt-format-inlinetask-function 'ignore)) (let ((format-function (function* (lambda (todo todo-type priority text tags diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index dcc9b7907..0df660da2 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -143,7 +143,7 @@ ;;; Preamble -(defcustom org-texinfo-filename nil +(defcustom org-texinfo-filename "" "Default filename for Texinfo output." :group 'org-export-texinfo :type '(string :tag "Export Filename")) @@ -202,7 +202,7 @@ a format string in which the section title will be added." ;;; Headline -(defcustom org-texinfo-format-headline-function nil +(defcustom org-texinfo-format-headline-function 'ignore "Function to format headline text. This function will be called with 5 arguments: @@ -316,7 +316,8 @@ returned as-is." ;;; Drawers -(defcustom org-texinfo-format-drawer-function nil +(defcustom org-texinfo-format-drawer-function + (lambda (name contents) contents) "Function called to format a drawer in Texinfo code. The function must accept two parameters: @@ -325,18 +326,15 @@ The function must accept two parameters: The function should return the string to be exported. -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-texinfo-format-drawer-default \(name contents\) - \"Format a drawer element for Texinfo export.\" - contents\)" +The default function simply returns the value of CONTENTS." :group 'org-export-texinfo + :version "24.4" + :package-version '(Org . "8.3") :type 'function) ;;; Inlinetasks -(defcustom org-texinfo-format-inlinetask-function nil +(defcustom org-texinfo-format-inlinetask-function 'ignore "Function called to format an inlinetask in Texinfo code. The function must accept six parameters: @@ -882,12 +880,8 @@ contextual information." CONTENTS holds the contents of the block. INFO is a plist holding contextual information." (let* ((name (org-element-property :drawer-name drawer)) - (output (if (functionp org-texinfo-format-drawer-function) - (funcall org-texinfo-format-drawer-function - name contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents))) + (output (funcall org-texinfo-format-drawer-function + name contents))) output)) ;;; Dynamic Block @@ -1036,7 +1030,7 @@ holding contextual information." ;; Create the headline text along with a no-tag version. The ;; latter is required to remove tags from table of contents. (full-text (org-texinfo--sanitize-content - (if (functionp org-texinfo-format-headline-function) + (if (not (eq org-texinfo-format-headline-function 'ignore)) ;; User-defined formatting function. (funcall org-texinfo-format-headline-function todo todo-type priority text tags) @@ -1051,7 +1045,7 @@ holding contextual information." (mapconcat 'identity tags ":"))))))) (full-text-no-tag (org-texinfo--sanitize-content - (if (functionp org-texinfo-format-headline-function) + (if (not (eq org-texinfo-format-headline-function 'ignore)) ;; User-defined formatting function. (funcall org-texinfo-format-headline-function todo todo-type priority text nil) @@ -1153,7 +1147,7 @@ holding contextual information." (org-element-property :priority inlinetask)))) ;; If `org-texinfo-format-inlinetask-function' is provided, call it ;; with appropriate arguments. - (if (functionp org-texinfo-format-inlinetask-function) + (if (not (eq org-texinfo-format-inlinetask-function 'ignore)) (funcall org-texinfo-format-inlinetask-function todo todo-type priority title tags contents) ;; Otherwise, use a default template. diff --git a/lisp/ox.el b/lisp/ox.el index 69dca6854..d291b4f45 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -822,7 +822,7 @@ automatically. But you can retrieve them with \\[org-export-stack]." :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-export-async-init-file user-init-file +(defcustom org-export-async-init-file "~/.emacs.el" "File used to initialize external export process. Value must be an absolute file name. It defaults to user's initialization file. Though, a specific configuration makes the @@ -830,6 +830,7 @@ process faster and the export more portable." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") + :set (lambda (var val) (set-default var user-init-file)) :type '(file :must-match t)) (defcustom org-export-dispatch-use-expert-ui nil From e49d3b3d690790d5374ea54791a8d53f2e7eedc5 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Thu, 14 Nov 2013 14:13:46 +0100 Subject: [PATCH 101/166] ox-odt.el (org-odt-content-template-file): Fix version * ox-odt.el (org-odt-content-template-file): Fix version. --- lisp/ox-odt.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 6f63a6b9a..453ef5f0e 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -449,7 +449,7 @@ under `org-odt-styles-dir' is used." :type '(choice (const nil) (file)) :group 'org-export-odt - :version "24.1") + :version "24.3") (defcustom org-odt-styles-file nil "Default styles file for use with ODT export. From 6c585439cde17a40a8fe55a442ba12bf53ddca65 Mon Sep 17 00:00:00 2001 From: Daniil Frumin Date: Thu, 14 Nov 2013 19:26:53 +0400 Subject: [PATCH 102/166] Smart quote support for Russian language * ox.el (org-export-smart-quotes-alist): Added ("ru"). TINYCHANGE --- lisp/ox.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lisp/ox.el b/lisp/ox.el index 91571d108..99a345079 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -4969,6 +4969,18 @@ Return a list of src-block elements with a caption." (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") (apostrophe :utf-8 "’" :html "’")) + ("ru" + ;; http://ru.wikipedia.org/wiki/%D0%9A%D0%B0%D0%B2%D1%8B%D1%87%D0%BA%D0%B8#.D0.9A.D0.B0.D0.B2.D1.8B.D1.87.D0.BA.D0.B8.2C_.D0.B8.D1.81.D0.BF.D0.BE.D0.BB.D1.8C.D0.B7.D1.83.D0.B5.D0.BC.D1.8B.D0.B5_.D0.B2_.D1.80.D1.83.D1.81.D1.81.D0.BA.D0.BE.D0.BC_.D1.8F.D0.B7.D1.8B.D0.BA.D0.B5 + ;; http://www.artlebedev.ru/kovodstvo/sections/104/ + (opening-double-quote :utf-8 "«" :html "«" :latex "{}<<" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex ">>{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "„" :html "„" :latex "\\glqq{}" + :texinfo "@quotedblbase{}") + (closing-single-quote :utf-8 "“" :html "“" :latex "\\grqq{}" + :texinfo "@quotedblleft{}") + (apostrophe :utf-8 "’" :html: "'")) ("sv" ;; based on https://sv.wikipedia.org/wiki/Citattecken (opening-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") From 1c57866a6ca03cd6e68924ee4d838554904dd311 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Thu, 14 Nov 2013 21:21:27 +0100 Subject: [PATCH 103/166] test-ob: correct expected default header arguments MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * testing/lisp/test-ob.el: The default header arguments have added '(hlines . yes)´ in commit c67e3cda15, also add them to the test so that the two are consistent again. --- testing/lisp/test-ob.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index e7f06455b..2f6cf6d55 100644 --- a/testing/lisp/test-ob.el +++ b/testing/lisp/test-ob.el @@ -99,7 +99,10 @@ (ert-deftest test-org-babel/default-inline-header-args () (should(equal - '((:session . "none") (:results . "replace") (:exports . "results")) + '((:session . "none") + (:results . "replace") + (:exports . "results") + (:hlines . "yes")) org-babel-default-inline-header-args))) (ert-deftest ob-test/org-babel-combine-header-arg-lists () From 81815b7fb752c1551788e312d085bfa144312ae2 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Thu, 14 Nov 2013 21:21:50 +0100 Subject: [PATCH 104/166] ob-R: declare org-every MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-R.el: Declare `org-every´ before first use. --- lisp/ob-R.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index dfb94a3d6..d06b98248 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -37,6 +37,7 @@ (declare-function ess-eval-buffer "ext:ess-inf" (vis)) (declare-function org-number-sequence "org-compat" (from &optional to inc)) (declare-function org-remove-if-not "org" (predicate seq)) +(declare-function org-every "org" (pred seq)) (defconst org-babel-header-args:R '((width . :any) From 920e726758de7ef855d58704f36b5812d9d2ba51 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Thu, 14 Nov 2013 21:21:58 +0100 Subject: [PATCH 105/166] org.el: Fix a variable name error MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/org.el (org-version): Fix an error imported with merge in f95641c443, replace `_version´ by `version1´. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index bd7a593c6..802dc208c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -311,7 +311,7 @@ When MESSAGE is non-nil, display a message with the version." (if here (insert version) (message version)) - (if message (message _version)) + (if message (message version1)) version1))) (defconst org-version (org-version)) From 0e313e0405673a904cd8abad454e3f4af7282826 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Thu, 14 Nov 2013 21:22:14 +0100 Subject: [PATCH 106/166] ob-list, ob-ref: fix byte-compiler warnings MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/org-list.el: Declare dynamic variable `org-drawer-regexp´. * lisp/ob-ref.el: Declare functions `org-babel-lob-execute´ and `org-babel-lob-get-info´ and dynamic variable `org-babel-lob-one-liner-regexp´. --- lisp/ob-ref.el | 3 +++ lisp/org-list.el | 1 + 2 files changed, 4 insertions(+) diff --git a/lisp/ob-ref.el b/lisp/ob-ref.el index b8ee9f82b..ed480100a 100644 --- a/lisp/ob-ref.el +++ b/lisp/ob-ref.el @@ -63,6 +63,8 @@ (declare-function org-show-context "org" (&optional key)) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-babel-lob-execute "ob-lob" (info)) +(declare-function org-babel-lob-get-info "ob-lob" nil) (defvar org-babel-ref-split-regexp "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") @@ -122,6 +124,7 @@ the variable." (point)) (point-max)))) +(defvar org-babel-lob-one-liner-regexp) (defvar org-babel-library-of-babel) (defun org-babel-ref-resolve (ref) "Resolve the reference REF and return its value." diff --git a/lisp/org-list.el b/lisp/org-list.el index 3cb9b325e..78729af7c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -92,6 +92,7 @@ (defvar org-scheduled-string) (defvar org-ts-regexp) (defvar org-ts-regexp-both) +(defvar org-drawer-regexp) (declare-function outline-invisible-p "outline" (&optional pos)) (declare-function outline-flag-region "outline" (from to flag)) From 9bd85c04e6a76b98d43f1323def3d12c6074c7fe Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Thu, 14 Nov 2013 22:19:42 +0100 Subject: [PATCH 107/166] creation --- lisp/org-effectiveness.el | 228 +++++++++++++++++ lisp/org-license.el | 523 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 751 insertions(+) create mode 100644 lisp/org-effectiveness.el create mode 100644 lisp/org-license.el diff --git a/lisp/org-effectiveness.el b/lisp/org-effectiveness.el new file mode 100644 index 000000000..a276989b0 --- /dev/null +++ b/lisp/org-effectiveness.el @@ -0,0 +1,228 @@ +;;; org-effectiveness.el --- Measuring the personal effectiveness + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: David Arroyo Menéndez +;; Keywords: effectiveness, plot +;; Homepage: http://orgmode.org +;; +;; This file is not part of GNU Emacs, yet. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements functions to measure the effectiveness in org. +;; Org-mode doesn't load this module by default - if this is not what +;; you want, configure the variable `org-modules'. Thanks to #emacs-es +;; irc channel for your support. + +;;; Code: + +(require 'org) + +(defun org-effectiveness-count-keyword(keyword) + "Print a message with the number of keyword outline in the current buffer" + (interactive "sKeyword: ") + (save-excursion + (goto-char (point-min)) + (message "Number of %s: %d" keyword (count-matches (concat "* " keyword))))) + +(defun org-effectiveness-count-todo() + "Print a message with the number of todo tasks in the current buffer" + (interactive) + (save-excursion + (goto-char (point-min)) + (message "Number of TODO: %d" (count-matches "* TODO")))) + +(defun org-effectiveness-count-done() + "Print a message with the number of done tasks in the current buffer" + (interactive) + (save-excursion + (goto-char (point-min)) + (message "Number of DONE: %d" (count-matches "* DONE")))) + +(defun org-effectiveness-count-canceled() + "Print a message with the number of canceled tasks in the current buffer" + (interactive) + (save-excursion + (goto-char (point-min)) + (message "Number of Canceled: %d" (count-matches "* CANCELED")))) + +(defun org-effectiveness() + "Returns the effectiveness in the current org buffer" + (interactive) + (save-excursion + (goto-char (point-min)) + (let ((done (float (count-matches "* DONE.*\n.*"))) + (canc (float (count-matches "* CANCELED.*\n.*")))) + (if (and (= done canc) (zerop done)) + (setq effectiveness 0) + (setq effectiveness (* 100 (/ done (+ done canc))))) + (message "Effectiveness: %f" effectiveness)))) + +(defun org-keywords-in-date(keyword date) + (interactive "sKeyword: \nsDate: " keyword date) + (setq count (count-matches (concat keyword ".*\n.*" date))) + (message (concat "%sS: %d" keyword count))) + +(defun org-dones-in-date(date) + (interactive "sGive me a date: " date) + (setq count (count-matches (concat "DONE.*\n.*" date))) + (message "DONES: %d" count)) + +(defun org-todos-in-date(date) + (interactive "sGive me a date: " date) + (setq count (count-matches (concat "TODO.*\n.*" date))) + (message "TODOS: %d" count)) + +(defun org-canceled-in-date(date) + (interactive "sGive me a date: " date) + (setq count (count-matches (concat "TODO.*\n.*" date))) + (message "CANCELEDS: %d" count)) + +(defun org-effectiveness-in-date(date &optional notmessage) + (interactive "sGive me a date: " date) + (save-excursion + (goto-char (point-min)) + (let ((done (float (count-matches (concat "* DONE.*\n.*" date)))) + (canc (float (count-matches (concat "* CANCELED.*\n.*" date))))) + (if (and (= done canc) (zerop done)) + (setq effectiveness 0) + (setq effectiveness (* 100 (/ done (+ done canc))))) + (if (eq notmessage 1) + (message "%d" effectiveness) + (message "Effectiveness: %d " effectiveness))))) + +(defun org-effectiveness-month-to-string (m) + (if (< m 10) + (concat "0" (number-to-string m)) + (number-to-string m))) + +(defun org-effectiveness-plot(startdate enddate) + (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) + (setq dates (org-effectiveness-check-dates startdate enddate)) + (setq syear (cadr (assoc 'startyear dates))) + (setq smonth (cadr (assoc 'startmonth dates))) + (setq eyear (cadr (assoc 'endyear dates))) + (setq emonth (assoc 'endmonth dates)) +;; Checking the format of the dates + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate)) + (message "The start date must have the next format YYYY-MM")) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate)) + (message "The end date must have the next format YYYY-MM")) +;; Checking if startdate < enddate + (if (string-match "^[0-9][0-9][0-9][0-9]" startdate) + (setq startyear (string-to-number (match-string 0 startdate)))) + (if (string-match "[0-9][0-9]$" startdate) + (setq startmonth (string-to-number (match-string 0 startdate)))) + (if (string-match "^[0-9][0-9][0-9][0-9]" enddate) + (setq endyear (string-to-number (match-string 0 enddate)))) + (if (string-match "[0-9][0-9]$" enddate) + (setq endmonth (string-to-number (match-string 0 enddate)))) + (if (> startyear endyear) + (message "The start date must be before that end date")) + (if (and (= startyear endyear) (> startmonth endmonth)) + (message "The start date must be before that end date")) +;; Create a file + (let ((month startmonth) + (year startyear) + (str "")) + (while (and (>= endyear year) (>= endmonth month)) + (setq str (concat str (number-to-string year) "-" (org-effectiveness-month-to-string month) " " (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1) "\n")) + (if (= month 12) + (progn + (setq year (+ 1 year)) + (setq month 1)) + (setq month (+ 1 month)))) + (write-region str nil "/tmp/org-effectiveness")) +;; Create the bar graph + (if (file-exists-p "/usr/bin/gnuplot") + (call-process "/bin/bash" nil t nil "-c" "/usr/bin/gnuplot -e 'plot \"/tmp/org-effectiveness\" using 2:xticlabels(1) with histograms' -p") + (message "gnuplot is not installed"))) + +(defun org-effectiveness-ascii-bar(n &optional label) + "Print a bar with the percentage from 0 to 100 printed in ascii" + (interactive "nPercentage: \nsLabel: ") + (if (or (< n 0) (> n 100)) + (message "The percentage must be between 0 to 100") + (let ((x 0) + (y 0) + (z 0)) + (insert (format "\n### %s ###" label)) + (insert "\n-") + (while (< x n) + (insert "-") + (setq x (+ x 1))) + (insert "+\n") + (insert (format "%d" n)) + (if (> n 10) + (setq y (+ y 1))) + (while (< y n) + (insert " ") + (setq y (+ y 1))) + (insert "|\n") + (insert "-") + (while (< z n) + (insert "-") + (setq z (+ z 1))) + (insert "+")))) + +(defun org-effectiveness-check-dates (startdate enddate) + "Generate a list with ((startyear startmonth) (endyear endmonth))" + (setq str nil) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" startdate)) + (setq str "The start date must have the next format YYYY-MM")) + (if (not (string-match "[0-9][0-9][0-9][0-9]-[0-9][0-9]" enddate)) + (setq str "The end date must have the next format YYYY-MM")) +;; Checking if startdate < enddate + (if (string-match "^[0-9][0-9][0-9][0-9]" startdate) + (setq startyear (string-to-number (match-string 0 startdate)))) + (if (string-match "[0-9][0-9]$" startdate) + (setq startmonth (string-to-number (match-string 0 startdate)))) + (if (string-match "^[0-9][0-9][0-9][0-9]" enddate) + (setq endyear (string-to-number (match-string 0 enddate)))) + (if (string-match "[0-9][0-9]$" enddate) + (setq endmonth (string-to-number (match-string 0 enddate)))) + (if (> startyear endyear) + (setq str "The start date must be before that end date")) + (if (and (= startyear endyear) (> startmonth endmonth)) + (setq str "The start date must be before that end date")) + (if str + (message str) +;; (list (list startyear startmonth) (list endyear endmonth)))) + (list (list 'startyear startyear) (list 'startmonth startmonth) (list 'endyear endyear) (list 'endmonth endmonth)))) + +(defun org-effectiveness-plot-ascii (startdate enddate) + (interactive "sGive me the start date: \nsGive me the end date: " startdate enddate) + (setq dates (org-effectiveness-check-dates startdate enddate)) + (setq syear (cadr (assoc 'startyear dates))) + (setq smonth (cadr (assoc 'startmonth dates))) + (setq eyear (cadr (assoc 'endyear dates))) + (setq emonth (cadr (assoc 'endmonth dates))) +;; (switch-to-buffer "*org-effectiveness*") + (let ((month smonth) + (year syear) + (str "")) + (while (and (>= eyear year) (>= emonth month)) + (org-effectiveness-ascii-bar (string-to-number (org-effectiveness-in-date (concat (number-to-string year) "-" (org-effectiveness-month-to-string month)) 1)) (format "%s-%s" year month)) + (if (= month 12) + (progn + (setq year (+ 1 year)) + (setq month 1)) + (setq month (+ 1 month)))))) + +(provide 'org-effectiveness) + diff --git a/lisp/org-license.el b/lisp/org-license.el new file mode 100644 index 000000000..b452706ac --- /dev/null +++ b/lisp/org-license.el @@ -0,0 +1,523 @@ +;;; org-license.el --- Add a license to your org files + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: David Arroyo Menéndez +;; Keywords: licenses, creative commons +;; Homepage: http://orgmode.org +;; +;; This file is not part of GNU Emacs, yet. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements functions to add a license fast in org files. +;; Org-mode doesn't load this module by default - if this is not what +;; you want, configure the variable `org-modules'. Thanks to #emacs-es +;; irc channel for your support. + +;;; Code: + +;; +;; +;; You can download the images from http://www.davidam/img/licenses.tar.gz +;; +;; TODO: create a function to test all combinations of licenses + +(defvar org-license-images-directory "") + +(defun my-org-switch-language () +"Switch language if a `#+LANGUAGE:' Org meta-tag is on top 8 lines." +(save-excursion + (let (lang + (license-alist '(("br" . "brazilian") + ("ca" . "catalan") + ("de" . "deutsch") + ("en" . "american") + ("eo" . "esperanto") + ("eu" . "euskera") + ("es" . "spanish")))) + (when (re-search-backward "#\\+LANGUAGE: +\\([[:alpha:]_]*\\)" 1 t) + (setq lang (match-string 1)) +;; (message lang) + (ispell-change-dictionary (cdr (assoc lang dico-alist))))))) + +(add-hook 'org-mode-hook 'my-org-switch-language) + +(defun org-license-cc-by (language) + (interactive "MLanguage ( br | ca | de | en | es | eo | eu | fi | fr | gl | it | jp | nl | pt ): " language) + (cond ((equal language "br") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Brasil]]\n"))) + ((equal language "ca") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/es/deed.ca") + (insert (concat "* Licència +El text està disponible sota la [[" org-license-cc-url "][Reconeixement 3.0 Espanya]]\n"))) + ((equal language "de") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/de/deed.de") + (insert (concat "* Lizenz +Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Lizenz Creative Commons Namensnennung 3.0 Deutschland]]\n"))) + ((equal language "eo") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/eo/deed.eo") + (insert (concat "* Licenco +Ĉi tiu verko estas disponebla laŭ la permesilo [[" org-license-cc-url "][Krea Komunaĵo Atribuite 3.0 Neadaptita]]\n"))) + ((equal language "es") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/es/deed.es") + (insert (concat "* Licencia +Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución 3.0 España]]\n"))) + ((equal language "eu") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/es/deed.eu") + (insert (concat "* Licenzua +Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))) + ((equal language "fi") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/1.0/fi/deed.fi") + (insert (concat "* Lisenssi +Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]] lisenssillä\n"))) +;;Nimeä 1.0 Suomi + ((equal language "fr") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/fr/deed.fr") + (insert (concat "* Licence +Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution 3.0 France]]\n"))) + ((equal language "gl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/es/deed.gl") + (insert (concat "* Licenza +Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n"))) + ((equal language "it") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/it/deed.it") + (insert (concat "* Licenza +Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione 3.0 Italia]]\n"))) + ((equal language "jp") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/2.1/jp/deed.en") + (insert (concat "* ライセンス +この文書は [[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n"))) + ((equal language "nl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/nl/deed.nl") + (insert (concat "* Licentie +Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding 3.0 Nederland]]\n"))) + ((equal language "pt") + (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição 3.0 Portugal]]\n"))) + (t (concat (insert "* License +This document is under a [[" org-license-cc-url "][Creative Commons Attribution 3.0]]\n")))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by/3.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by/3.0/80x15.png]]\n")))) + +(defun org-license-cc-by-sa (language) + (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language) + (cond ((equal language "br") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-sa/3.0/br/deed.pt_BR") + (concat (insert "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n"))) + ((equal language "ca") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.ca") + (insert (concat "* Licència +El text està disponible sota la [[" org-license-cc-url "][Reconeixement-CompartirIgual 3.0 Espanya]]\n"))) + ((equal language "de") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/de/deed.de") + (insert (concat "* Lizenz +Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n"))) + ((equal language "es") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.es") + (concat (insert "* Licencia +Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución Compartir por Igual 3.0 España]]\n"))) + ((equal language "eu") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.eu") + (concat (insert "* Licenzua +Testua [[" org-license-cc-url "][Aitortu-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))) + ((equal language "fi") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi") + (insert (concat "* Lisenssi +Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n"))) + ((equal language "fr") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/fr/deed.fr") + (concat (insert "* Licence +Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Partage dans les Mêmes Conditions 3.0 France]]\n"))) + ((equal language "gl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.gl") + (insert (concat "* Licenza +Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n"))) + ((equal language "it") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/it/deed.it") + (insert (concat "* Licenza +Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Condividi allo stesso modo 3.0 Italia]]\n"))) + ((equal language "jp") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/2.1/jp/deed.en") + (insert (concat "* ライセンス +この文書は、[[" org-license-cc-url "][Creative Commons Attribution 2.1 ]] ライセンスの下である\n"))) + ((equal language "nl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/nl/deed.nl") + (insert (concat "* Licentie +Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding Gelijk Delen 3.0 Nederland]]\n"))) + ((equal language "pt") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição-CompartilhaIgual 3.0 Portugal]]\n"))) + (t + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/deed") + (insert (concat "* License +This document is under a [[" org-license-cc-url "][Creative Commons Attribution-ShareAlike Unported 3.0]]\n")))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-sa/3.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-sa/3.0/80x15.png]]\n")))) + +(defun org-license-cc-by-nd (language) + (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | pt ): " language) + (cond ((equal language "br") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-nd/3.0/br/deed.pt_BR") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Compartil ha Igual 3.0 Brasil]]\n"))) + ((equal language "ca") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.ca") + (insert (concat "* Licència +El text està disponible sota la [[" org-license-cc-url "][Reconeixement-SenseObraDerivada 3.0 Espanya]]\n"))) + ((equal language "de") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/de/deed.de") + (insert (concat "* Lizenz +Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Keine Bearbeitung 3.0 Deutschland]]\n"))) + ((equal language "es") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.es") + (insert (concat "* Licencia +Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Atribución-SinDerivadas 3.0]]\n"))) + ((equal language "eu") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/3.0/es/deed.eu") + (insert (concat "* Licenzua +Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))) + ((equal language "fi") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-sa/1.0/fi/deed.fi") + (insert (concat "* Lisenssi +Teksti on saatavilla [[" org-license-cc-url "][Nimeä-JaaSamoin 1.0 Suomi]] lisenssillä\n"))) + ((equal language "fr") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/fr/deed.fr") + (insert (concat "* Licence +Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n"))) + ((equal language "gl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/es/deed.gl") + (insert (concat "* Licenza +Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n"))) + ((equal language "it") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/it/deed.it") + (insert (concat "* Licenza +Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n"))) + ((equal language "jp") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/2.1/jp/deed.en") + (insert (concat "* ライセンス +この文書は、[[" org-license-cc-url "][Creative Commons No Derivatives 2.1]] ライセンスの下である\n"))) + ((equal language "nl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/nl/deed.nl") + (insert (concat "* Licentie +Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding GeenAfgeleideWerken 3.0 Nederland]]\n"))) + ((equal language "pt") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Sem Derivados 3.0 Portugal]]\n"))) + (t + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nd/3.0/deed") + (insert (concat "* License +This document is under a [[" org-license-cc-url "][Creative Commons No Derivatives Unported 3.0]]\n")))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nd/3.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nd/3.0/80x15.png]]\n")))) + + +(defun org-license-cc-by-nc (language) + (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | it | jp | nl | pt ): " language) + (cond ((equal language "br") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-nc/3.0/br/deed.pt_BR") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Brasil]]\n"))) + ((equal language "ca") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.ca") + (insert (concat "* Licència +El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n"))) + ((equal language "de") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/de/deed.de") + (insert (concat "* Lizenz +Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-Nicht-kommerziell 3.0 Deutschland]]\n"))) + ((equal language "es") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.es") + (insert (concat "* Licencia +Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n"))) + ((equal language "eu") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.eu") + (insert "* Licenzua +Testua [[" org-license-cc-url "][Aitortu-EzKomertziala 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")) + ((equal language "fi") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/1.0/fi/deed.fi") + (insert (concat "* Lisenssi +Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen 1.0 Suomi]] lisenssillä\n"))) + ((equal language "fr") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/fr/deed.fr") + (insert (concat "* Licence +Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d'Utilisation Commerciale 3.0 France]]\n"))) + ((equal language "gl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/es/deed.gl") + (insert (concat "* Licenza +Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n"))) + ((equal language "it") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/it/deed.it") + (insert (concat "* Licenza +Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non commerciale 3.0 Italia]]\n"))) + ((equal language "jp") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/2.1/jp/deed.en") + (insert (concat "* ライセンス +この文書は、[[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 2.1 ]] ライセンスの下である\n"))) + ((equal language "nl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/nl/deed.nl") + (insert (concat "* Licentie +Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel 3.0 Nederland 3.0 Nederland]]\n"))) + ((equal language "pt") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial 3.0 Portugal]]\n"))) + (t + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/deed") + (insert (concat "* License +This document is under a [[" org-license-cc-url "][Creative Commons Attribution-NonCommercial 3.0 Unported]]\n")))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc/3.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc/3.0/80x15.png]]\n")))) + +(defun org-license-cc-by-nc-sa (language) + (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | jp | nl | pt ): " language) + (cond ((equal language "br") + (setq org-license-cc-url "https://creativecommons.org/licenses/by-nc-sa/3.0/br/deed.pt_BR") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial - Compartil ha Igual 3.0 Brasil]]\n"))) + ((equal language "ca") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.ca") + (insert (concat "* Licència +El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial 3.0 Espanya]]\n"))) + ((equal language "de") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/de/deed.de") + (insert (concat "* Lizenz +Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung - Weitergabe unter gleichen Bedingungen 3.0 Deutschland]]\n"))) + ((equal language "es") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.es") + (insert (concat "* Licencia +Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial 3.0]]\n"))) + ((equal language "eu") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.eu") + (insert "* Licenzua +Testua [[" org-license-cc-url "][Aitortu-EzKomertziala-PartekatuBerdin 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n")) + ((equal language "fi") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/1.0/fi/deed.fi") + (insert (concat "* Lisenssi +Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Epäkaupallinen-JaaSamoin 1.0 Suomi]] lisenssillä\n"))) + ((equal language "fr") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/fr/deed.fr") + (insert (concat "* Licence +Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas d’Utilisation Commerciale - Partage dans les Mêmes Conditions 3.0 France]]\n"))) + ((equal language "gl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/es/deed.gl") + (insert (concat "* Licenza +Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n"))) + ((equal language "it") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/it/deed.it") + (insert (concat "* Licenza +Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n"))) + ((equal language "jp") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/2.1/jp/deed.en") + (insert (concat "* ライセンス +この文書は、[[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 2.1 ]] ライセンスの下である\n"))) + ((equal language "nl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/nl/deed.nl") + (insert (concat "* Licentie +Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GelijkDelen 3.0 Nederland]]\n"))) + ((equal language "pt") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição NãoComercial Compartil ha Igual 3.0 Portugal]]\n"))) + (t + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-sa/3.0/deed") + (insert (concat "* License +This document is under a [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial Share Alike 3.0 Unported]]\n")))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-sa/3.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-sa/3.0/80x15.png]]\n")))) + +(defun org-license-cc-by-nc-nd (language) + (interactive "MLanguage ( br | ca | de | en | es | eu | fi | fr | gl | it | pt ): " language) + (cond ((equal language "br") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Brasil]]\n"))) + ((equal language "ca") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.ca") + (insert (concat "* Licència +El text està disponible sota la [[" org-license-cc-url "][Reconeixement-NoComercial-SenseObraDerivada 3.0 Espanya]]\n"))) + ((equal language "de") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/de/deed.de") + (insert (concat "* Lizenz +Dieses Werk bzw. Inhalt steht unter einer [[" org-license-cc-url "][Namensnennung-NichtKommerziell-KeineBearbeitung 3.0 Deutschland]]\n"))) + ((equal language "es") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.es") + (insert (concat "* Licencia +Este documento está bajo una [[" org-license-cc-url "][Licencia Creative Commons Reconocimiento-NoComercial-SinObraDerivada 3.0]]\n"))) + ((equal language "eu") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.eu") + (insert (concat "* Licenzua +Testua [[" org-license-cc-url "][Aitortu-LanEratorririkGabe 3.0 Espainia]] lizentziari jarraituz erabil daiteke\n"))) + ((equal language "fi") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/1.0/fi/deed.fi") + (insert (concat "* Lisenssi +Teksti on saatavilla [[" org-license-cc-url "][Nimeä-Ei muutoksia-Epäkaupallinen 1.0 Suomi]] lisenssillä\n"))) + ((equal language "fr") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/fr/deed.fr") + (insert (concat "* Licence +Ce(tte) œuvre est mise à disposition selon les termes de la [[" org-license-cc-url "][Licence Creative Commons Attribution - Pas de Modification 3.0 France]]\n"))) + ((equal language "gl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/es/deed.gl") + (insert (concat "* Licenza +Todo o texto está dispoñible baixo a [[" org-license-cc-url "][licenza Creative Commons recoñecemento compartir igual 3.0]].\n"))) + ((equal language "it") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/it/deed.it") + (insert (concat "* Licenza +Quest'opera e distribuita con Licenza [[" org-license-cc-url "][Licenza Creative Commons Attribuzione - Non opere derivate 3.0 Italia]]\n"))) + ((equal language "jp") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/2.1/jp/deed.en") + (insert (concat "* ライセンス +この文書は [[" org-license-cc-url "][License Creative Commons Attribution Non Commercial - No Derivs 2.1]] ライセンスの下である\n"))) + ((equal language "nl") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/nl/deed.nl") + (insert (concat "* Licentie +Dit werk is valt onder een [[" org-license-cc-url "][Creative Commons Naamsvermelding NietCommercieel GeenAfgeleideWerken 3.0 Nederland]]\n"))) + ((equal language "pt") + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/pt/deed.pt") + (insert (concat "* Licença +Este texto é disponibilizado nos termos da licença [[" org-license-cc-url "][Atribuição Não Comercial Sem Derivados 3.0 Portugal]]\n"))) + (t + (setq org-license-cc-url "http://creativecommons.org/licenses/by-nc-nd/3.0/deed") + (insert (concat "* License +This document is under a [[" org-license-cc-url "][License Creative Commons +Reconocimiento-NoComercial-SinObraDerivada 3.0 Unported]]\n")))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-cc-url "][file:http://i.creativecommons.org/l/by-nc-nd/3.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-cc-url "][file:" org-license-images-directory "/by-nc-nd/3.0/80x15.png]]\n")))) + +(defun org-license-gfdl (language) + (interactive "MLanguage (es | en): " language) + (cond ((equal language "es") + (insert "* Licencia +Copyright (C) 2013 " user-full-name +"\n Se permite copiar, distribuir y/o modificar este documento + bajo los términos de la GNU Free Documentation License, Version 1.3 + o cualquier versión publicada por la Free Software Foundation; + sin Secciones Invariantes y sin Textos de Portada o Contraportada. + Una copia de la licencia está incluida en [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n")) + (t (insert (concat "* License +Copyright (C) 2013 " user-full-name +"\n Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. + A copy of the license is included in [[https://www.gnu.org/copyleft/fdl.html][GNU Free Documentation License]].\n")))) + (if (string= "" org-license-images-directory) + (insert "\n[[https://www.gnu.org/copyleft/fdl.html][file:https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/GFDL_Logo.svg/200px-GFDL_Logo.svg.png]]\n") + (insert (concat "\n[[https://www.gnu.org/copyleft/fdl.html][file:" org-license-images-directory "/gfdl/gfdl.png]]\n")))) + +(defun org-license-print-all () +"Print all combinations of licenses and languages, it's useful to find bugs" + (interactive) + (org-license-gfdl "es") + (org-license-gfdl "en") + (org-license-cc-by "br") + (org-license-cc-by "ca") + (org-license-cc-by "de") + (org-license-cc-by "es") + (org-license-cc-by "en") + (org-license-cc-by "eo") + (org-license-cc-by "eu") + (org-license-cc-by "fi") + (org-license-cc-by "fr") + (org-license-cc-by "gl") + (org-license-cc-by "it") + (org-license-cc-by "jp") + (org-license-cc-by "nl") + (org-license-cc-by "pt") + (org-license-cc-by-sa "br") + (org-license-cc-by-sa "ca") + (org-license-cc-by-sa "de") + (org-license-cc-by-sa "es") + (org-license-cc-by-sa "en") +;; (org-license-cc-by-sa "eo") + (org-license-cc-by-sa "eu") + (org-license-cc-by-sa "fi") + (org-license-cc-by-sa "fr") + (org-license-cc-by-sa "gl") + (org-license-cc-by-sa "it") + (org-license-cc-by-sa "jp") + (org-license-cc-by-sa "nl") + (org-license-cc-by-sa "pt") + (org-license-cc-by-nd "br") + (org-license-cc-by-nd "ca") + (org-license-cc-by-nd "de") + (org-license-cc-by-nd "es") + (org-license-cc-by-nd "en") +;; (org-license-cc-by-nd "eo") + (org-license-cc-by-nd "eu") + (org-license-cc-by-nd "fi") + (org-license-cc-by-nd "fr") + (org-license-cc-by-nd "gl") + (org-license-cc-by-nd "it") + (org-license-cc-by-nd "jp") + (org-license-cc-by-nd "nl") + (org-license-cc-by-nd "pt") + (org-license-cc-by-nc "br") + (org-license-cc-by-nc "ca") + (org-license-cc-by-nc "de") + (org-license-cc-by-nc "es") + (org-license-cc-by-nc "en") +;; (org-license-cc-by-nc "eo") + (org-license-cc-by-nc "eu") + (org-license-cc-by-nc "fi") + (org-license-cc-by-nc "fr") + (org-license-cc-by-nc "gl") + (org-license-cc-by-nc "it") + (org-license-cc-by-nc "jp") + (org-license-cc-by-nc "nl") + (org-license-cc-by-nc "pt") + (org-license-cc-by-nc-sa "br") + (org-license-cc-by-nc-sa "ca") + (org-license-cc-by-nc-sa "de") + (org-license-cc-by-nc-sa "es") + (org-license-cc-by-nc-sa "en") +;; (org-license-cc-by-nc-sa "eo") + (org-license-cc-by-nc-sa "eu") + (org-license-cc-by-nc-sa "fi") + (org-license-cc-by-nc-sa "fr") + (org-license-cc-by-nc-sa "gl") + (org-license-cc-by-nc-sa "it") + (org-license-cc-by-nc-sa "jp") + (org-license-cc-by-nc-sa "nl") + (org-license-cc-by-nc-sa "pt") + (org-license-cc-by-nc-nd "br") + (org-license-cc-by-nc-nd "ca") + (org-license-cc-by-nc-nd "de") + (org-license-cc-by-nc-nd "es") + (org-license-cc-by-nc-nd "en") +;; (org-license-cc-by-nc-nd "eo") + (org-license-cc-by-nc-nd "eu") + (org-license-cc-by-nc-nd "fi") + (org-license-cc-by-nc-nd "fr") + (org-license-cc-by-nc-nd "gl") + (org-license-cc-by-nc-nd "it") + (org-license-cc-by-nc-nd "jp") + (org-license-cc-by-nc-nd "nl") + (org-license-cc-by-nc-nd "pt") +) From 695391fc24527a9745e6aa096d3a0cb4a9683ab8 Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Thu, 14 Nov 2013 22:25:15 +0100 Subject: [PATCH 108/166] org-effectiveness and org-license must be in contrib/lisp --- {lisp => contrib/lisp}/org-effectiveness.el | 0 {lisp => contrib/lisp}/org-license.el | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename {lisp => contrib/lisp}/org-effectiveness.el (100%) rename {lisp => contrib/lisp}/org-license.el (100%) diff --git a/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el similarity index 100% rename from lisp/org-effectiveness.el rename to contrib/lisp/org-effectiveness.el diff --git a/lisp/org-license.el b/contrib/lisp/org-license.el similarity index 100% rename from lisp/org-license.el rename to contrib/lisp/org-license.el From 19dd1e1cc32afe10a8142c833fc8e9f12242bf38 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Thu, 14 Nov 2013 23:39:54 +0100 Subject: [PATCH 109/166] Fix commit 1eb03c8c87de9ccd0506ed90c4938240f5eb9fc2 Thanks to Michael Brand for reporting this. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 802dc208c..7f0d79ad2 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12858,7 +12858,7 @@ This function is run automatically after each state change to a DONE state." (org-log-done nil) (org-todo-log-states nil) re type n what ts time to-state) - (when (and repeat (not (zerop (string-to-number repeat)))) + (when (and repeat (not (zerop (string-to-number (substring repeat 1))))) (if (eq org-log-repeat t) (setq org-log-repeat 'state)) (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") org-todo-repeat-to-state)) From 22a061f575f9a58c2e0f7f72de3fa52679ddd61f Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 15 Nov 2013 06:22:36 +0100 Subject: [PATCH 110/166] Partially revert commit adcebf * ox.el (org-export-async-init-file): * ox-odt.el (org-odt-with-latex): * ox-html.el (org-html-with-latex): * org.el (org-return-follows-link): * ob-python.el (org-babel-python-command): Don't use :set. Thanks to Glenn Morris for pointing at this. --- lisp/ob-python.el | 6 ++---- lisp/org.el | 10 ++++------ lisp/ox-html.el | 3 +-- lisp/ox-odt.el | 3 +-- lisp/ox.el | 3 +-- 5 files changed, 9 insertions(+), 16 deletions(-) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index fc7b9e2d1..2f91b535f 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -47,15 +47,13 @@ :group 'org-babel :type 'string) -(defcustom org-babel-python-mode 'python +(defcustom org-babel-python-mode + (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) "Preferred python mode for use in running python interactively. This will typically be either 'python or 'python-mode." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :set (lambda (var val) - (set-default var (if (or (featurep 'xemacs) (featurep 'python-mode)) - 'python-mode 'python))) :type 'symbol) (defvar org-src-preserve-indentation) diff --git a/lisp/org.el b/lisp/org.el index 3f6af07e8..e7fdd19fa 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1725,17 +1725,15 @@ In tables, the special behavior of RET has precedence." :group 'org-link-follow :type 'boolean) -(defcustom org-mouse-1-follows-link 450 +(defcustom org-mouse-1-follows-link + (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) "Non-nil means mouse-1 on a link will follow the link. A longer mouse click will still set point. Does not work on XEmacs. Needs to be set before org.el is loaded." :group 'org-link-follow :version "24.4" :package-version '(Org . "8.3") - :set (lambda (var val) - (set-default var (if (boundp 'mouse-1-click-follows-link) - mouse-1-click-follows-link t))) - :type '(choice + :type '(choice (const :tag "A double click follows the link" 'double) (const :tag "Unconditionally follow the link with mouse-1" t) (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))) @@ -20407,7 +20405,7 @@ If `org-special-ctrl-o' is nil, just call `open-line' everywhere." (open-line n)) ((org-at-table-p) (org-table-insert-row)) - (t + (t (open-line n)))) (defun org-return (&optional indent) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 524568083..5f3879150 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -673,7 +673,7 @@ The function should return the string to be exported." ;;;; LaTeX -(defcustom org-html-with-latex t +(defcustom org-html-with-latex org-export-with-latex "Non-nil means process LaTeX math snippets. When set, the exporter will process LaTeX environments and @@ -694,7 +694,6 @@ t Synonym for `mathjax'." :group 'org-export-html :version "24.4" :package-version '(Org . "8.0") - :set (lambda (var val) (set-default var org-export-with-latex)) :type '(choice (const :tag "Do not process math in any way" nil) (const :tag "Use dvipng to make images" dvipng) diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 453ef5f0e..99c1353ce 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -704,7 +704,7 @@ The function should return the string to be exported." ;;;; LaTeX -(defcustom org-odt-with-latex t +(defcustom org-odt-with-latex org-export-with-latex "Non-nil means process LaTeX math snippets. When set, the exporter will process LaTeX environments and @@ -725,7 +725,6 @@ t Synonym for `mathjax'." :group 'org-export-odt :version "24.4" :package-version '(Org . "8.0") - :set (lambda (var val) (set-default var org-export-with-latex)) :type '(choice (const :tag "Do not process math in any way" nil) (const :tag "Use dvipng to make images" dvipng) diff --git a/lisp/ox.el b/lisp/ox.el index d291b4f45..69dca6854 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -822,7 +822,7 @@ automatically. But you can retrieve them with \\[org-export-stack]." :package-version '(Org . "8.0") :type 'boolean) -(defcustom org-export-async-init-file "~/.emacs.el" +(defcustom org-export-async-init-file user-init-file "File used to initialize external export process. Value must be an absolute file name. It defaults to user's initialization file. Though, a specific configuration makes the @@ -830,7 +830,6 @@ process faster and the export more portable." :group 'org-export-general :version "24.4" :package-version '(Org . "8.0") - :set (lambda (var val) (set-default var user-init-file)) :type '(file :must-match t)) (defcustom org-export-dispatch-use-expert-ui nil From bf012136bd8a89cc297ebaecfc70e2e3eba7ac8e Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 15 Nov 2013 06:53:59 +0100 Subject: [PATCH 111/166] Remove org-autoload. * org-macs.el (org-autoload): Delete. * org-docview.el ("docview"): Fix declarations and require doc-view directly. * org-id.el (org-id-copy) (org-id-get-with-outline-path-completion) (org-id-get-with-outline-drilling, org-id-new): * org-colview.el: (org-colview-initial-truncate-line-value) (org-columns-open-link, org-string-to-number): * org-clock.el: (org-clock-put-overlay, org-count-quarter, org-clock-loaded): * org-archive.el (org-get-local-archive-location): * org-agenda.el (org-agenda-todo-custom-ignore-p): Autoload. Those functions were autoloaded from within calls to `org-autoload' in org.el, we now autoload them from where they live. --- contrib/lisp/org-colview-xemacs.el | 4 ++++ lisp/org-agenda.el | 1 + lisp/org-archive.el | 1 + lisp/org-clock.el | 3 +++ lisp/org-colview.el | 5 +++++ lisp/org-docview.el | 8 +++---- lisp/org-id.el | 4 ++++ lisp/org-macs.el | 8 ------- lisp/org-table.el | 3 +++ lisp/org.el | 36 ++---------------------------- 10 files changed, 26 insertions(+), 47 deletions(-) diff --git a/contrib/lisp/org-colview-xemacs.el b/contrib/lisp/org-colview-xemacs.el index 63c02384b..f9b35d3a2 100644 --- a/contrib/lisp/org-colview-xemacs.el +++ b/contrib/lisp/org-colview-xemacs.el @@ -477,6 +477,7 @@ This is the compiled version of the format.") (defvar org-colview-initial-truncate-line-value nil "Remember the value of `truncate-lines' across colview.") +;;;###autoload (defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) @@ -820,6 +821,7 @@ around it." (let ((value (get-char-property (point) 'org-columns-value))) (org-open-link-from-string value arg))) +;;;###autoload (defun org-columns-get-format-and-top-level () (let (fmt) (when (condition-case nil (org-back-to-heading) (error nil)) @@ -1091,6 +1093,7 @@ Don't set this, this is meant for dynamic scoping.") (org-overlay-display ov (format fmt val)))))) org-columns-overlays)))) +;;;###autoload (defun org-columns-compute (property) "Sum the values of property PROPERTY hierarchically, for the entire buffer." (interactive) @@ -1187,6 +1190,7 @@ Don't set this, this is meant for dynamic scoping.") (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) sum))) +;;;###autoload (defun org-columns-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 42b0f0cb1..8bf122dbd 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5451,6 +5451,7 @@ This function is invoked if `org-agenda-todo-ignore-deadlines', (>= days n) (<= days n)))) +;;;###autoload (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item (&optional end) "Do we have a reason to ignore this TODO entry because it has a time stamp?" diff --git a/lisp/org-archive.el b/lisp/org-archive.el index d5bdff16f..3dc52c1c9 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -135,6 +135,7 @@ information." (match-string 1)) (t org-archive-location)))))) +;;;###autoload (defun org-add-archive-files (files) "Splice the archive files into the list of files. This implies visiting all these files and finding out what the diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 0b2037d07..2340ffc7c 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1871,6 +1871,7 @@ will be easy to remove." (overlay-put ov 'end-glyph (make-glyph tx))) (push ov org-clock-overlays))) +;;;###autoload (defun org-clock-remove-overlays (&optional beg end noremove) "Remove the occur highlights from the buffer. BEG and END are ignored. If NOREMOVE is nil, remove this function @@ -2143,6 +2144,7 @@ If you can combine both, the month starting day will have priority." ((= n 3) "3rd") ((= n 4) "4th"))) +;;;###autoload (defun org-clocktable-shift (dir n) "Try to shift the :block date of the clocktable at point. Point must be in the #+BEGIN: line of a clocktable, or this function @@ -2752,6 +2754,7 @@ This function is made for clock tables." (defvar org-clock-loaded nil "Was the clock file loaded?") +;;;###autoload (defun org-clock-update-time-maybe () "If this is a CLOCK line, update it and return t. Otherwise, return nil." diff --git a/lisp/org-colview.el b/lisp/org-colview.el index 523b42186..361560dcb 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -323,6 +323,7 @@ for the duration of the command.") (defvar org-colview-initial-truncate-line-value nil "Remember the value of `truncate-lines' across colview.") +;;;###autoload (defun org-columns-remove-overlays () "Remove all currently active column overlays." (interactive) @@ -670,6 +671,7 @@ around it." (let ((value (get-char-property (point) 'org-columns-value))) (org-open-link-from-string value arg))) +;;;###autoload (defun org-columns-get-format-and-top-level () (let ((fmt (org-columns-get-format))) (org-columns-goto-top-level) @@ -951,6 +953,8 @@ display, or in the #+COLUMNS line of the current buffer." (defvar org-inlinetask-min-level (if (featurep 'org-inlinetask) org-inlinetask-min-level 15)) + +;;;###autoload (defun org-columns-compute (property) "Sum the values of property PROPERTY hierarchically, for the entire buffer." (interactive) @@ -1054,6 +1058,7 @@ display, or in the #+COLUMNS line of the current buffer." (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) sum))) +;;;###autoload (defun org-columns-number-to-string (n fmt &optional printf) "Convert a computed column number to a string value, according to FMT." (cond diff --git a/lisp/org-docview.el b/lisp/org-docview.el index 72ccc46d6..8e61c8ab1 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -44,12 +44,10 @@ (require 'org) +(require 'doc-view) -(declare-function doc-view-goto-page "ext:doc-view" (page)) -(declare-function image-mode-window-get "ext:image-mode" - (prop &optional winprops)) - -(org-autoload "doc-view" '(doc-view-goto-page)) +(declare-function doc-view-goto-page "doc-view" (page)) +(declare-function image-mode-window-get "image-mode" (prop &optional winprops)) (org-add-link-type "docview" 'org-docview-open 'org-docview-export) (add-hook 'org-store-link-functions 'org-docview-store-link) diff --git a/lisp/org-id.el b/lisp/org-id.el index f1fa05bdc..37f6e70e8 100644 --- a/lisp/org-id.el +++ b/lisp/org-id.el @@ -233,6 +233,7 @@ With optional argument FORCE, force the creation of a new ID." (org-entry-put (point) "ID" nil)) (org-id-get (point) 'create)) +;;;###autoload (defun org-id-copy () "Copy the ID of the entry at point to the kill ring. Create an ID if necessary." @@ -258,6 +259,7 @@ In any case, the ID of the entry is returned." (org-id-add-location id (buffer-file-name (buffer-base-buffer))) id))))) +;;;###autoload (defun org-id-get-with-outline-path-completion (&optional targets) "Use `outline-path-completion' to retrieve the ID of an entry. TARGETS may be a setting for `org-refile-targets' to define @@ -274,6 +276,7 @@ If necessary, the ID is created." (prog1 (org-id-get pom 'create) (move-marker pom nil)))) +;;;###autoload (defun org-id-get-with-outline-drilling (&optional targets) "Use an outline-cycling interface to retrieve the ID of an entry. This only finds entries in the current buffer, using `org-get-location'. @@ -320,6 +323,7 @@ With optional argument MARKERP, return the position as a new marker." ;; Creating new IDs +;;;###autoload (defun org-id-new (&optional prefix) "Create a new globally unique ID. diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 0083d293e..4afbace56 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -283,14 +283,6 @@ we turn off invisibility temporarily. Use this in a `let' form." (<= (match-beginning n) pos) (>= (match-end n) pos))) -(defun org-autoload (file functions) - "Establish autoload for all FUNCTIONS in FILE, if not bound already." - (let ((d (format "Documentation will be available after `%s.el' is loaded." - file)) - f) - (while (setq f (pop functions)) - (or (fboundp f) (autoload f file d t))))) - (defun org-match-line (re) "Looking-at at the beginning of the current line." (save-excursion diff --git a/lisp/org-table.el b/lisp/org-table.el index 246cf8d60..c191345e5 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -915,6 +915,7 @@ When nil, simply write \"#ERROR\" in corrupted fields.") (setq org-table-may-need-update nil) )) +;;;###autoload (defun org-table-begin (&optional table-type) "Find the beginning of the table and return its position. With argument TABLE-TYPE, go to the beginning of a table.el-type table." @@ -928,6 +929,7 @@ With argument TABLE-TYPE, go to the beginning of a table.el-type table." (beginning-of-line 2) (point)))) +;;;###autoload (defun org-table-end (&optional table-type) "Find the end of the table and return its position. With argument TABLE-TYPE, go to the end of a table.el-type table." @@ -1199,6 +1201,7 @@ Return t when the line exists, nil if it does not exist." (< (setq cnt (1+ cnt)) N))) (= cnt N))) +;;;###autoload (defun org-table-blank-field () "Blank the current table field or active region." (interactive) diff --git a/lisp/org.el b/lisp/org.el index e7fdd19fa..4c85b995e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4247,12 +4247,6 @@ Normal means, no org-mode-specific context." "Detect the first line outside a table when searching from within it. This works for both table types.") -;; Autoload the functions in org-table.el that are needed by functions here. - -(eval-and-compile - (org-autoload "org-table" - '(org-table-begin org-table-blank-field org-table-end))) - (defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " "Detect a #+TBLFM line.") @@ -4333,12 +4327,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." (re-search-forward org-table-any-border-regexp nil 1)))) (unless quietly (message "Mapping tables: done"))) -;; Declare and autoload functions from org-agenda.el - -(eval-and-compile - (org-autoload "org-agenda" - '(org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item))) - (declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) (declare-function org-clock-update-mode-line "org-clock" ()) (declare-function org-resolve-clocks "org-clock" @@ -4364,11 +4352,6 @@ If TABLE-TYPE is non-nil, also check for table.el-type tables." Return nil if no clock is running." (marker-buffer org-clock-marker)) -(eval-and-compile - (org-autoload "org-clock" '(org-clock-remove-overlays - org-clock-update-time-maybe - org-clocktable-shift))) - (defun org-check-running-clock () "Check if the current buffer contains the running clock. If yes, offer to stop it and to save the buffer with the changes." @@ -4568,33 +4551,18 @@ Otherwise, these types are allowed: (defalias 'org-advertized-archive-subtree 'org-archive-subtree) -(eval-and-compile - (org-autoload "org-archive" - '(org-add-archive-files))) - -;; Autoload Column View Code +;; Declare Column View Code (declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) (declare-function org-columns-get-format-and-top-level "org-colview" ()) (declare-function org-columns-compute "org-colview" (property)) -(org-autoload (if (featurep 'xemacs) "org-colview-xemacs" "org-colview") - '(org-columns-number-to-string - org-columns-get-format-and-top-level - org-columns-compute - org-columns-remove-overlays)) - -;; Autoload ID code +;; Declare ID code (declare-function org-id-store-link "org-id") (declare-function org-id-locations-load "org-id") (declare-function org-id-locations-save "org-id") (defvar org-id-track-globally) -(org-autoload "org-id" - '(org-id-new - org-id-copy - org-id-get-with-outline-path-completion - org-id-get-with-outline-drilling)) ;;; Variables for pre-computed regular expressions, all buffer local From 97e99614d83828858d9e620231567d045a80f398 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Thu, 14 Nov 2013 21:21:58 +0100 Subject: [PATCH 112/166] org.el: Fix a variable name error MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/org.el (org-version): Fix an error imported with merge in f95641c443, replace `_version´ by `version1´. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 4c85b995e..8c0fe3547 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -309,7 +309,7 @@ When MESSAGE is non-nil, display a message with the version." (if here (insert version) (message version)) - (if message (message _version)) + (if message (message version1)) version1))) (defconst org-version (org-version)) From 0a6b6bf73514196b3c445116302195e374688dbd Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 15 Nov 2013 10:08:25 +0100 Subject: [PATCH 113/166] Enhance docstrings * ox.el (org-export-with-sub-superscripts): * org.el (org-use-sub-superscripts): Enhance docstrings. Thansk to Dieter and Nick for raising this. --- lisp/org.el | 24 ++++++++++++++---------- lisp/ox.el | 28 ++++++++++++++++------------ 2 files changed, 30 insertions(+), 22 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 8c0fe3547..50d44c39d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -654,11 +654,15 @@ the following lines anywhere in the buffer: (defcustom org-use-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for display. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. + +If you want to control how Org exports those characters, +see `org-export-with-sub-superscripts'. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts within the buffer. Several characters after +\"_\" or \"^\" will be considered as a single item - so grouping +with {} is normally not needed. For example, the following things +will be parsed as single sub- or superscripts: 10^24 or 10^tau several digits will be considered 1 item. 10^-12 or 10^-tau a leading sign with digits or a word @@ -666,11 +670,11 @@ sub- or superscripts. terminated by almost any nonword/nondigit char. x_{i^2} or x^(2-i) braces or parenthesis do grouping. -Still, ambiguity is possible - so when in doubt use {} to enclose -the sub/superscript. If you set this variable to the symbol -`{}', the braces are *required* in order to trigger -interpretations as sub/superscript. This can be helpful in -documents that need \"_\" frequently in plain text." +Still, ambiguity is possible. So when in doubt, use {} to enclose +the sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text." :group 'org-startup :version "24.1" :type '(choice diff --git a/lisp/ox.el b/lisp/ox.el index 69dca6854..22fe8f99f 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -626,11 +626,18 @@ e.g. \"stat:nil\"" (defcustom org-export-with-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for export. +If you want to control how Org displays those characters, +see `org-use-sub-superscripts'. + When this option is turned on, you can use TeX-like syntax for -sub- and superscripts. Several characters after \"_\" or \"^\" -will be considered as a single item - so grouping with {} is -normally not needed. For example, the following things will be -parsed as single sub- or superscripts. +sub- and superscripts and see them exported correctly. + +You can also set the option with #+OPTIONS: ^:t + +Several characters after \"_\" or \"^\" will be considered as a +single item - so grouping with {} is normally not needed. For +example, the following things will be parsed as single sub- or +superscripts: 10^24 or 10^tau several digits will be considered 1 item. 10^-12 or 10^-tau a leading sign with digits or a word @@ -638,14 +645,11 @@ parsed as single sub- or superscripts. terminated by almost any nonword/nondigit char. x_{i^2} or x^(2-i) braces or parenthesis do grouping. -Still, ambiguity is possible - so when in doubt use {} to enclose -the sub/superscript. If you set this variable to the symbol -`{}', the braces are *required* in order to trigger -interpretations as sub/superscript. This can be helpful in -documents that need \"_\" frequently in plain text. - -This option can also be set with the OPTIONS keyword, -e.g. \"^:nil\"." +Still, ambiguity is possible. So when in doubt, use {} to enclose +the sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text." :group 'org-export-general :type '(choice (const :tag "Interpret them" t) From 77710ec2628a0c8b0a2be05ca51c57bcb0649e04 Mon Sep 17 00:00:00 2001 From: Michael Brand Date: Fri, 15 Nov 2013 19:20:25 +0100 Subject: [PATCH 114/166] Babel: add comments to ERT for reading properties * testing/examples/babel.org (use case of reading entry properties): Add comments to function definitions. --- testing/examples/babel.org | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/testing/examples/babel.org b/testing/examples/babel.org index b1f170242..449824fc2 100644 --- a/testing/examples/babel.org +++ b/testing/examples/babel.org @@ -413,6 +413,9 @@ Note: Just export of a property can be done with a macro: {{{property(a)}}}. **** function definition +comments for ":var": +- The "or" is to deal with a property not present. +- The t is to get property inheritance. #+NAME: src_block_location_shell #+HEADER: :var a=(or (org-entry-get org-babel-current-src-block-location "a" t) "0") #+HEADER: :var b=(or (org-entry-get org-babel-current-src-block-location "b" t) "0") @@ -433,6 +436,11 @@ Note: Just export of a property can be done with a macro: {{{property(a)}}}. #+HEADER: :var e='nil #+BEGIN_SRC emacs-lisp :exports results (setq + ;; - The first `or' together with ":var ='nil" is to check for + ;; a value bound from an optional call argument, in the examples + ;; here: c=5, e=6 + ;; - The second `or' is to deal with a property not present + ;; - The t is to get property inheritance a (or a (string-to-number (or (org-entry-get org-babel-current-src-block-location "a" t) "0"))) From 54a64f50b5297fb895c06a33e064ccf7b51400bb Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Fri, 15 Nov 2013 20:18:58 +0100 Subject: [PATCH 115/166] ob-C, ob-clojure, ob-tangle, org-agenda, org, ox: fix byte-compiler warnings MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/ob-C.el, lisp/ob-clojure.e: Require 'cl at compile-time. * lisp/ob-tangle.el: Do not require 'cl at compile time. * lisp/org-agenda.el: Declare function `org-columns-remove-overlays´. * lisp/org.el: Declare functions `org-clocktable-shift´, `org-clock-update-time-maybe´, `org-clock-remove-overlays´, `org-babel-tangle-file´, `org-table-blank-field´, `org-table-insert-row´, `org-add-archive-files´, `org-table-begin´, `org-table-end´. Move defsubst `org-uniquify´ before its many uses. * lisp/ox.el: Move defsubst `org-export-get-parent´ before its many uses. --- lisp/ob-C.el | 2 ++ lisp/ob-clojure.el | 2 ++ lisp/ob-tangle.el | 2 -- lisp/org-agenda.el | 1 + lisp/org.el | 17 +++++++++++++---- lisp/ox.el | 10 +++++----- 6 files changed, 23 insertions(+), 11 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index ecc08c882..bac292017 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -32,6 +32,8 @@ ;;; Code: (require 'ob) (require 'cc-mode) +(eval-when-compile + (require 'cl)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index d797a3f76..e18fa7695 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -45,6 +45,8 @@ ;;; Code: (require 'ob) +(eval-when-compile + (require 'cl)) (declare-function cider-current-ns "ext:cider-interaction" ()) (declare-function nrepl-send-string-sync "ext:nrepl-client" (input &optional ns session)) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 808f12b26..7b06c39ff 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -27,8 +27,6 @@ ;;; Code: (require 'org-src) -(eval-when-compile - (require 'cl)) (declare-function org-edit-special "org" (&optional arg)) (declare-function org-link-escape "org" (text &optional table)) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index fc17005bc..1936df1cd 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -69,6 +69,7 @@ (declare-function calendar-persian-date-string "cal-persia" (&optional date)) (declare-function calendar-check-holidays "holidays" (date)) +(declare-function org-columns-remove-overlays "org-colview" ()) (declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) (declare-function org-columns-quit "org-colview" ()) diff --git a/lisp/org.el b/lisp/org.el index f03eb809f..a3c19589d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -115,24 +115,33 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) (declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-clocktable-shift "org-clock" (dir n)) (declare-function org-clock-get-last-clock-out-time "org-clock" ()) +(declare-function org-clock-update-time-maybe "org-clock" ()) +(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove)) (declare-function org-clock-timestamps-up "org-clock" (&optional n)) (declare-function org-clock-timestamps-down "org-clock" (&optional n)) (declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) +(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) (declare-function orgtbl-mode "org-table" (&optional arg)) (declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) (declare-function org-beamer-mode "ox-beamer" ()) +(declare-function org-table-blank-field "org-table" ()) (declare-function org-table-edit-field "org-table" (arg)) +(declare-function org-table-insert-row "org-table" (&optional arg)) (declare-function org-table-justify-field-maybe "org-table" (&optional new)) (declare-function org-table-set-constants "org-table" ()) (declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) (declare-function org-id-get-create "org-id" (&optional force)) +(declare-function org-add-archive-files "org-archive" (files)) (declare-function org-id-find-id-file "org-id" (id)) (declare-function org-tags-view "org-agenda" (&optional todo-only match)) (declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) (declare-function org-agenda-redo "org-agenda" (&optional all)) (declare-function org-table-align "org-table" ()) +(declare-function org-table-begin "org-table" (&optional table-type)) +(declare-function org-table-end "org-table" (&optional table-type)) (declare-function org-table-paste-rectangle "org-table" ()) (declare-function org-table-maybe-eval-formula "org-table" ()) (declare-function org-table-maybe-recalculate-line "org-table" ()) @@ -161,6 +170,10 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-element-restriction "org-element" (element)) (declare-function org-element-type "org-element" (element)) +(defsubst org-uniquify (list) + "Non-destructively remove duplicate elements from LIST." + (let ((res (copy-sequence list))) (delete-dups res))) + ;; load languages based on value of `org-babel-load-languages' (defvar org-babel-load-languages) @@ -21782,10 +21795,6 @@ for the search purpose." "Return the reverse of STRING." (apply 'string (reverse (string-to-list string)))) -(defsubst org-uniquify (list) - "Non-destructively remove duplicate elements from LIST." - (let ((res (copy-sequence list))) (delete-dups res))) - (defun org-uniquify-alist (alist) "Merge elements of ALIST with the same key. diff --git a/lisp/ox.el b/lisp/ox.el index 99a345079..93f9da292 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -90,6 +90,11 @@ (defvar org-table-number-regexp) +(defsubst org-export-get-parent (blob) + "Return BLOB parent or nil. +BLOB is the element or object considered." + (org-element-property :parent blob)) + ;;; Internal Variables ;; @@ -5156,11 +5161,6 @@ Return the new string." ;; `org-export-get-genealogy' returns the full genealogy of a given ;; element or object, from closest parent to full parse tree. -(defsubst org-export-get-parent (blob) - "Return BLOB parent or nil. -BLOB is the element or object considered." - (org-element-property :parent blob)) - (defun org-export-get-genealogy (blob) "Return full genealogy relative to a given element or object. From 91c1718519b316bd932f99ca999e779b3a1cc145 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 15 Nov 2013 23:07:48 +0100 Subject: [PATCH 116/166] org-element: Fix cache corruption when moving list * lisp/org-element.el (org-element--shift-positions): Fix cache corruption when moving list. --- lisp/org-element.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 5e252ea76..3dd162c3c 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4819,12 +4819,12 @@ modified by side-effect. Return modified element." ;; Shift :structure property for the first plain list only: it is ;; the only one that really matters and it prevents from shifting ;; it more than once. - (when (eq (car element) 'plain-list) - (let ((structure (plist-get properties :structure))) - (when (<= (plist-get properties :begin) (caar structure)) - (dolist (item structure) - (incf (car item) offset) - (incf (nth 6 item) offset))))) + (when (and (eq (org-element-type element) 'plain-list) + (not (eq (org-element-type (plist-get properties :parent)) + 'item))) + (dolist (item (plist-get properties :structure)) + (incf (car item) offset) + (incf (nth 6 item) offset))) (plist-put properties :begin (+ (plist-get properties :begin) offset)) (plist-put properties :end (+ (plist-get properties :end) offset)) (dolist (key '(:contents-begin :contents-end :post-affiliated)) From 73d60606bd397e2d4a1eb19c624bec4af8c2fa0c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 15 Nov 2013 23:46:45 +0100 Subject: [PATCH 117/166] org-element: Fix cache bug * lisp/org-element.el (org-element--cache-sync): Properly remove from cache last element in a plain list when blank lines at the end of that list are modified. --- lisp/org-element.el | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 3dd162c3c..f6b970037 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -5038,22 +5038,21 @@ removed from the cache." ;; Preserve any element ending before BEG. If it ;; overlaps the BEG-END area, remove it. (t - (when (let ((element (car value))) - (or (>= (org-element-property :end element) beg) - ;; Special case: footnote definitions and - ;; plain lists can end with blank lines. - ;; Modifying those can also alter last - ;; element inside. We must therefore - ;; remove these elements from cache. - (let ((parent - (org-element-property :parent element))) - (and (memq (org-element-type parent) - '(footnote-definition plain-list)) - (>= (org-element-property :end parent) beg) - (= (org-element-property :contents-end - parent) - (org-element-property :end element)))))) - (remhash key org-element--cache))))) + (let ((element (car value))) + (if (>= (org-element-property :end element) beg) + (remhash key org-element--cache) + ;; Special case: footnote definitions and plain + ;; lists can end with blank lines. Modifying + ;; those can also alter last element inside. We + ;; must therefore remove them from cache. + (let ((parent (org-element-property :parent element))) + (when (and parent (eq (org-element-type parent) 'item)) + (setq parent (org-element-property :parent parent))) + (when (and parent + (>= (org-element-property :end parent) beg) + (= (org-element-property :contents-end parent) + (org-element-property :end element))) + (remhash key org-element--cache)))))))) org-element--cache) ;; Signal cache as up-to-date. (org-element--cache-cancel-changes)))))) From 38a2bd37835924b888075c2aabd61bcc9522184e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 16 Nov 2013 00:20:13 +0100 Subject: [PATCH 118/166] ox-org: Improve keyword handling * lisp/ox-org.el (org-org-template): New function. (org-org-keyword): Handle document keywords specially. --- lisp/ox-org.el | 66 ++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 56 insertions(+), 10 deletions(-) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index cecad5632..8601f8b34 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -87,6 +87,7 @@ setting of `org-html-htmlize-output-type' is 'css." (line-break . org-org-identity) (link . org-org-identity) (node-property . org-org-identity) + (template . org-org-template) (paragraph . org-org-identity) (plain-list . org-org-identity) (planning . org-org-identity) @@ -140,16 +141,54 @@ CONTENTS is its contents, as a string or nil. INFO is ignored." "Transcode KEYWORD element back into Org syntax. CONTENTS is nil. INFO is ignored. This function ignores keywords targeted at other export back-ends." - (unless (member (org-element-property :key keyword) - (mapcar - (lambda (block-cons) - (and (eq (cdr block-cons) 'org-element-export-block-parser) - (car block-cons))) - org-element-block-name-alist)) - (org-element-keyword-interpreter keyword nil))) + (let ((key (org-element-property :key keyword))) + (unless (or (member key + (mapcar + (lambda (block-cons) + (and (eq (cdr block-cons) + 'org-element-export-block-parser) + (car block-cons))) + org-element-block-name-alist)) + (member key + '("AUTHOR" "CREATOR" "DATE" "DESCRIPTION" "EMAIL" + "KEYWORDS" "TITLE"))) + (org-element-keyword-interpreter keyword nil)))) + +(defun org-org-template (contents info) + "Return Org document template with document keywords. +CONTENTS is the transcoded contents string. INFO is a plist used +as a communication channel." + (concat + (and (plist-get info :time-stamp-file) + (format-time-string "# Created %Y-%m-%d %a %H:%M\n")) + (format "#+TITLE: %s\n" (org-export-data (plist-get info :title) info)) + (and (plist-get info :with-date) + (let ((date (org-export-data (org-export-get-date info) info))) + (and (org-string-nw-p date) + (format "#+DATE: %s\n" date)))) + (and (plist-get info :with-author) + (let ((author (org-export-data (plist-get info :author) info))) + (and (org-string-nw-p author) + (format "#+AUTHOR: %s\n" author)))) + (and (plist-get info :with-email) + (let ((email (org-export-data (plist-get info :email) info))) + (and (org-string-nw-p email) + (format "#+EMAIL: %s\n" email)))) + (and (eq (plist-get info :with-creator) t) + (org-string-nw-p (plist-get info :creator)) + (format "#+CREATOR: %s\n" (plist-get info :creator))) + (and (org-string-nw-p (plist-get info :keywords)) + (format "#+KEYWORDS: %s\n" (plist-get info :keywords))) + (and (org-string-nw-p (plist-get info :description)) + (format "#+DESCRIPTION: %s\n" (plist-get info :description))) + contents + (and (eq (plist-get info :with-creator) 'comment) + (org-string-nw-p (plist-get info :creator)) + (format "\n# %s\n" (plist-get info :creator))))) ;;;###autoload -(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist) +(defun org-org-export-as-org + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to an Org buffer. If narrowing is active in the current buffer, only export its @@ -168,6 +207,9 @@ first. When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. +When optional argument BODY-ONLY is non-nil, strip document +keywords from output. + EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. @@ -177,10 +219,11 @@ be displayed when `org-export-show-temporary-export-buffer' is non-nil." (interactive) (org-export-to-buffer 'org "*Org ORG Export*" - async subtreep visible-only nil ext-plist (lambda () (org-mode)))) + async subtreep visible-only body-only ext-plist (lambda () (org-mode)))) ;;;###autoload -(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist) +(defun org-org-export-to-org + (&optional async subtreep visible-only body-only ext-plist) "Export current buffer to an org file. If narrowing is active in the current buffer, only export its @@ -199,6 +242,9 @@ first. When optional argument VISIBLE-ONLY is non-nil, don't export contents of hidden elements. +When optional argument BODY-ONLY is non-nil, strip document +keywords from output. + EXT-PLIST, when provided, is a property list with external parameters overriding Org default settings, but still inferior to file-local settings. From 4466af5c115b56377d7251e848860dc03212c583 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 16 Nov 2013 00:33:30 +0100 Subject: [PATCH 119/166] org-element: Fix commit 73d60606bd397e2d4a1eb19c624bec4af8c2fa0c * lisp/org-element.el (org-element--cache-sync): Fix commit 73d60606bd397e2d4a1eb19c624bec4af8c2fa0c. --- lisp/org-element.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index f6b970037..ce4fe2370 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -5048,7 +5048,8 @@ removed from the cache." (let ((parent (org-element-property :parent element))) (when (and parent (eq (org-element-type parent) 'item)) (setq parent (org-element-property :parent parent))) - (when (and parent + (when (and (memq (org-element-type parent) + '(footnote-definition plain-list)) (>= (org-element-property :end parent) beg) (= (org-element-property :contents-end parent) (org-element-property :end element))) From 9676c59547900fb5034a2f734426aca3353f4b24 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 16 Nov 2013 09:19:22 +0100 Subject: [PATCH 120/166] ox-org: Add "body-only" export * lisp/ox-org.el (org-org-export-to-org): Add body-only export. --- lisp/ox-org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ox-org.el b/lisp/ox-org.el index 8601f8b34..32262e2b6 100644 --- a/lisp/ox-org.el +++ b/lisp/ox-org.el @@ -253,7 +253,7 @@ Return output file name." (interactive) (let ((outfile (org-export-output-file-name ".org" subtreep))) (org-export-to-file 'org outfile - async subtreep visible-only nil ext-plist))) + async subtreep visible-only body-only ext-plist))) ;;;###autoload (defun org-org-publish-to-org (plist filename pub-dir) From 926bc85861b86fde88129b535caf144c483e08af Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 16 Nov 2013 09:53:10 +0100 Subject: [PATCH 121/166] org-element: Rename a function * lisp/org-element.el (org-element--cache-shift-positions): Renamed from `org-element--shift-positions'. (org-element--cache-sync): Apply renaming. --- lisp/org-element.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index ce4fe2370..fc59d4414 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -4810,7 +4810,7 @@ the value to store. Nothing will be stored if (unless org-element--cache (org-element-cache-reset)) (puthash pos data org-element--cache))) -(defsubst org-element--shift-positions (element offset) +(defsubst org-element--cache-shift-positions (element offset) "Shift ELEMENT properties relative to buffer positions by OFFSET. Properties containing buffer positions are `:begin', `:end', `:contents-begin', `:contents-end' and `:structure'. They are @@ -4996,14 +4996,14 @@ removed from the cache." (let* ((conflictp (consp (caar value))) (value-to-shift (if conflictp (cdr value) value))) ;; Shift element part. - (org-element--shift-positions (car value-to-shift) offset) + (org-element--cache-shift-positions (car value-to-shift) offset) ;; Shift objects part. (dolist (object-data (cdr value-to-shift)) (incf (car object-data) offset) (dolist (successor (nth 1 object-data)) (incf (cdr successor) offset)) (dolist (object (cddr object-data)) - (org-element--shift-positions object offset))) + (org-element--cache-shift-positions object offset))) ;; Shift key-value pair. (let* ((new-key (+ key offset)) (new-value (gethash new-key org-element--cache))) From fc95ee2768549dfd1f8fd3d6e3a77161cefc1f56 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 16 Nov 2013 10:15:28 +0100 Subject: [PATCH 122/166] org-element: Change to timestamp interpreter * lisp/org-element.el (org-element-timestamp-interpreter): Ignore :raw-value and build timestamp from numeric properties instead. * testing/lisp/test-org-element.el: Update tests. * testing/lisp/test-ox.el: Update tests. This change allow to modify and update a timestamp easily without requiring to reset :raw-value first, which was not intuitive. --- lisp/org-element.el | 185 +++++++++++++++---------------- testing/lisp/test-org-element.el | 57 +++++----- testing/lisp/test-ox.el | 41 +++---- 3 files changed, 144 insertions(+), 139 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index fc59d4414..57e26ffb5 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -3550,100 +3550,97 @@ Assume point is at the beginning of the timestamp." (defun org-element-timestamp-interpreter (timestamp contents) "Interpret TIMESTAMP object as Org syntax. CONTENTS is nil." - ;; Use `:raw-value' if specified. - (or (org-element-property :raw-value timestamp) - ;; Otherwise, build timestamp string. - (let* ((repeat-string - (concat - (case (org-element-property :repeater-type timestamp) - (cumulate "+") (catch-up "++") (restart ".+")) - (let ((val (org-element-property :repeater-value timestamp))) - (and val (number-to-string val))) - (case (org-element-property :repeater-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) - (warning-string - (concat - (case (org-element-property :warning-type timestamp) - (first "--") - (all "-")) - (let ((val (org-element-property :warning-value timestamp))) - (and val (number-to-string val))) - (case (org-element-property :warning-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) - (build-ts-string - ;; Build an Org timestamp string from TIME. ACTIVEP is - ;; non-nil when time stamp is active. If WITH-TIME-P is - ;; non-nil, add a time part. HOUR-END and MINUTE-END - ;; specify a time range in the timestamp. REPEAT-STRING - ;; is the repeater string, if any. - (lambda (time activep &optional with-time-p hour-end minute-end) - (let ((ts (format-time-string - (funcall (if with-time-p 'cdr 'car) - org-time-stamp-formats) - time))) - (when (and hour-end minute-end) - (string-match "[012]?[0-9]:[0-5][0-9]" ts) - (setq ts - (replace-match - (format "\\&-%02d:%02d" hour-end minute-end) - nil nil ts))) - (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) - (dolist (s (list repeat-string warning-string)) - (when (org-string-nw-p s) - (setq ts (concat (substring ts 0 -1) - " " - s - (substring ts -1))))) - ;; Return value. - ts))) - (type (org-element-property :type timestamp))) - (case type - ((active inactive) - (let* ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp)) - (time-range-p (and hour-start hour-end minute-start minute-end - (or (/= hour-start hour-end) - (/= minute-start minute-end))))) - (funcall - build-ts-string - (encode-time 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active) - (and hour-start minute-start) - (and time-range-p hour-end) - (and time-range-p minute-end)))) - ((active-range inactive-range) - (let ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp))) - (concat - (funcall - build-ts-string (encode-time - 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active-range) - (and hour-start minute-start)) - "--" - (funcall build-ts-string - (encode-time 0 - (or minute-end 0) - (or hour-end 0) - (org-element-property :day-end timestamp) - (org-element-property :month-end timestamp) - (org-element-property :year-end timestamp)) - (eq type 'active-range) - (and hour-end minute-end))))))))) + (let* ((repeat-string + (concat + (case (org-element-property :repeater-type timestamp) + (cumulate "+") (catch-up "++") (restart ".+")) + (let ((val (org-element-property :repeater-value timestamp))) + (and val (number-to-string val))) + (case (org-element-property :repeater-unit timestamp) + (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (warning-string + (concat + (case (org-element-property :warning-type timestamp) + (first "--") + (all "-")) + (let ((val (org-element-property :warning-value timestamp))) + (and val (number-to-string val))) + (case (org-element-property :warning-unit timestamp) + (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (build-ts-string + ;; Build an Org timestamp string from TIME. ACTIVEP is + ;; non-nil when time stamp is active. If WITH-TIME-P is + ;; non-nil, add a time part. HOUR-END and MINUTE-END + ;; specify a time range in the timestamp. REPEAT-STRING is + ;; the repeater string, if any. + (lambda (time activep &optional with-time-p hour-end minute-end) + (let ((ts (format-time-string + (funcall (if with-time-p 'cdr 'car) + org-time-stamp-formats) + time))) + (when (and hour-end minute-end) + (string-match "[012]?[0-9]:[0-5][0-9]" ts) + (setq ts + (replace-match + (format "\\&-%02d:%02d" hour-end minute-end) + nil nil ts))) + (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) + (dolist (s (list repeat-string warning-string)) + (when (org-string-nw-p s) + (setq ts (concat (substring ts 0 -1) + " " + s + (substring ts -1))))) + ;; Return value. + ts))) + (type (org-element-property :type timestamp))) + (case type + ((active inactive) + (let* ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (time-range-p (and hour-start hour-end minute-start minute-end + (or (/= hour-start hour-end) + (/= minute-start minute-end))))) + (funcall + build-ts-string + (encode-time 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active) + (and hour-start minute-start) + (and time-range-p hour-end) + (and time-range-p minute-end)))) + ((active-range inactive-range) + (let ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp))) + (concat + (funcall + build-ts-string (encode-time + 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active-range) + (and hour-start minute-start)) + "--" + (funcall build-ts-string + (encode-time 0 + (or minute-end 0) + (or hour-end 0) + (org-element-property :day-end timestamp) + (org-element-property :month-end timestamp) + (org-element-property :year-end timestamp)) + (eq type 'active-range) + (and hour-end minute-end)))))))) (defun org-element-timestamp-successor () "Search for the next timestamp object. diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index ad98199b5..45a0bfa11 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -2211,16 +2211,17 @@ Outside list" "Test clock interpreter." ;; Running clock. (should - (equal (let ((org-clock-string "CLOCK:")) - (org-test-parse-and-interpret "CLOCK: [2012-01-01 sun. 00:01]")) - "CLOCK: [2012-01-01 sun. 00:01]\n")) + (string-match + "CLOCK: \\[2012-01-01 .* 00:01\\]" + (let ((org-clock-string "CLOCK:")) + (org-test-parse-and-interpret "CLOCK: [2012-01-01 sun. 00:01]")))) ;; Closed clock. (should - (equal + (string-match + "CLOCK: \\[2012-01-01 .* 00:01\\]--\\[2012-01-01 .* 00:02\\] => 0:01" (let ((org-clock-string "CLOCK:")) (org-test-parse-and-interpret " -CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01")) - "CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01\n"))) +CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01"))))) (ert-deftest test-org-element/comment-interpreter () "Test comment interpreter." @@ -2320,12 +2321,12 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01")) (org-deadline-string "DEADLINE:") (org-scheduled-string "SCHEDULED:")) (should - (equal + (string-match + "\\* Headline +DEADLINE: <2012-03-29 .*?> SCHEDULED: <2012-03-29 .*?> CLOSED: \\[2012-03-29 .*?\\]" (org-test-parse-and-interpret "* Headline -DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]") - "* Headline -DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) +DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu.]"))))) (ert-deftest test-org-element/property-drawer-interpreter () "Test property drawer interpreter." @@ -2395,8 +2396,9 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) (ert-deftest test-org-element/timestamp-interpreter () "Test timestamp interpreter." ;; Active. - (should (equal (org-test-parse-and-interpret "<2012-03-29 thu. 16:40>") - "<2012-03-29 thu. 16:40>\n")) + (should + (string-match "<2012-03-29 .* 16:40>" + (org-test-parse-and-interpret "<2012-03-29 thu. 16:40>"))) (should (string-match "<2012-03-29 .* 16:40>" (org-element-timestamp-interpreter @@ -2404,8 +2406,9 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) (:type active :year-start 2012 :month-start 3 :day-start 29 :hour-start 16 :minute-start 40)) nil))) ;; Inactive. - (should (equal (org-test-parse-and-interpret "[2012-03-29 thu. 16:40]") - "[2012-03-29 thu. 16:40]\n")) + (should + (string-match "\\[2012-03-29 .* 16:40\\]" + (org-test-parse-and-interpret "[2012-03-29 thu. 16:40]"))) (should (string-match "\\[2012-03-29 .* 16:40\\]" @@ -2414,9 +2417,10 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) (:type inactive :year-start 2012 :month-start 3 :day-start 29 :hour-start 16 :minute-start 40)) nil))) ;; Active range. - (should (equal (org-test-parse-and-interpret - "<2012-03-29 thu. 16:40>--<2012-03-29 thu. 16:41>") - "<2012-03-29 thu. 16:40>--<2012-03-29 thu. 16:41>\n")) + (should + (string-match "<2012-03-29 .* 16:40>--<2012-03-29 .* 16:41>" + (org-test-parse-and-interpret + "<2012-03-29 thu. 16:40>--<2012-03-29 thu. 16:41>"))) (should (string-match "<2012-03-29 .* 16:40>--<2012-03-29 .* 16:41>" @@ -2426,9 +2430,10 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) :hour-start 16 :minute-start 40 :year-end 2012 :month-end 3 :day-end 29 :hour-end 16 :minute-end 41)) nil))) ;; Inactive range. - (should (equal (org-test-parse-and-interpret - "[2012-03-29 thu. 16:40]--[2012-03-29 thu. 16:41]") - "[2012-03-29 thu. 16:40]--[2012-03-29 thu. 16:41]\n")) + (should + (string-match "\\[2012-03-29 .* 16:40\\]--\\[2012-03-29 .* 16:41\\]" + (org-test-parse-and-interpret + "[2012-03-29 thu. 16:40]--[2012-03-29 thu. 16:41]"))) (should (string-match "\\[2012-03-29 .* 16:40\\]--\\[2012-03-29 .* 16:41\\]" @@ -2441,8 +2446,9 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) (should (equal (org-test-parse-and-interpret "<%%diary-float t 4 2>") "<%%diary-float t 4 2>\n")) ;; Timestamp with repeater interval, with delay, with both. - (should (equal (org-test-parse-and-interpret "<2012-03-29 thu. +1y>") - "<2012-03-29 thu. +1y>\n")) + (should + (string-match "<2012-03-29 .* \\+1y>" + (org-test-parse-and-interpret "<2012-03-29 thu. +1y>"))) (should (string-match "<2012-03-29 .* \\+1y>" @@ -2469,9 +2475,10 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) :repeater-type cumulate :repeater-value 1 :repeater-unit year)) nil))) ;; Timestamp range with repeater interval - (should (equal (org-test-parse-and-interpret - "<2012-03-29 Thu +1y>--<2012-03-30 Thu +1y>") - "<2012-03-29 Thu +1y>--<2012-03-30 Thu +1y>\n")) + (should + (string-match "<2012-03-29 .* \\+1y>--<2012-03-30 .* \\+1y>" + (org-test-parse-and-interpret + "<2012-03-29 Thu +1y>--<2012-03-30 Thu +1y>"))) (should (string-match "<2012-03-29 .* \\+1y>--<2012-03-30 .* \\+1y>" diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index b375f9c35..c9b2eed89 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -400,11 +400,11 @@ Paragraph" nil nil nil '(:with-archived-trees t)))))) ;; Clocks. (should - (equal "CLOCK: [2012-04-29 sun. 10:45]\n" - (let ((org-clock-string "CLOCK:")) - (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-clocks t)))))) + (string-match "CLOCK: \\[2012-04-29 .* 10:45\\]" + (let ((org-clock-string "CLOCK:")) + (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-clocks t)))))) (should (equal "" (let ((org-clock-string "CLOCK:")) @@ -464,11 +464,12 @@ Paragraph" nil nil nil '(:with-inlinetasks nil))))))) ;; Plannings. (should - (equal "CLOSED: [2012-04-29 sun. 10:45]\n" - (let ((org-closed-string "CLOSED:")) - (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-planning t)))))) + (string-match + "CLOSED: \\[2012-04-29 .* 10:45\\]" + (let ((org-closed-string "CLOSED:")) + (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-planning t)))))) (should (equal "" (let ((org-closed-string "CLOSED:")) @@ -505,8 +506,8 @@ Paragraph" "Test `org-export-with-timestamps' specifications." ;; t value. (should - (equal - "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n" + (string-match + "\\[2012-04-29 .*? 10:45\\]<2012-04-29 .*? 10:45>" (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>" (org-export-as (org-test-default-backend) nil nil nil '(:with-timestamps t))))) @@ -519,24 +520,24 @@ Paragraph" nil nil nil '(:with-timestamps nil))))) ;; `active' value. (should - (equal - "<2012-03-29 Thu>\n\nParagraph <2012-03-29 Thu>[2012-03-29 Thu]" + (string-match + "<2012-03-29 .*?>\n\nParagraph <2012-03-29 .*?>\\[2012-03-29 .*?\\]" (org-test-with-temp-text "<2012-03-29 Thu>[2012-03-29 Thu] Paragraph <2012-03-29 Thu>[2012-03-29 Thu]" - (org-trim (org-export-as (org-test-default-backend) - nil nil nil '(:with-timestamps active)))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-timestamps active))))) ;; `inactive' value. (should - (equal - "[2012-03-29 Thu]\n\nParagraph <2012-03-29 Thu>[2012-03-29 Thu]" + (string-match + "\\[2012-03-29 .*?\\]\n\nParagraph <2012-03-29 .*?>\\[2012-03-29 .*?\\]" (org-test-with-temp-text "<2012-03-29 Thu>[2012-03-29 Thu] Paragraph <2012-03-29 Thu>[2012-03-29 Thu]" - (org-trim (org-export-as (org-test-default-backend) - nil nil nil '(:with-timestamps inactive))))))) + (org-export-as (org-test-default-backend) + nil nil nil '(:with-timestamps inactive)))))) (ert-deftest test-org-export/comment-tree () "Test if export process ignores commented trees." From 19f55fbe27e2091d45f60fca0aff67173d4a340f Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Sat, 16 Nov 2013 20:12:05 +0100 Subject: [PATCH 123/166] Accepting canceled and cancelled --- contrib/lisp/org-effectiveness.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el index a276989b0..c42925dfc 100644 --- a/contrib/lisp/org-effectiveness.el +++ b/contrib/lisp/org-effectiveness.el @@ -59,7 +59,7 @@ (interactive) (save-excursion (goto-char (point-min)) - (message "Number of Canceled: %d" (count-matches "* CANCELED")))) + (message "Number of Canceled: %d" (count-matches "* CANCEL+ED")))) (defun org-effectiveness() "Returns the effectiveness in the current org buffer" @@ -67,7 +67,7 @@ (save-excursion (goto-char (point-min)) (let ((done (float (count-matches "* DONE.*\n.*"))) - (canc (float (count-matches "* CANCELED.*\n.*")))) + (canc (float (count-matches "* CANCEL+ED.*\n.*")))) (if (and (= done canc) (zerop done)) (setq effectiveness 0) (setq effectiveness (* 100 (/ done (+ done canc))))) @@ -90,7 +90,7 @@ (defun org-canceled-in-date(date) (interactive "sGive me a date: " date) - (setq count (count-matches (concat "TODO.*\n.*" date))) + (setq count (count-matches (concat "CANCEL+ED.*\n.*" date))) (message "CANCELEDS: %d" count)) (defun org-effectiveness-in-date(date &optional notmessage) @@ -98,7 +98,7 @@ (save-excursion (goto-char (point-min)) (let ((done (float (count-matches (concat "* DONE.*\n.*" date)))) - (canc (float (count-matches (concat "* CANCELED.*\n.*" date))))) + (canc (float (count-matches (concat "* CANCEL+ED.*\n.*" date))))) (if (and (= done canc) (zerop done)) (setq effectiveness 0) (setq effectiveness (* 100 (/ done (+ done canc))))) From d8e149eb76219ea45114cac796db851e452152a3 Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Sat, 16 Nov 2013 20:16:03 +0100 Subject: [PATCH 124/166] All functions must start by org-effectiveness --- contrib/lisp/org-effectiveness.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el index c42925dfc..a872cb201 100644 --- a/contrib/lisp/org-effectiveness.el +++ b/contrib/lisp/org-effectiveness.el @@ -73,22 +73,22 @@ (setq effectiveness (* 100 (/ done (+ done canc))))) (message "Effectiveness: %f" effectiveness)))) -(defun org-keywords-in-date(keyword date) +(defun org-effectiveness-keywords-in-date(keyword date) (interactive "sKeyword: \nsDate: " keyword date) (setq count (count-matches (concat keyword ".*\n.*" date))) (message (concat "%sS: %d" keyword count))) -(defun org-dones-in-date(date) +(defun org-effectiveness-dones-in-date(date) (interactive "sGive me a date: " date) (setq count (count-matches (concat "DONE.*\n.*" date))) (message "DONES: %d" count)) -(defun org-todos-in-date(date) +(defun org-effectivenes-todos-in-date(date) (interactive "sGive me a date: " date) (setq count (count-matches (concat "TODO.*\n.*" date))) (message "TODOS: %d" count)) -(defun org-canceled-in-date(date) +(defun org-effectiveness-canceled-in-date(date) (interactive "sGive me a date: " date) (setq count (count-matches (concat "CANCEL+ED.*\n.*" date))) (message "CANCELEDS: %d" count)) From 19d74816656387d12ec3ff2c3256cbaff5e23bf5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 29 Oct 2013 14:53:21 +0100 Subject: [PATCH 125/166] Change some defcustoms into defconsts * lisp/org.el (org-clock-string, org-closed-string) (org-deadline-string, org-scheduled-string) (org-archive-tag, org-comment-string, org-quote-string) (org-effort-property, org-latex-regexps): Turn variables into constants. * testing/lisp/test-org-element.el: Update tests. * testing/lisp/test-ox.el: Update tests. Also collect all syntax related constants in the same part of the file. --- lisp/org.el | 389 ++++++++++++++++--------------- testing/lisp/test-org-element.el | 57 ++--- testing/lisp/test-ox.el | 14 +- 3 files changed, 224 insertions(+), 236 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index a3c19589d..1f69b32e6 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -329,8 +329,204 @@ When MESSAGE is non-nil, display a message with the version." (defconst org-version (org-version)) -;;; Compatibility constants + +;;; Syntax Constants +;;;; Block + +(defconst org-block-regexp + "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" + "Regular expression for hiding blocks.") + +(defconst org-dblock-start-re + "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" + "Matches the start line of a dynamic block, with parameters.") + +(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" + "Matches the end of a dynamic block.") + +;;;; Clock and Planning + +(defconst org-clock-string "CLOCK:" + "String used as prefix for timestamps clocking work hours on an item.") + +(defconst org-closed-string "CLOSED:" + "String used as the prefix for timestamps logging closing a TODO entry.") + +(defconst org-deadline-string "DEADLINE:" + "String to mark deadline entries. +A deadline is this string, followed by a time stamp. Should be a word, +terminated by a colon. You can insert a schedule keyword and +a timestamp with \\[org-deadline].") + +(defconst org-scheduled-string "SCHEDULED:" + "String to mark scheduled TODO entries. +A schedule is this string, followed by a time stamp. Should be a word, +terminated by a colon. You can insert a schedule keyword and +a timestamp with \\[org-schedule].") + +(defconst org-planning-or-clock-line-re + (concat "^[ \t]*" + (regexp-opt + (list org-clock-string org-closed-string org-deadline-string + org-scheduled-string) + t)) + "Matches a line with planning or clock info. +Matched keyword is in group 1.") + +;;;; Drawer + +(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" + "Matches first line of a hidden block. +Group 1 contains drawer's name.") + +(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the last line of a property drawer.") + +(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-drawer-re + (concat "\\(" org-property-start-re "\\)[^\000]*?\\(" + org-property-end-re "\\)\n?") + "Matches an entire property drawer.") + +(defconst org-clock-drawer-re + (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\(" + org-property-end-re "\\)\n?") + "Matches an entire clock drawer.") + +;;;; Headline + +(defconst org-heading-keyword-regexp-format + "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Printf format for a regexp matching a headline with some keyword. +This regexp will match the headline of any node which has the +exact keyword that is put into the format. The keyword isn't in +any group by default, but the stars and the body are.") + +(defconst org-heading-keyword-maybe-regexp-format + "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Printf format for a regexp matching a headline, possibly with some keyword. +This regexp can match any headline with the specified keyword, or +without a keyword. The keyword isn't in any group by default, +but the stars and the body are.") + +(defconst org-archive-tag "ARCHIVE" + "The tag that marks a subtree as archived. +An archived subtree does not open during visibility cycling, and does +not contribute to the agenda listings.") + +(defconst org-comment-string "COMMENT" + "Entries starting with this keyword will never be exported. +An entry can be toggled between COMMENT and normal with +\\[org-toggle-comment].") + +(defconst org-quote-string "QUOTE" + "Entries starting with this keyword will be exported in fixed-width font. +Quoting applies only to the text in the entry following the headline, and does +not extend beyond the next headline, even if that is lower level. +An entry can be toggled between QUOTE and normal with +\\[org-toggle-fixed-width-section].") + +;;;; LaTeX Environments and Fragments + +(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) + ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p + ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) + "Regular expressions for matching embedded LaTeX.") + +;;;; Node Property + +(defconst org-effort-property "Effort" + "The property that is being used to keep track of effort estimates. +Effort estimates given in this property need to have the format H:MM.") + +;;;; Table + +(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" + "Detect an org-type or table-type table.") + +(defconst org-table-line-regexp "^[ \t]*|" + "Detect an org-type table line.") + +(defconst org-table-dataline-regexp "^[ \t]*|[^-]" + "Detect an org-type table line.") + +(defconst org-table-hline-regexp "^[ \t]*|-" + "Detect an org-type table hline.") + +(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" + "Detect a table-type table hline.") + +(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" + "Detect the first line outside a table when searching from within it. +This works for both table types.") + +(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " + "Detect a #+TBLFM line.") + +;;;; Timestamp + +(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" + "Regular expression for fast time stamp matching.") + +(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" + "Regular expression for fast time stamp matching.") + +(defconst org-ts-regexp0 + "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis. +This one does not require the space after the date, so it can be used +on a string that terminates immediately after the date.") + +(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis.") + +(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") + "Regular expression matching time stamps, with groups.") + +(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") + "Regular expression matching time stamps (also [..]), with groups.") + +(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) + "Regular expression matching a time stamp range.") + +(defconst org-tr-regexp-both + (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) + "Regular expression matching a time stamp range.") + +(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" + org-ts-regexp "\\)?") + "Regular expression matching a time stamp or time stamp range.") + +(defconst org-tsr-regexp-both + (concat org-ts-regexp-both "\\(--?-?" + org-ts-regexp-both "\\)?") + "Regular expression matching a time stamp or time stamp range. +The time stamps may be either active or inactive.") + +(defconst org-repeat-re + "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" + "Regular expression for specifying repeated events. +After a match, group 1 contains the repeat expression.") + +(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") + "Formats for `format-time-string' which are used for time stamps.") + + ;;; The custom variables (defgroup org nil @@ -840,34 +1036,6 @@ effective." :tag "Org Keywords" :group 'org) -(defcustom org-deadline-string "DEADLINE:" - "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-scheduled-string "SCHEDULED:" - "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-string "CLOSED:" - "String used as the prefix for timestamps logging closing a TODO entry." - :group 'org-keywords - :type 'string) - -(defcustom org-clock-string "CLOCK:" - "String used as prefix for timestamps clocking work hours on an item." - :group 'org-keywords - :type 'string) - (defcustom org-closed-keep-when-no-todo nil "Remove CLOSED: time-stamp when switching back to a non-todo state?" :group 'org-todo @@ -876,39 +1044,6 @@ Changes become only effective after restarting Emacs." :package-version '(Org . "8.0") :type 'boolean) -(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" - org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string "\\|" - org-clock-string "\\)") - "Matches a line with planning or clock info.") - -(defcustom org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. -An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-quote-string "QUOTE" - "Entries starting with this keyword will be exported in fixed-width font. -Quoting applies only to the text in the entry following the headline, and does -not extend beyond the next headline, even if that is lower level. -An entry can be toggled between QUOTE and normal with -\\[org-toggle-fixed-width-section]." - :group 'org-keywords - :type 'string) - -(defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" - "Matches first line of a hidden block. -Group 1 contains drawer's name.") - -(defconst org-repeat-re - "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" - "Regular expression for specifying repeated events. -After a match, group 1 contains the repeat expression.") - (defgroup org-structure nil "Options concerning the general structure of Org-mode files." :tag "Org Structure" @@ -2861,10 +2996,6 @@ the time stamp will always be forced into the second line." :group 'org-time :type 'boolean) -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - (defcustom org-time-stamp-rounding-minutes '(0 5) "Number of minutes to round time stamps to. These are two values, the first applies when first creating a time stamp. @@ -3532,13 +3663,6 @@ or nil if the normal value should be used." :group 'org-properties :type '(choice (const nil) (function))) -(defcustom org-effort-property "Effort" - "The property that is being used to keep track of effort estimates. -Effort estimates given in this property need to have the format H:MM." - :group 'org-properties - :group 'org-progress - :type '(string :tag "Property")) - (defconst org-global-properties-fixed '(("VISIBILITY_ALL" . "folded children content all") ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) @@ -4234,30 +4358,6 @@ Normal means, no org-mode-specific context." (declare-function speedbar-line-directory "speedbar" (&optional depth)) (declare-function table--at-cell-p "table" (position &optional object at-column)) -(defvar org-latex-regexps) - -;;; Autoload and prepare some org modules - -;; Some table stuff that needs to be defined here, because it is used -;; by the functions setting up org-mode or checking for table context. - -(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detect an org-type or table-type table.") -(defconst org-table-line-regexp "^[ \t]*|" - "Detect an org-type table line.") -(defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detect an org-type table line.") -(defconst org-table-hline-regexp "^[ \t]*|-" - "Detect an org-type table hline.") -(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detect a table-type table hline.") -(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Detect the first line outside a table when searching from within it. -This works for both table types.") - -(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " - "Detect a #+TBLFM line.") - ;;;###autoload (defun turn-on-orgtbl () "Unconditionally turn on `orgtbl-mode'." @@ -4454,16 +4554,6 @@ the hierarchy, it will be used." :group 'org-archive :type 'string) -(defcustom org-archive-tag "ARCHIVE" - "The tag that marks a subtree as archived. -An archived subtree does not open during visibility cycling, and does -not contribute to the agenda listings. -After changing this, font-lock must be restarted in the relevant buffers to -get the proper fontification." - :group 'org-archive - :group 'org-keywords - :type 'string) - (defcustom org-agenda-skip-archived-trees t "Non-nil means the agenda will skip any items located in archived trees. An archived tree is a tree marked with the tag ARCHIVE. The use of this @@ -4759,22 +4849,6 @@ means to push this value onto the list in the variable.") (cons (cons key (if previous (concat previous " " val) val)) remainder) (cons (cons key val) remainder)))) -(defconst org-block-regexp - "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" - "Regular expression for hiding blocks.") -(defconst org-heading-keyword-regexp-format - "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching a headline with some keyword. -This regexp will match the headline of any node which has the -exact keyword that is put into the format. The keyword isn't in -any group by default, but the stars and the body are.") -(defconst org-heading-keyword-maybe-regexp-format - "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching a headline, possibly with some keyword. -This regexp can match any headline with the specified keyword, or -without a keyword. The keyword isn't in any group by default, -but the stars and the body are.") - (defcustom org-group-tags t "When non-nil (the default), use group tags. This can be turned on/off through `org-toggle-tags-groups'." @@ -5633,35 +5707,6 @@ This should be called after the variable `org-link-types' has changed." (org-make-link-regexps) -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 - "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis. -This one does not require the space after the date, so it can be used -on a string that terminates immediately after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis.") -(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") - "Regular expression matching time stamps, with groups.") -(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") - "Regular expression matching time stamps (also [..]), with groups.") -(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) - "Regular expression matching a time stamp range.") -(defconst org-tr-regexp-both - (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) - "Regular expression matching a time stamp range.") -(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" - org-ts-regexp "\\)?") - "Regular expression matching a time stamp or time stamp range.") -(defconst org-tsr-regexp-both - (concat org-ts-regexp-both "\\(--?-?" - org-ts-regexp-both "\\)?") - "Regular expression matching a time stamp or time stamp range. -The time stamps may be either active or inactive.") - (defvar org-emph-face nil) (defun org-do-emphasis-faces (limit) @@ -11828,13 +11873,6 @@ If not found, stay at current position and return nil." (if pos (goto-char pos)) pos)) -(defconst org-dblock-start-re - "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" - "Matches the start line of a dynamic block, with parameters.") - -(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" - "Matches the end of a dynamic block.") - (defun org-create-dblock (plist) "Create a dynamic block section, with parameters taken from PLIST. PLIST must contain a :name entry which is used as name of the block." @@ -15052,28 +15090,6 @@ but in some other way.") "Some properties that are used by Org-mode for various purposes. Being in this list makes sure that they are offered for completion.") -(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the last line of a property drawer.") - -(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-property-drawer-re - (concat "\\(" org-property-start-re "\\)[^\000]*?\\(" - org-property-end-re "\\)\n?") - "Matches an entire property drawer.") - -(defconst org-clock-drawer-re - (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\(" - org-property-end-re "\\)\n?") - "Matches an entire clock drawer.") - (defun org-property-action () "Do an action on properties." (interactive) @@ -18202,17 +18218,6 @@ Revert to the normal definition outside of these fragments." ;;;; LaTeX fragments -(defvar 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) - ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) - ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) - "Regular expressions for matching embedded LaTeX.") - (defun org-inside-LaTeX-fragment-p () "Test if point is inside a LaTeX fragment. I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 45a0bfa11..e533b6520 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -293,9 +293,8 @@ Some other text (ert-deftest test-org-element/clock-parser () "Test `clock' parser." ;; Running clock. - (let* ((org-clock-string "CLOCK:") - (clock (org-test-with-temp-text "CLOCK: [2012-01-01 sun. 00:01]" - (org-element-at-point)))) + (let ((clock (org-test-with-temp-text "CLOCK: [2012-01-01 sun. 00:01]" + (org-element-at-point)))) (should (eq (org-element-property :status clock) 'running)) (should (equal (org-element-property :raw-value @@ -303,11 +302,10 @@ Some other text "[2012-01-01 sun. 00:01]")) (should-not (org-element-property :duration clock))) ;; Closed clock. - (let* ((org-clock-string "CLOCK:") - (clock - (org-test-with-temp-text - "CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" - (org-element-at-point)))) + (let ((clock + (org-test-with-temp-text + "CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" + (org-element-at-point)))) (should (eq (org-element-property :status clock) 'closed)) (should (equal (org-element-property :raw-value (org-element-property :value clock)) @@ -2213,15 +2211,13 @@ Outside list" (should (string-match "CLOCK: \\[2012-01-01 .* 00:01\\]" - (let ((org-clock-string "CLOCK:")) - (org-test-parse-and-interpret "CLOCK: [2012-01-01 sun. 00:01]")))) + (org-test-parse-and-interpret "CLOCK: [2012-01-01 sun. 00:01]"))) ;; Closed clock. (should (string-match "CLOCK: \\[2012-01-01 .* 00:01\\]--\\[2012-01-01 .* 00:02\\] => 0:01" - (let ((org-clock-string "CLOCK:")) - (org-test-parse-and-interpret " -CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01"))))) + (org-test-parse-and-interpret " +CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01")))) (ert-deftest test-org-element/comment-interpreter () "Test comment interpreter." @@ -2317,16 +2313,13 @@ CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01"))))) (ert-deftest test-org-element/planning-interpreter () "Test planning interpreter." - (let ((org-closed-string "CLOSED:") - (org-deadline-string "DEADLINE:") - (org-scheduled-string "SCHEDULED:")) - (should - (string-match - "\\* Headline + (should + (string-match + "\\* Headline DEADLINE: <2012-03-29 .*?> SCHEDULED: <2012-03-29 .*?> CLOSED: \\[2012-03-29 .*?\\]" - (org-test-parse-and-interpret - "* Headline -DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu.]"))))) + (org-test-parse-and-interpret + "* Headline +DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu.]")))) (ert-deftest test-org-element/property-drawer-interpreter () "Test property drawer interpreter." @@ -2561,20 +2554,12 @@ DEADLINE: <2012-03-29 thu.> SCHEDULED: <2012-03-29 thu.> CLOSED: [2012-03-29 thu (ert-deftest test-org-element/latex-fragment-interpreter () "Test latex fragment interpreter." - (let ((org-latex-regexps - '(("begin" "^[ ]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^]+?\\\\end{\\2}\\)" 1 t) - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \n,;.$]\\$\\)\\([- .,?;:'\")]\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \n,;.$][^$\n ]*?\\(\n[^$\n ]*?\\)\\{0,2\\}[^ \n,.$]\\)\\$\\)\\)\\([- .,?;:'\")]\\|$\\)" 2 nil) - ("\\(" "\\\\([^]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^]*?\\\\\\]" 0 nil) - ("$$" "\\$\\$[^]*?\\$\\$" 0 nil)))) - (should (equal (org-test-parse-and-interpret "\\command{}") - "\\command{}\n")) - (should (equal (org-test-parse-and-interpret "$x$") "$x$\n")) - (should (equal (org-test-parse-and-interpret "$x+y$") "$x+y$\n")) - (should (equal (org-test-parse-and-interpret "$$x+y$$") "$$x+y$$\n")) - (should (equal (org-test-parse-and-interpret "\\(x+y\\)") "\\(x+y\\)\n")) - (should (equal (org-test-parse-and-interpret "\\[x+y\\]") "\\[x+y\\]\n")))) + (should (equal (org-test-parse-and-interpret "\\command{}") "\\command{}\n")) + (should (equal (org-test-parse-and-interpret "$x$") "$x$\n")) + (should (equal (org-test-parse-and-interpret "$x+y$") "$x+y$\n")) + (should (equal (org-test-parse-and-interpret "$$x+y$$") "$$x+y$$\n")) + (should (equal (org-test-parse-and-interpret "\\(x+y\\)") "\\(x+y\\)\n")) + (should (equal (org-test-parse-and-interpret "\\[x+y\\]") "\\[x+y\\]\n"))) (ert-deftest test-org-element/line-break-interpreter () "Test line break interpreter." diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index c9b2eed89..940beeb00 100644 --- a/testing/lisp/test-ox.el +++ b/testing/lisp/test-ox.el @@ -401,16 +401,14 @@ Paragraph" ;; Clocks. (should (string-match "CLOCK: \\[2012-04-29 .* 10:45\\]" - (let ((org-clock-string "CLOCK:")) - (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-clocks t)))))) + (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-clocks t))))) (should (equal "" - (let ((org-clock-string "CLOCK:")) - (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" - (org-export-as (org-test-default-backend) - nil nil nil '(:with-clocks nil)))))) + (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" + (org-export-as (org-test-default-backend) + nil nil nil '(:with-clocks nil))))) ;; Drawers. (should (equal "" From a3d7cdcd9e76fa0346c098b473ee5d53b839745b Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sun, 17 Nov 2013 08:46:50 +0100 Subject: [PATCH 126/166] Fix version for org-(export-with|use)-sub-superscript * ox.el (org-export-with-sub-superscripts): * org.el (org-use-sub-superscripts): Fix version and enhance docstring again. --- lisp/org.el | 9 ++++++--- lisp/ox.el | 8 ++++++-- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 50d44c39d..2781c677c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -655,8 +655,10 @@ the following lines anywhere in the buffer: (defcustom org-use-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for display. -If you want to control how Org exports those characters, -see `org-export-with-sub-superscripts'. +If you want to control how Org exports those characters, see +`org-export-with-sub-superscripts'. `org-use-sub-superscripts' +used to be an alias for `org-export-with-sub-superscripts' in +Org <8.0, it is not anymore. When this option is turned on, you can use TeX-like syntax for sub- and superscripts within the buffer. Several characters after @@ -676,7 +678,8 @@ the braces are *required* in order to trigger interpretations as sub/superscript. This can be helpful in documents that need \"_\" frequently in plain text." :group 'org-startup - :version "24.1" + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Always interpret" t) (const :tag "Only with braces" {}) diff --git a/lisp/ox.el b/lisp/ox.el index 22fe8f99f..c5f369924 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -626,8 +626,10 @@ e.g. \"stat:nil\"" (defcustom org-export-with-sub-superscripts t "Non-nil means interpret \"_\" and \"^\" for export. -If you want to control how Org displays those characters, -see `org-use-sub-superscripts'. +If you want to control how Org displays those characters, see +`org-use-sub-superscripts'. `org-export-with-sub-superscripts' +used to be an alias for `org-use-sub-superscripts' in Org <8.0, +it is not anymore. When this option is turned on, you can use TeX-like syntax for sub- and superscripts and see them exported correctly. @@ -651,6 +653,8 @@ the braces are *required* in order to trigger interpretations as sub/superscript. This can be helpful in documents that need \"_\" frequently in plain text." :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Interpret them" t) (const :tag "Curly brackets only" {}) From a6210cc9c24a8f6c2037650e07c2d26ea5a3ab33 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sun, 17 Nov 2013 09:12:41 +0100 Subject: [PATCH 127/166] Backport Paul's fixes from Emacs trunk (1/2) See http://article.gmane.org/gmane.emacs.diffs/123123 --- doc/org.texi | 42 +++++++++++++++++++++--------------------- etc/ORG-NEWS | 16 ++++++++-------- lisp/ob-core.el | 2 +- lisp/ob-python.el | 10 +++++----- lisp/org-agenda.el | 2 +- lisp/org-bibtex.el | 2 +- lisp/org-clock.el | 2 +- lisp/org-src.el | 2 +- lisp/org-table.el | 4 ++-- lisp/ox-ascii.el | 6 +++--- lisp/ox-html.el | 4 ++-- lisp/ox-latex.el | 10 +++++----- lisp/ox-md.el | 2 +- lisp/ox-odt.el | 29 ++++++++++++++--------------- lisp/ox-texinfo.el | 10 +++++----- lisp/ox.el | 8 ++++---- 16 files changed, 75 insertions(+), 76 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 94f7ac30a..210eabb26 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -689,7 +689,7 @@ Using header arguments * System-wide header arguments:: Set global default values * Language-specific header arguments:: Set default values by language * Header arguments in Org mode properties:: Set default values for a buffer or heading -* Language-specific header arguments in Org mode properties:: Set langugage-specific default values for a buffer or heading +* Language-specific header arguments in Org mode properties:: Set language-specific default values for a buffer or heading * Code block specific header arguments:: The most common way to set values * Header arguments in function calls:: The most specific level @@ -3875,7 +3875,7 @@ Jump to line 255. Search for a link target @samp{<>}, or do a text search for @samp{my target}, similar to the search in internal links, see @ref{Internal links}. In HTML export (@pxref{HTML export}), such a file -link will become a HTML reference to the corresponding named anchor in +link will become an HTML reference to the corresponding named anchor in the linked file. @item *My Target In an Org file, restrict search to headlines. @@ -8056,7 +8056,7 @@ You may also test for properties (@pxref{Properties and Columns}) at the same time as matching tags. The properties may be real properties, or special properties that represent other metadata (@pxref{Special properties}). For example, the ``property'' @code{TODO} represents the TODO keyword of the -entry and the ``propety'' @code{PRIORITY} represents the PRIORITY keyword of +entry and the ``property'' @code{PRIORITY} represents the PRIORITY keyword of the entry. The ITEM special property cannot currently be used in tags/property searches@footnote{But @pxref{x-agenda-skip-entry-regexp, ,skipping entries based on regexp}.}. @@ -8548,7 +8548,7 @@ Limit the number of tagged entries. @end table When set to a positive integer, each option will exclude entries from other -catogories: for example, @code{(setq org-agenda-max-effort 100)} will limit +categories: for example, @code{(setq org-agenda-max-effort 100)} will limit the agenda to 100 minutes of effort and exclude any entry that as no effort property. If you want to include entries with no effort property, use a negative value for @code{org-agenda-max-effort}. @@ -9633,7 +9633,7 @@ or on a per-file basis with a line like @end example If you would like to move the table of contents to a different location, you -should turn off the detault table using @code{org-export-with-toc} or +should turn off the default table using @code{org-export-with-toc} or @code{#+OPTIONS} and insert @code{#+TOC: headlines N} at the desired location(s). @@ -10857,7 +10857,7 @@ recognized. See @ref{@LaTeX{} and PDF export} for more information. @cindex #+BEAMER_INNER_THEME @cindex #+BEAMER_OUTER_THEME Beamer export introduces a number of keywords to insert code in the -document's header. Four control appearance of the presentantion: +document's header. Four control appearance of the presentation: @code{#+BEAMER_THEME}, @code{#+BEAMER_COLOR_THEME}, @code{#+BEAMER_FONT_THEME}, @code{#+BEAMER_INNER_THEME} and @code{#+BEAMER_OUTER_THEME}. All of them accept optional arguments @@ -10976,7 +10976,7 @@ Here is a simple example Org document that is intended for Beamer export. @section HTML export @cindex HTML export -Org mode contains a HTML (XHTML 1.0 strict) exporter with extensive +Org mode contains an HTML (XHTML 1.0 strict) exporter with extensive HTML formatting, in ways similar to John Gruber's @emph{markdown} language, but with additional support for tables. @@ -10999,11 +10999,11 @@ language, but with additional support for tables. @table @kbd @orgcmd{C-c C-e h h,org-html-export-to-html} -Export as a HTML file. For an Org file @file{myfile.org}, +Export as an HTML file. For an Org file @file{myfile.org}, the HTML file will be @file{myfile.html}. The file will be overwritten without warning. @kbd{C-c C-e h o} -Export as a HTML file and immediately open it with a browser. +Export as an HTML file and immediately open it with a browser. @orgcmd{C-c C-e h H,org-html-export-as-html} Export to a temporary buffer. Do not create a file. @end table @@ -11030,7 +11030,7 @@ Export to a temporary buffer. Do not create a file. Org can export to various (X)HTML flavors. Setting the variable @code{org-html-doctype} allows you to export to different -(X)HTML variants. The exported HTML will be adjusted according to the sytax +(X)HTML variants. The exported HTML will be adjusted according to the syntax requirements of that variant. You can either set this variable to a doctype string directly, in which case the exporter will try to adjust the syntax automatically, or you can use a ready-made doctype. The ready-made options @@ -11177,7 +11177,7 @@ includes automatic links created by radio targets (@pxref{Radio targets}). Links to external files will still work if the target file is on the same @i{relative} path as the published Org file. Links to other @file{.org} files will be translated into HTML links under the assumption -that a HTML version also exists of the linked file, at the same relative +that an HTML version also exists of the linked file, at the same relative path. @samp{id:} links can then be used to jump to specific entries across files. For information related to linking files while publishing them to a publishing directory see @ref{Publishing links}. @@ -11774,10 +11774,10 @@ attribute. You may set it to: @code{t}: if you want to make the source block a float. It is the default value when a caption is provided. @item -@code{mulicolumn}: if you wish to include a source block which spans multiple -colums in a page. +@code{multicolumn}: if you wish to include a source block which spans multiple +columns in a page. @item -@code{nil}: if you need to avoid any floating evironment, even when a caption +@code{nil}: if you need to avoid any floating environment, even when a caption is provided. It is useful for source code that may not fit in a single page. @end itemize @@ -11839,7 +11839,7 @@ respectively, @code{:width} and @code{:thickness} attributes: @section Markdown export @cindex Markdown export -@code{md} export back-end generates Markdown syntax@footnote{Vanilla flavour, +@code{md} export back-end generates Markdown syntax@footnote{Vanilla flavor, as defined at @url{http://daringfireball.net/projects/markdown/}.} for an Org mode buffer. @@ -12862,7 +12862,7 @@ you are using. The FAQ covers this issue. @cindex export back-ends, built-in @vindex org-export-backends -On top of the aforemetioned back-ends, Org comes with other built-in ones: +On top of the aforementioned back-ends, Org comes with other built-in ones: @itemize @item @file{ox-man.el}: export to a man page. @@ -12895,8 +12895,8 @@ Convert the selected region into @code{Texinfo}. Convert the selected region into @code{MarkDown}. @end table -This is particularily useful for converting tables and lists in foreign -buffers. E.g., in a HTML buffer, you can turn on @code{orgstruct-mode}, then +This is particularly useful for converting tables and lists in foreign +buffers. E.g., in an HTML buffer, you can turn on @code{orgstruct-mode}, then use Org commands for editing a list, and finally select and convert the list with @code{M-x org-html-convert-region-to-html RET}. @@ -17274,8 +17274,8 @@ to become slow. Below are some tips on how to speed up the agenda commands. @enumerate @item -Reduce the number of Org agenda files: this will reduce the slowliness caused -by accessing to a hard drive. +Reduce the number of Org agenda files: this will reduce the slowness caused +by accessing a hard drive. @item Reduce the number of DONE and archived headlines: this way the agenda does not need to skip them. @@ -17913,7 +17913,7 @@ inspired some of the early development, including HTML export. He also asked for a way to narrow wide table columns. @item @i{Jason Dunsmore} has been maintaining the Org-Mode server at Rackspace for -several years now. He also sponsered the hosting costs until Rackspace +several years now. He also sponsored the hosting costs until Rackspace started to host us for free. @item @i{Thomas S. Dye} contributed documentation on Worg and helped integrating diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 15e6a0650..2f9d156ae 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -101,7 +101,7 @@ of the list. Add support for ell, imath, jmath, varphi, varpi, aleph, gimel, beth, dalet, cdots, S (§), dag, ddag, colon, therefore, because, triangleq, leq, geq, lessgtr, lesseqgtr, ll, lll, gg, ggg, prec, preceq, -preccurleyeq, succ, succeq, succurleyeq, setminus, nexist(s), mho, +preccurlyeq, succ, succeq, succurlyeq, setminus, nexist(s), mho, check, frown, diamond. Changes loz, vert, checkmark, smile and tilde. *** Anonymous export back-ends @@ -146,7 +146,7 @@ This makes java executable configurable for ditaa blocks. This enables SVG generation from latex code blocks. -*** New option: [[doc:org-habit-show-done-alwyays-green][org-habit-show-done-alwyays-green]] +*** New option: [[doc:org-habit-show-done-always-green][org-habit-show-done-always-green]] See [[http://lists.gnu.org/archive/html/emacs-orgmode/2013-05/msg00214.html][this message]] from Max Mikhanosha. @@ -277,8 +277,8 @@ manual for details and check [[http://orgmode.org/worg/org-8.0.html][this Worg p moved some contributions into the =contrib/= directory. The rationale for deciding that these files should live in =contrib/= - is either because they rely on third-part softwares that are not - included in Emacs, or because they are not targetting a significant + is either because they rely on third-party software that is not + included in Emacs, or because they are not targeting a significant user-base. - org-colview-xemacs.el @@ -395,7 +395,7 @@ Among the new/updated export options, three are of particular importance: - [[doc:org-export-allow-bind-keywords][org-export-allow-bind-keywords]] :: This option replaces the old option =org-export-allow-BIND= and the default value is =nil=, not =confirm=. - You will need to explicitely set this to =t= in your initialization + You will need to explicitly set this to =t= in your initialization file if you want to allow =#+BIND= keywords. - [[doc:org-export-with-planning][org-export-with-planning]] :: This new option controls the export of @@ -654,7 +654,7 @@ headlines and their content (but not subheadings) into the new file. This is useful when you want to quickly share an agenda containing the full list of notes. -**** New commands to drag an agenda line forward (=M-=) or backard (=M-=) +**** New commands to drag an agenda line forward (=M-=) or backward (=M-=) It sometimes handy to move agenda lines around, just to quickly reorganize your tasks, or maybe before saving the agenda to a file. Now you can use @@ -717,7 +717,7 @@ string is important to keep the agenda alignment clean. When [[doc:org-agenda-skip-scheduled-if-deadline-is-shown][org-agenda-skip-scheduled-if-deadline-is-shown]] is set to =repeated-after-deadline=, the agenda will skip scheduled items if they are -repeated beyond the current dealine. +repeated beyond the current deadline. **** New option for [[doc:org-agenda-skip-deadline-prewarning-if-scheduled][org-agenda-skip-deadline-prewarning-if-scheduled]] @@ -757,7 +757,7 @@ check against the name of the buffer. Using =#+TAGS: { Tag1 : Tag2 Tag3 }= will define =Tag1= as a /group tag/ (note the colon after =Tag1=). If you search for =Tag1=, it will return -headlines containing either =Tag1=, =Tag2= or =Tag3= (or any combinaison +headlines containing either =Tag1=, =Tag2= or =Tag3= (or any combination of those tags.) You can use group tags for sparse tree in an Org buffer, for creating diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 0ec945d6a..84caed7ea 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -318,7 +318,7 @@ Do not query the user." (message (format "Evaluation of this%scode-block%sis disabled." code-block block-name)))))) - ;; dynamically scoped for asynchroneous export + ;; dynamically scoped for asynchronous export (defvar org-babel-confirm-evaluate-answer-no) (defsubst org-babel-confirm-evaluate (info) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 2f91b535f..3c3f66468 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -156,14 +156,14 @@ Emacs-lisp table, otherwise return the results as a string." "Return the buffer associated with SESSION." (cdr (assoc session org-babel-python-buffers))) -(defun org-babel-python-with-earmufs (session) +(defun org-babel-python-with-earmuffs (session) (let ((name (if (stringp session) session (format "%s" session)))) (if (and (string= "*" (substring name 0 1)) (string= "*" (substring name (- (length name) 1)))) name (format "*%s*" name)))) -(defun org-babel-python-without-earmufs (session) +(defun org-babel-python-without-earmuffs (session) (let ((name (if (stringp session) session (format "%s" session)))) (if (and (string= "*" (substring name 0 1)) (string= "*" (substring name (- (length name) 1)))) @@ -190,9 +190,9 @@ then create. Return the initialized session." (if (not (version< "24.1" emacs-version)) (run-python cmd) (unless python-buffer - (setq python-buffer (org-babel-python-with-earmufs session))) + (setq python-buffer (org-babel-python-with-earmuffs session))) (let ((python-shell-buffer-name - (org-babel-python-without-earmufs python-buffer))) + (org-babel-python-without-earmuffs python-buffer))) (run-python cmd)))) ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el @@ -208,7 +208,7 @@ then create. Return the initialized session." (concat "Python-" (symbol-name session)))) (py-which-bufname bufname)) (py-shell) - (setq python-buffer (org-babel-python-with-earmufs bufname)))) + (setq python-buffer (org-babel-python-with-earmuffs bufname)))) (t (error "No function available for running an inferior Python"))) (setq org-babel-python-buffers diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 8bf122dbd..4dfa3e9e3 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -863,7 +863,7 @@ When set to the symbol `not-today', skip scheduled previously, but not scheduled today. When set to the symbol `repeated-after-deadline', skip scheduled -items if they are repeated beyond the current dealine." +items if they are repeated beyond the current deadline." :group 'org-agenda-skip :group 'org-agenda-daily/weekly :type '(choice diff --git a/lisp/org-bibtex.el b/lisp/org-bibtex.el index 526439948..def9340e4 100644 --- a/lisp/org-bibtex.el +++ b/lisp/org-bibtex.el @@ -44,7 +44,7 @@ ;; Here is an example of a capture template that use some of this ;; information (:author :year :title :journal :pages): ;; -;; (setq org-capure-templates +;; (setq org-capture-templates ;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \ ;; In %:journal, %:pages."))) ;; diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 2340ffc7c..3238c8ca9 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -667,7 +667,7 @@ previous clocking intervals." VALUE can be a number of minutes, or a string with format hh:mm or mm. When the string starts with a + or a - sign, the current value of the effort property will be changed by that amount. If the effort value is expressed -as an `org-effort-durations' (e.g. \"3h\"), the modificied value will be +as an `org-effort-durations' (e.g. \"3h\"), the modified value will be converted to a hh:mm duration. This command will update the \"Effort\" property of the currently diff --git a/lisp/org-src.el b/lisp/org-src.el index 99038576f..259186c0c 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -69,7 +69,7 @@ there are kept outside the narrowed region." This will save the content of the source code editing buffer into a newly created file, not the base buffer for this source block. -If you want to regularily save the base buffer instead of the source +If you want to regularly save the base buffer instead of the source code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." :group 'org-edit-structure :version "24.4" diff --git a/lisp/org-table.el b/lisp/org-table.el index c191345e5..fa66ed0a1 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -97,11 +97,11 @@ this variable requires a restart of Emacs to become effective." Each template must define lines that will be treated as a comment and that must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" lines where \"%n\" will be replaced with the name of the table during -insertion of the tempate. The transformed table will later be inserted +insertion of the template. The transformed table will later be inserted between these lines. The template should also contain a minimal table in a multiline comment. -If multiline comments are not possible in the buffer language, +If multiline comments are not possible in the buffer language, you can pack it into a string that will not be used when the code is compiled or executed. Above the table will you need a line with the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index b2a38d55f..55bda8368 100644 --- a/lisp/ox-ascii.el +++ b/lisp/ox-ascii.el @@ -459,7 +459,7 @@ Empty lines are not indented." (defun org-ascii--box-string (s info) "Return string S with a partial box to its left. -INFO is a plist used as a communicaton channel." +INFO is a plist used as a communication channel." (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) (format (if utf8p "╭────\n%s\n╰────" ",----\n%s\n`----") (replace-regexp-in-string @@ -680,7 +680,7 @@ generation. INFO is a plist used as a communication channel." (let ((text-width (if keyword (org-ascii--current-text-width keyword info) (- org-ascii-text-width org-ascii-global-margin))) - ;; Use a counter instead of retreiving ordinal of each + ;; Use a counter instead of retrieving ordinal of each ;; src-block. (count 0)) (mapconcat @@ -718,7 +718,7 @@ generation. INFO is a plist used as a communication channel." (let ((text-width (if keyword (org-ascii--current-text-width keyword info) (- org-ascii-text-width org-ascii-global-margin))) - ;; Use a counter instead of retreiving ordinal of each + ;; Use a counter instead of retrieving ordinal of each ;; src-block. (count 0)) (mapconcat diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 5f3879150..7edbf2ca4 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -153,7 +153,7 @@ \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">") ("xhtml-transitional" . "") - ("xhtml-framset" . "") ("xhtml-11" . "") @@ -3078,7 +3078,7 @@ CONTENTS is the contents of the object. INFO is a plist holding contextual information." (format "%s" contents)) -;;;; Tabel Cell +;;;; Table Cell (defun org-html-table-cell (table-cell contents info) "Transcode a TABLE-CELL element from Org to HTML. diff --git a/lisp/ox-latex.el b/lisp/ox-latex.el index 014ed266a..3609881b6 100644 --- a/lisp/ox-latex.el +++ b/lisp/ox-latex.el @@ -1319,13 +1319,13 @@ holding contextual information." (let* ((class (plist-get info :latex-class)) (level (org-export-get-relative-level headline info)) (numberedp (org-export-numbered-headline-p headline info)) - (class-sectionning (assoc class org-latex-classes)) + (class-sectioning (assoc class org-latex-classes)) ;; Section formatting will set two placeholders: one for ;; the title and the other for the contents. (section-fmt - (let ((sec (if (functionp (nth 2 class-sectionning)) - (funcall (nth 2 class-sectionning) level numberedp) - (nth (1+ level) class-sectionning)))) + (let ((sec (if (functionp (nth 2 class-sectioning)) + (funcall (nth 2 class-sectioning) level numberedp) + (nth (1+ level) class-sectioning)))) (cond ;; No section available for that LEVEL. ((not sec) nil) @@ -1616,7 +1616,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (value (org-remove-indentation (org-element-property :value latex-environment)))) (if (not (org-string-nw-p label)) value - ;; Environment is labelled: label must be within the environment + ;; Environment is labeled: label must be within the environment ;; (otherwise, a reference pointing to that element will count ;; the section instead). (with-temp-buffer diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 811c4e580..78420170b 100644 --- a/lisp/ox-md.el +++ b/lisp/ox-md.el @@ -22,7 +22,7 @@ ;;; Commentary: -;; This library implements a Markdown back-end (vanilla flavour) for +;; This library implements a Markdown back-end (vanilla flavor) for ;; Org exporter, based on `html' back-end. See Org manual for more ;; information. diff --git a/lisp/ox-odt.el b/lisp/ox-odt.el index 99c1353ce..975dbdb9f 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -597,7 +597,7 @@ INPUT-FMT-LIST in to a single class. Note that this variable inherently captures how LibreOffice based converters work. LibreOffice maps documents of various formats to classes like Text, Web, Spreadsheet, Presentation etc and -allow document of a given class (irrespective of it's source +allow document of a given class (irrespective of its source format) to be converted to any of the export formats associated with that class. @@ -920,7 +920,7 @@ Specifically, locale-dependent specifiers like \"%c\", \"%x\" are formatted as canonical Org timestamps. For finer control, avoid these %-specifiers. -Textutal specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\" +Textual specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\" etc., are displayed by the application in the default language and country specified in `org-odt-styles-file'. Note that the default styles file uses language \"en\" and country \"GB\". You @@ -1439,7 +1439,7 @@ original parsed data. INFO is a plist holding export options." ;; Update content.xml. (let* ( ;; `org-display-custom-times' should be accessed right - ;; within the context of the Org buffer. So obtain it's + ;; within the context of the Org buffer. So obtain its ;; value before moving on to temp-buffer context down below. (custom-time-fmts (if org-display-custom-times @@ -1720,7 +1720,7 @@ CONTENTS is nil. INFO is a plist holding contextual information." (and (eq (org-element-type prev) 'footnote-reference) (format "%s" "OrgSuperscript" ","))) - ;; Trancode footnote reference. + ;; Transcode footnote reference. (let ((n (org-export-get-footnote-number footnote-reference info))) (cond ((not (org-export-footnote-first-reference-p footnote-reference info)) @@ -2194,7 +2194,7 @@ SHORT-CAPTION are strings." (concat ;; Sneak in a bookmark. The bookmark is used when the ;; labeled element is referenced with a link that - ;; provides it's own description. + ;; provides its own description. (format "\n" label) ;; Label definition: Typically formatted as below: ;; CATEGORY SEQ-NO: LONG CAPTION @@ -2341,7 +2341,6 @@ used as a communication channel." (user-frame-params (list user-frame-style user-frame-attrs user-frame-anchor)) ;; (embed-as (or embed-as user-frame-anchor "paragraph")) - ;; extrac ;; ;; Handle `:width', `:height' and `:scale' properties. Read ;; them as numbers since we need them for computations. @@ -2371,7 +2370,7 @@ used as a communication channel." (title (and replaces (capitalize (symbol-name (org-element-type replaces))))) - ;; If yes, note down it's contents. It will go in to frame + ;; If yes, note down its contents. It will go in to frame ;; description. This quite useful for debugging. (desc (and replaces (org-element-property :value replaces)))) (org-odt--render-image/formula entity href width height @@ -2409,7 +2408,7 @@ used as a communication channel." (title (and replaces (capitalize (symbol-name (org-element-type replaces))))) - ;; If yes, note down it's contents. It will go in to frame + ;; If yes, note down its contents. It will go in to frame ;; description. This quite useful for debugging. (desc (and replaces (org-element-property :value replaces))) width height) @@ -2613,12 +2612,12 @@ used as a communication channel." INFO is a plist holding contextual information. Return non-nil, if ELEMENT is of type paragraph satisfying -PARAGRAPH-PREDICATE and it's sole content, save for whitespaces, +PARAGRAPH-PREDICATE and its sole content, save for whitespaces, is a link that satisfies LINK-PREDICATE. Return non-nil, if ELEMENT is of type link satisfying -LINK-PREDICATE and it's containing paragraph satisfies -PARAGRAPH-PREDICATE inaddtion to having no other content save for +LINK-PREDICATE and its containing paragraph satisfies +PARAGRAPH-PREDICATE in addition to having no other content save for leading and trailing whitespaces. Return nil, otherwise." @@ -2707,7 +2706,7 @@ Return nil, otherwise." (concat (number-to-string n) "."))) item-numbers ""))))) ;; Case 2: Locate a regular and numbered headline in the - ;; hierarchy. Display it's section number. + ;; hierarchy. Display its section number. (let ((headline (loop for el in (cons destination genealogy) when (and (eq (org-element-type el) 'headline) (not (org-export-low-level-p el info)) @@ -2720,7 +2719,7 @@ Return nil, otherwise." (mapconcat 'number-to-string (org-export-get-headline-number headline info) ".")))) ;; Case 4: Locate a regular headline in the hierarchy. Display - ;; it's title. + ;; its title. (let ((headline (loop for el in (cons destination genealogy) when (and (eq (org-element-type el) 'headline) (not (org-export-low-level-p el info))) @@ -3100,9 +3099,9 @@ holding contextual information." (defun org-odt-hfy-face-to-css (fn) "Create custom style for face FN. -When FN is the default face, use it's foreground and background +When FN is the default face, use its foreground and background properties to create \"OrgSrcBlock\" paragraph style. Otherwise -use it's color attribute to create a character style whose name +use its color attribute to create a character style whose name is obtained from FN. Currently all attributes of FN other than color are ignored. diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index 0df660da2..43c1de215 100644 --- a/lisp/ox-texinfo.el +++ b/lisp/ox-texinfo.el @@ -957,7 +957,7 @@ holding contextual information." (let* ((class (plist-get info :texinfo-class)) (level (org-export-get-relative-level headline info)) (numberedp (org-export-numbered-headline-p headline info)) - (class-sectionning (assoc class org-texinfo-classes)) + (class-sectioning (assoc class org-texinfo-classes)) ;; Find the index type, if any (index (org-element-property :INDEX headline)) ;; Check if it is an appendix @@ -993,10 +993,10 @@ holding contextual information." ;; Section formatting will set two placeholders: one for the ;; title and the other for the contents. (section-fmt - (let ((sec (if (and (symbolp (nth 2 class-sectionning)) - (fboundp (nth 2 class-sectionning))) - (funcall (nth 2 class-sectionning) level numberedp) - (nth (1+ level) class-sectionning)))) + (let ((sec (if (and (symbolp (nth 2 class-sectioning)) + (fboundp (nth 2 class-sectioning))) + (funcall (nth 2 class-sectioning) level numberedp) + (nth (1+ level) class-sectioning)))) (cond ;; No section available for that LEVEL. ((not sec) nil) diff --git a/lisp/ox.el b/lisp/ox.el index c5f369924..8316ef26e 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -2870,7 +2870,7 @@ The copy will preserve local variables, visibility, contents and narrowing of the original buffer. If a region was active in BUFFER, contents will be narrowed to that region instead. -The resulting function can be evaled at a later time, from +The resulting function can be evaluated at a later time, from another buffer, effectively cloning the original buffer there. The function assumes BUFFER's major mode is `org-mode'." @@ -4682,7 +4682,7 @@ INFO is a plist used as a communication channel." "Return TABLE-ROW number. INFO is a plist used as a communication channel. Return value is zero-based and ignores separators. The function returns nil for -special colums and separators." +special columns and separators." (when (and (eq (org-element-property :type table-row) 'standard) (not (org-export-table-row-is-special-p table-row info))) (let ((number 0)) @@ -5874,7 +5874,7 @@ files or buffers, only the display. "Export dispatcher for Org mode. It provides an access to common export related tasks in a buffer. -Its interface comes in two flavours: standard and expert. +Its interface comes in two flavors: standard and expert. While both share the same set of bindings, only the former displays the valid keys associations in a dedicated buffer. @@ -5882,7 +5882,7 @@ Scrolling (resp. line-wise motion) in this buffer is done with SPC and DEL (resp. C-n and C-p) keys. Set variable `org-export-dispatch-use-expert-ui' to switch to one -flavour or the other. +flavor or the other. When ARG is \\[universal-argument], repeat the last export action, with the same set of options used back then, on the current buffer. From 4e798549fea189393f74583371809ab13e884b86 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Sun, 17 Nov 2013 09:15:25 +0100 Subject: [PATCH 128/166] Backport Paul's fixes from Emacs trunk (2/2) See http://article.gmane.org/gmane.emacs.diffs/123123 --- lisp/org.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 2781c677c..f47caa11a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -720,7 +720,7 @@ the following lines anywhere in the buffer: "Non-nil means preview LaTeX fragments when loading a new Org file. This can also be configured on a per-file basis by adding one of -the followinglines anywhere in the buffer: +the following lines anywhere in the buffer: #+STARTUP: latexpreview #+STARTUP: nolatexpreview" :group 'org-startup @@ -1044,7 +1044,7 @@ commands in the Help buffer using the `?' speed command." :last-refile "org-refile-last-stored" :last-capture-marker "org-capture-last-stored-marker") "Names for bookmarks automatically set by some Org commands. -This can provide strings as names for a number of bookmakrs Org sets +This can provide strings as names for a number of bookmarks Org sets automatically. The following keys are currently implemented: :last-capture :last-capture-marker @@ -19521,7 +19521,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names." "Transpose words for Org. This uses the `org-mode-transpose-word-syntax-table' syntax table, which interprets characters in `org-emphasis-alist' as -word constituants." +word constituents." (interactive) (with-syntax-table org-mode-transpose-word-syntax-table (call-interactively 'transpose-words))) @@ -21127,7 +21127,7 @@ With prefix arg UNCOMPILED, load the uncompiled versions." (message "The following feature%s found in load-path, please check if that's correct:\n%s" (if (> (length load-uncore) 1) "s were" " was") load-uncore)) (if load-misses - (message "Some error occured while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" + (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) From 36c8d8b4d22007e2d24104c31e3a76de83095b53 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 17 Nov 2013 09:52:54 +0100 Subject: [PATCH 129/166] org-footnote: Fix dual `org-load-hook' run * lisp/org-footnote.el (org-footnote-section): Do not require `org-element' when initializing the variable, since `org' is not provided yet. --- lisp/org-footnote.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-footnote.el b/lisp/org-footnote.el index e80f36fde..f4c9273b4 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -113,7 +113,7 @@ you will need to run the following command after the change: \\[universal-argument] \\[org-element-cache-reset]" :group 'org-footnote - :initialize 'custom-initialize-set + :initialize 'custom-initialize-default :set (lambda (var val) (set var val) (when (fboundp 'org-element-cache-reset) From 246c8c6637a86d9b66b7ae01672825ab58c35b63 Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Sun, 17 Nov 2013 11:54:00 +0100 Subject: [PATCH 130/166] org-license.el: remove my-org-switch-language function. --- contrib/lisp/org-license.el | 20 ++------------------ 1 file changed, 2 insertions(+), 18 deletions(-) diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el index b452706ac..dc6d78664 100644 --- a/contrib/lisp/org-license.el +++ b/contrib/lisp/org-license.el @@ -39,24 +39,6 @@ (defvar org-license-images-directory "") -(defun my-org-switch-language () -"Switch language if a `#+LANGUAGE:' Org meta-tag is on top 8 lines." -(save-excursion - (let (lang - (license-alist '(("br" . "brazilian") - ("ca" . "catalan") - ("de" . "deutsch") - ("en" . "american") - ("eo" . "esperanto") - ("eu" . "euskera") - ("es" . "spanish")))) - (when (re-search-backward "#\\+LANGUAGE: +\\([[:alpha:]_]*\\)" 1 t) - (setq lang (match-string 1)) -;; (message lang) - (ispell-change-dictionary (cdr (assoc lang dico-alist))))))) - -(add-hook 'org-mode-hook 'my-org-switch-language) - (defun org-license-cc-by (language) (interactive "MLanguage ( br | ca | de | en | es | eo | eu | fi | fr | gl | it | jp | nl | pt ): " language) (cond ((equal language "br") @@ -521,3 +503,5 @@ Copyright (C) 2013 " user-full-name (org-license-cc-by-nc-nd "nl") (org-license-cc-by-nc-nd "pt") ) + + From 971a3a4e485c897b8b6c2c1c244d02cb8d943167 Mon Sep 17 00:00:00 2001 From: Michael Brand Date: Sun, 17 Nov 2013 12:00:18 +0100 Subject: [PATCH 131/166] Hyperlink: Use url-encode-url for browse-url * lisp/org.el (org-open-at-point): When available (Emacs 24.3.1) use `url-encode-url' instead of `org-link-escape-browser'. --- lisp/org.el | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index ed3928fab..5cfaa2cd9 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -10520,11 +10520,29 @@ application the system uses for this file type." (apply cmd (nreverse args1)))) ((member type '("http" "https" "ftp" "news")) - (browse-url (concat type ":" (org-link-escape-browser path)))) + ;; In the example of the http Org link + ;; [[http://lists.gnu.org/archive/cgi-bin/namazu.cgi?idxname=emacs-orgmode&query=%252Bsubject:"Release+8.2"]] + ;; to open a browser with +subject:"Release 8.2" in the + ;; query field the variable `path' contains + ;; [...]=%2Bsubject:"Release+8.2", `url-encode-url' + ;; converts correct to [...]=%2Bsubject:%22Release+8.2%22 + ;; and `org-link-escape-browser' converts wrong to + ;; [...]=%252Bsubject:%22Release+8.2%22. + ;; + ;; `url-encode-url' is available since Emacs 24.3.1 and + ;; `org-link-escape-browser' can be removed altogether + ;; once Org drops support for Emacs 24.1 and 24.2. + (browse-url (funcall (if (fboundp 'url-encode-url) + #'url-encode-url + #'org-link-escape-browser) + (concat type ":" path)))) ((string= type "doi") - (browse-url (concat org-doi-server-url - (org-link-escape-browser path)))) + ;; See comments for type http above + (browse-url (funcall (if (fboundp 'url-encode-url) + #'url-encode-url + #'org-link-escape-browser) + (concat org-doi-server-url path)))) ((member type '("message")) (browse-url (concat type ":" path))) From 739b2649c74d01ecb515cc922d99bf26b6d403d7 Mon Sep 17 00:00:00 2001 From: Paul Sexton Date: Mon, 18 Nov 2013 07:18:52 +1300 Subject: [PATCH 132/166] Updated org-drill to latest version. --- contrib/lisp/org-drill.el | 543 ++++++++++++++++++++++++++------------ 1 file changed, 380 insertions(+), 163 deletions(-) diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index 5bf6dd490..2fedd476b 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -1,73 +1,72 @@ -;; -*- coding: utf-8-unix -*- +;;; -*- coding: utf-8-unix -*- ;;; org-drill.el - Self-testing using spaced repetition ;;; -;; Author: Paul Sexton -;; Version: 2.3.7 -;; Repository at http://bitbucket.org/eeeickythump/org-drill/ -;; -;; This file is not part of GNU Emacs. -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see . - -;;; Commentary and synopsis: +;;; Author: Paul Sexton +;;; Version: 2.4.0 +;;; Repository at http://bitbucket.org/eeeickythump/org-drill/ ;;; -;; Uses the SuperMemo spaced repetition algorithms to conduct interactive -;; "drill sessions", where the material to be remembered is presented to the -;; student in random order. The student rates his or her recall of each item, -;; and this information is used to schedule the item for later revision. -;; -;; Each drill session can be restricted to topics in the current buffer -;; (default), one or several files, all agenda files, or a subtree. A single -;; topic can also be drilled. -;; -;; Different "card types" can be defined, which present their information to -;; the student in different ways. -;; -;; See the file README.org for more detailed documentation. -;; -;;; Code: +;;; +;;; Synopsis +;;; ======== +;;; +;;; Uses the SuperMemo spaced repetition algorithms to conduct interactive +;;; "drill sessions", where the material to be remembered is presented to the +;;; student in random order. The student rates his or her recall of each item, +;;; and this information is used to schedule the item for later revision. +;;; +;;; Each drill session can be restricted to topics in the current buffer +;;; (default), one or several files, all agenda files, or a subtree. A single +;;; topic can also be drilled. +;;; +;;; Different "card types" can be defined, which present their information to +;;; the student in different ways. +;;; +;;; See the file README.org for more detailed documentation. + (eval-when-compile (require 'cl)) (eval-when-compile (require 'hi-lock)) +(require 'cl-lib) +(require 'hi-lock) (require 'org) (require 'org-id) (require 'org-learn) + (defgroup org-drill nil "Options concerning interactive drill sessions in Org mode (org-drill)." :tag "Org-Drill" :group 'org-link) -(defcustom org-drill-question-tag "drill" + + +(defcustom org-drill-question-tag + "drill" "Tag which topics must possess in order to be identified as review topics by `org-drill'." :group 'org-drill :type 'string) -(defcustom org-drill-maximum-items-per-session 30 + +(defcustom org-drill-maximum-items-per-session + 30 "Each drill session will present at most this many topics for review. Nil means unlimited." :group 'org-drill :type '(choice integer (const nil))) -(defcustom org-drill-maximum-duration 20 + + +(defcustom org-drill-maximum-duration + 20 "Maximum duration of a drill session, in minutes. Nil means unlimited." :group 'org-drill :type '(choice integer (const nil))) -(defcustom org-drill-failure-quality 2 + +(defcustom org-drill-failure-quality + 2 "If the quality of recall for an item is this number or lower, it is regarded as an unambiguous failure, and the repetition interval for the card is reset to 0 days. If the quality is higher @@ -81,7 +80,9 @@ really sensible." :group 'org-drill :type '(choice (const 2) (const 1))) -(defcustom org-drill-forgetting-index 10 + +(defcustom org-drill-forgetting-index + 10 "What percentage of items do you consider it is 'acceptable' to forget each drill session? The default is 10%. A warning message is displayed at the end of the session if the percentage forgotten @@ -89,13 +90,17 @@ climbs above this number." :group 'org-drill :type 'integer) -(defcustom org-drill-leech-failure-threshold 15 + +(defcustom org-drill-leech-failure-threshold + 15 "If an item is forgotten more than this many times, it is tagged as a 'leech' item." :group 'org-drill :type '(choice integer (const nil))) -(defcustom org-drill-leech-method 'skip + +(defcustom org-drill-leech-method + 'skip "How should 'leech items' be handled during drill sessions? Possible values: - nil :: Leech items are treated the same as normal items. @@ -106,60 +111,87 @@ Possible values: :group 'org-drill :type '(choice (const 'warn) (const 'skip) (const nil))) + (defface org-drill-visible-cloze-face '((t (:foreground "darkseagreen"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) + (defface org-drill-visible-cloze-hint-face '((t (:foreground "dark slate blue"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) + (defface org-drill-hidden-cloze-face '((t (:foreground "deep sky blue" :background "blue"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) -(defcustom org-drill-use-visible-cloze-face-p nil + +(defcustom org-drill-use-visible-cloze-face-p + nil "Use a special face to highlight cloze-deleted text in org mode buffers?" :group 'org-drill :type 'boolean) -(defcustom org-drill-hide-item-headings-p nil + +(defcustom org-drill-hide-item-headings-p + nil "Conceal the contents of the main heading of each item during drill sessions? You may want to enable this behaviour if item headings or tags contain information that could 'give away' the answer." :group 'org-drill :type 'boolean) -(defcustom org-drill-new-count-color "royal blue" + +(defcustom org-drill-new-count-color + "royal blue" "Foreground colour used to display the count of remaining new items during a drill session." :group 'org-drill :type 'color) -(defcustom org-drill-mature-count-color "green" +(defcustom org-drill-mature-count-color + "green" "Foreground colour used to display the count of remaining mature items during a drill session. Mature items are due for review, but are not new." :group 'org-drill :type 'color) -(defcustom org-drill-failed-count-color "red" +(defcustom org-drill-failed-count-color + "red" "Foreground colour used to display the count of remaining failed items during a drill session." :group 'org-drill :type 'color) -(defcustom org-drill-done-count-color "sienna" +(defcustom org-drill-done-count-color + "sienna" "Foreground colour used to display the count of reviewed items during a drill session." :group 'org-drill :type 'color) +(defcustom org-drill-left-cloze-delimiter + "[" + "String used within org buffers to delimit cloze deletions." + :group 'org-drill + :type 'string) + +(defcustom org-drill-right-cloze-delimiter + "]" + "String used within org buffers to delimit cloze deletions." + :group 'org-drill + :type 'string) + + (setplist 'org-drill-cloze-overlay-defaults - '(display "[...]" + `(display ,(format "%s...%s" + org-drill-left-cloze-delimiter + org-drill-right-cloze-delimiter) face org-drill-hidden-cloze-face window t)) @@ -171,21 +203,35 @@ during a drill session." face default window t)) + (defvar org-drill-hint-separator "||" "String which, if it occurs within a cloze expression, signifies that the rest of the expression after the string is a `hint', to be displayed instead of the hidden cloze during a test.") -(defvar org-drill-cloze-regexp - (concat "\\(\\[[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|" +(defun org-drill--compute-cloze-regexp () + (concat "\\(" + (regexp-quote org-drill-left-cloze-delimiter) + "[[:cntrl:][:graph:][:space:]]+?\\)\\(\\|" (regexp-quote org-drill-hint-separator) - ".+?\\)\\(\\]\\)")) + ".+?\\)\\(" + (regexp-quote org-drill-right-cloze-delimiter) + "\\)")) + +(defun org-drill--compute-cloze-keywords () + (list (list (org-drill--compute-cloze-regexp) + (copy-list '(1 'org-drill-visible-cloze-face nil)) + (copy-list '(2 'org-drill-visible-cloze-hint-face t)) + (copy-list '(3 'org-drill-visible-cloze-face nil)) + ))) + +(defvar-local org-drill-cloze-regexp + (org-drill--compute-cloze-regexp)) + + +(defvar-local org-drill-cloze-keywords + (org-drill--compute-cloze-keywords)) -(defvar org-drill-cloze-keywords - `((,org-drill-cloze-regexp - (1 'org-drill-visible-cloze-face nil) - (2 'org-drill-visible-cloze-hint-face t) - (3 'org-drill-visible-cloze-face nil)))) (defcustom org-drill-card-type-alist '((nil org-drill-present-simple-card) @@ -234,7 +280,9 @@ even if their bodies are empty." :type '(alist :key-type (choice string (const nil)) :value-type function)) -(defcustom org-drill-scope 'file + +(defcustom org-drill-scope + 'file "The scope in which to search for drill items when conducting a drill session. This can be any of: @@ -261,13 +309,25 @@ directory All files with the extension '.org' in the same (const 'agenda-with-archives) (const 'directory) list)) -(defcustom org-drill-save-buffers-after-drill-sessions-p t + +(defcustom org-drill-match + nil + "If non-nil, a string specifying a tags/property/TODO query. During +drill sessions, only items that match this query will be considered." + :group 'org-drill + :type '(choice (const nil) string)) + + +(defcustom org-drill-save-buffers-after-drill-sessions-p + t "If non-nil, prompt to save all modified buffers after a drill session finishes." :group 'org-drill :type 'boolean) -(defcustom org-drill-spaced-repetition-algorithm 'sm5 + +(defcustom org-drill-spaced-repetition-algorithm + 'sm5 "Which SuperMemo spaced repetition algorithm to use for scheduling items. Available choices are: - SM2 :: the SM2 algorithm, used in SuperMemo 2.0 @@ -282,7 +342,9 @@ Available choices are: :group 'org-drill :type '(choice (const 'sm2) (const 'sm5) (const 'simple8))) -(defcustom org-drill-optimal-factor-matrix nil + +(defcustom org-drill-optimal-factor-matrix + nil "DO NOT CHANGE THE VALUE OF THIS VARIABLE. Persistent matrix of optimal factors, used by the SuperMemo SM5 algorithm. @@ -294,14 +356,18 @@ pace of learning." :group 'org-drill :type 'sexp) -(defcustom org-drill-sm5-initial-interval 4.0 + +(defcustom org-drill-sm5-initial-interval + 4.0 "In the SM5 algorithm, the initial interval after the first successful presentation of an item is always 4 days. If you wish to change this, you can do so here." :group 'org-drill :type 'float) -(defcustom org-drill-add-random-noise-to-intervals-p nil + +(defcustom org-drill-add-random-noise-to-intervals-p + nil "If true, the number of days until an item's next repetition will vary slightly from the interval calculated by the SM2 algorithm. The variation is very small when the interval is @@ -309,7 +375,9 @@ small, but scales up with the interval." :group 'org-drill :type 'boolean) -(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p nil + +(defcustom org-drill-adjust-intervals-for-early-and-late-repetitions-p + nil "If true, when the student successfully reviews an item 1 or more days before or after the scheduled review date, this will affect that date of the item's next scheduled review, according to the algorithm presented at @@ -324,7 +392,9 @@ is used." :group 'org-drill :type 'boolean) -(defcustom org-drill-cloze-text-weight 4 + +(defcustom org-drill-cloze-text-weight + 4 "For card types 'hide1_firstmore', 'show1_lastmore' and 'show1_firstless', this number determines how often the 'less favoured' situation should arise. It will occur 1 in every N trials, where N is the @@ -343,12 +413,15 @@ all weighted card types are treated as their unweighted equivalents." :group 'org-drill :type '(choice integer (const nil))) -(defcustom org-drill-cram-hours 12 + +(defcustom org-drill-cram-hours + 12 "When in cram mode, items are considered due for review if they were reviewed at least this many hours ago." :group 'org-drill :type 'integer) + ;;; NEW items have never been presented in a drill session before. ;;; MATURE items HAVE been presented at least once before. ;;; - YOUNG mature items were scheduled no more than @@ -361,13 +434,17 @@ they were reviewed at least this many hours ago." ;;; LAST-INTERVAL * (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) days, ;;; regardless of young/old status. -(defcustom org-drill-days-before-old 10 + +(defcustom org-drill-days-before-old + 10 "When an item's inter-repetition interval rises above this value in days, it is no longer considered a 'young' (recently learned) item." :group 'org-drill :type 'integer) -(defcustom org-drill-overdue-interval-factor 1.2 + +(defcustom org-drill-overdue-interval-factor + 1.2 "An item is considered overdue if its scheduled review date is more than (ORG-DRILL-OVERDUE-INTERVAL-FACTOR - 1) * LAST-INTERVAL days in the past. For example, a value of 1.2 means an additional @@ -379,7 +456,9 @@ should never be less than 1.0." :group 'org-drill :type 'float) -(defcustom org-drill-learn-fraction 0.5 + +(defcustom org-drill-learn-fraction + 0.5 "Fraction between 0 and 1 that governs how quickly the spaces between successive repetitions increase, for all items. The default value is 0.5. Higher values make spaces increase more @@ -389,6 +468,7 @@ exponential effect on inter-repetition spacing." :group 'org-drill :type 'float) + (defvar drill-answer nil "Global variable that can be bound to a correct answer when an item is being presented. If this variable is non-nil, the default @@ -399,6 +479,7 @@ This variable is useful for card types that compute their answers -- for example, a card type that asks the student to translate a random number to another language. ") + (defvar *org-drill-session-qualities* nil) (defvar *org-drill-start-time* 0) (defvar *org-drill-new-entries* nil) @@ -428,8 +509,10 @@ for review unless they were already reviewed in the recent past?") "DRILL_TOTAL_REPEATS" "DRILL_FAILURE_COUNT" "DRILL_AVERAGE_QUALITY" "DRILL_EASE" "DRILL_LAST_QUALITY" "DRILL_LAST_REVIEWED")) + ;;; Make the above settings safe as file-local variables. + (put 'org-drill-question-tag 'safe-local-variable 'stringp) (put 'org-drill-maximum-items-per-session 'safe-local-variable '(lambda (val) (or (integerp val) (null val)))) @@ -454,15 +537,22 @@ for review unless they were already reviewed in the recent past?") (put 'org-drill-overdue-interval-factor 'safe-local-variable 'floatp) (put 'org-drill-scope 'safe-local-variable '(lambda (val) (or (symbolp val) (listp val)))) +(put 'org-drill-match 'safe-local-variable + '(lambda (val) (or (stringp val) (null val)))) (put 'org-drill-save-buffers-after-drill-sessions-p 'safe-local-variable 'booleanp) (put 'org-drill-cloze-text-weight 'safe-local-variable '(lambda (val) (or (null val) (integerp val)))) +(put 'org-drill-left-cloze-delimiter 'safe-local-variable 'stringp) +(put 'org-drill-right-cloze-delimiter 'safe-local-variable 'stringp) + ;;;; Utilities ================================================================ + (defun free-marker (m) (set-marker m nil)) + (defmacro pop-random (place) (let ((idx (gensym))) `(if (null ,place) @@ -472,11 +562,13 @@ for review unless they were already reviewed in the recent past?") (setq ,place (append (subseq ,place 0 ,idx) (subseq ,place (1+ ,idx))))))))) + (defmacro push-end (val place) "Add VAL to the end of the sequence stored in PLACE. Return the new value." `(setq ,place (append ,place (list ,val)))) + (defun shuffle-list (list) "Randomly permute the elements of LIST (all permutations equally likely)." ;; Adapted from 'shuffle-vector' in cookie1.el @@ -492,28 +584,43 @@ value." (setq i (1+ i)))) list) + (defun round-float (floatnum fix) "Round the floating point number FLOATNUM to FIX decimal places. Example: (round-float 3.56755765 3) -> 3.568" (let ((n (expt 10 fix))) (/ (float (round (* floatnum n))) n))) + (defun command-keybinding-to-string (cmd) "Return a human-readable description of the key/keys to which the command CMD is bound, or nil if it is not bound to a key." (let ((key (where-is-internal cmd overriding-local-map t))) (if key (key-description key)))) + (defun time-to-inactive-org-timestamp (time) (format-time-string (concat "[" (substring (cdr org-time-stamp-formats) 1 -1) "]") time)) -(defun org-map-drill-entries (func &optional scope &rest skip) + +(defun time-to-active-org-timestamp (time) + (format-time-string + (concat "<" (substring (cdr org-time-stamp-formats) 1 -1) ">") + time)) + + +(defun org-map-drill-entries (func &optional scope drill-match &rest skip) "Like `org-map-entries', but only drill entries are processed." - (let ((org-drill-scope (or scope org-drill-scope))) + (let ((org-drill-scope (or scope org-drill-scope)) + (org-drill-match (or drill-match org-drill-match))) (apply 'org-map-entries func - (concat "+" org-drill-question-tag) + (concat "+" org-drill-question-tag + (if (and (stringp org-drill-match) + (not (member '(?+ ?- ?|) (elt org-drill-match 0)))) + "+" "") + (or org-drill-match "")) (case org-drill-scope (file nil) (file-no-restriction 'file) @@ -523,6 +630,7 @@ CMD is bound, or nil if it is not bound to a key." (t org-drill-scope)) skip))) + (defmacro with-hidden-cloze-text (&rest body) `(progn (org-drill-hide-clozed-text) @@ -531,6 +639,7 @@ CMD is bound, or nil if it is not bound to a key." ,@body) (org-drill-unhide-clozed-text)))) + (defmacro with-hidden-cloze-hints (&rest body) `(progn (org-drill-hide-cloze-hints) @@ -539,6 +648,7 @@ CMD is bound, or nil if it is not bound to a key." ,@body) (org-drill-unhide-text)))) + (defmacro with-hidden-comments (&rest body) `(progn (if org-drill-hide-item-headings-p @@ -549,6 +659,7 @@ CMD is bound, or nil if it is not bound to a key." ,@body) (org-drill-unhide-text)))) + (defun org-drill-days-since-last-review () "Nil means a last review date has not yet been stored for the item. @@ -562,6 +673,7 @@ this should never happen." (time-to-days (apply 'encode-time (org-parse-time-string datestr))))))) + (defun org-drill-hours-since-last-review () "Like `org-drill-days-since-last-review', but return value is in hours rather than days." @@ -573,6 +685,7 @@ in hours rather than days." (org-parse-time-string datestr)))) (* 60 60)))))) + (defun org-drill-entry-p (&optional marker) "Is MARKER, or the point, in a 'drill item'? This will return nil if the point is inside a subheading of a drill item -- to handle that @@ -582,10 +695,12 @@ situation use `org-part-of-drill-entry-p'." (org-drill-goto-entry marker)) (member org-drill-question-tag (org-get-local-tags)))) + (defun org-drill-goto-entry (marker) (switch-to-buffer (marker-buffer marker)) (goto-char marker)) + (defun org-part-of-drill-entry-p () "Is the current entry either the main heading of a 'drill item', or a subheading within a drill item?" @@ -593,6 +708,7 @@ or a subheading within a drill item?" ;; Does this heading INHERIT the drill tag (member org-drill-question-tag (org-get-tags-at)))) + (defun org-drill-goto-drill-entry-heading () "Move the point to the heading which holds the :drill: tag for this drill entry." @@ -604,11 +720,14 @@ drill entry." (unless (org-up-heading-safe) (error "Cannot find a parent heading that is marked as a drill entry")))) + + (defun org-drill-entry-leech-p () "Is the current entry a 'leech item'?" (and (org-drill-entry-p) (member "leech" (org-get-local-tags)))) + ;; (defun org-drill-entry-due-p () ;; (cond ;; (*org-drill-cram-mode* @@ -626,6 +745,7 @@ drill entry." ;; (- (time-to-days (current-time)) ;; (time-to-days item-time)))))))))) + (defun org-drill-entry-days-overdue () "Returns: - NIL if the item is not to be regarded as scheduled for review at all. @@ -655,6 +775,7 @@ drill entry." (- (time-to-days (current-time)) (time-to-days item-time)))))))) + (defun org-drill-entry-overdue-p (&optional days-overdue last-interval) "Returns true if entry that is scheduled DAYS-OVERDUE dasy in the past, and whose last inter-repetition interval was LAST-INTERVAL, should be @@ -670,28 +791,34 @@ from the entry at point." (> (/ (+ days-overdue last-interval 1.0) last-interval) org-drill-overdue-interval-factor))) + + (defun org-drill-entry-due-p () (let ((due (org-drill-entry-days-overdue))) (and (not (null due)) (not (minusp due))))) + (defun org-drill-entry-new-p () (and (org-drill-entry-p) (let ((item-time (org-get-scheduled-time (point)))) (null item-time)))) + (defun org-drill-entry-last-quality (&optional default) (let ((quality (org-entry-get (point) "DRILL_LAST_QUALITY"))) (if quality (string-to-number quality) default))) + (defun org-drill-entry-failure-count () (let ((quality (org-entry-get (point) "DRILL_FAILURE_COUNT"))) (if quality (string-to-number quality) 0))) + (defun org-drill-entry-average-quality (&optional default) (let ((val (org-entry-get (point) "DRILL_AVERAGE_QUALITY"))) (if val @@ -722,16 +849,17 @@ from the entry at point." (string-to-number val) default))) + ;;; From http://www.supermemo.com/english/ol/sm5.htm (defun org-drill-random-dispersal-factor () "Returns a random number between 0.5 and 1.5." (let ((a 0.047) (b 0.092) (p (- (random* 1.0) 0.5))) - (flet ((sign (n) - (cond ((zerop n) 0) - ((plusp n) 1) - (t -1)))) + (cl-flet ((sign (n) + (cond ((zerop n) 0) + ((plusp n) 1) + (t -1)))) (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p))))) (sign p))) 100.0)))) @@ -744,9 +872,10 @@ from the entry at point." (- variation) mean)) + (defun org-drill-early-interval-factor (optimal-factor - optimal-interval - days-ahead) + optimal-interval + days-ahead) "Arguments: - OPTIMAL-FACTOR: interval-factor if the item had been tested exactly when it was supposed to be. @@ -763,6 +892,7 @@ in the matrix." (- optimal-factor (* delta-ofmax (/ days-ahead (+ days-ahead (* 0.6 optimal-interval))))))) + (defun org-drill-get-item-data () "Returns a list of 6 items, containing all the stored recall data for the item at point: @@ -800,6 +930,7 @@ in the matrix." (t ; virgin item (list 0 0 0 0 nil nil))))) + (defun org-drill-store-item-data (last-interval repeats failures total-repeats meanq ease) @@ -815,8 +946,11 @@ in the matrix." (org-set-property "DRILL_EASE" (number-to-string (round-float ease 3)))) + + ;;; SM2 Algorithm ============================================================= + (defun determine-next-interval-sm2 (last-interval n ef quality failures meanq total-repeats) "Arguments: @@ -865,6 +999,8 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher ;;; SM5 Algorithm ============================================================= + + (defun initial-optimal-factor-sm5 (n ef) (if (= 1 n) org-drill-sm5-initial-interval @@ -877,6 +1013,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (and ef-of (cdr ef-of)))) (initial-optimal-factor-sm5 n ef)))) + (defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix) (let ((of (get-optimal-factor-sm5 n ef (or of-matrix org-drill-optimal-factor-matrix)))) @@ -884,6 +1021,7 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher of (* of last-interval)))) + (defun determine-next-interval-sm5 (last-interval n ef quality failures meanq total-repeats of-matrix &optional delta-days) @@ -894,10 +1032,12 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (unless of-matrix (setq of-matrix org-drill-optimal-factor-matrix)) (setq of-matrix (cl-copy-tree of-matrix)) + (setq meanq (if meanq (/ (+ quality (* meanq total-repeats 1.0)) (1+ total-repeats)) quality)) + (let ((next-ef (modify-e-factor ef quality)) (old-ef ef) (new-of (modify-of (get-optimal-factor-sm5 n ef of-matrix) @@ -910,10 +1050,13 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (inter-repetition-interval-sm5 last-interval n ef of-matrix) delta-days))) + (setq of-matrix (set-optimal-factor n next-ef of-matrix (round-float new-of 3))) ; round OF to 3 d.p. + (setq ef next-ef) + (cond ;; "Failed" -- reset repetitions to 0, ((<= quality org-drill-failure-quality) @@ -938,8 +1081,10 @@ Returns a list: (INTERVAL REPEATS EF FAILURES MEAN TOTAL-REPEATS OFMATRIX), wher (1+ total-repeats) of-matrix))))) + ;;; Simple8 Algorithm ========================================================= + (defun org-drill-simple8-first-interval (failures) "Arguments: - FAILURES: integer >= 0. The total number of times the item has @@ -949,6 +1094,7 @@ Returns the optimal FIRST interval for an item which has previously been forgotten on FAILURES occasions." (* 2.4849 (exp (* -0.057 failures)))) + (defun org-drill-simple8-interval-factor (ease repetition) "Arguments: - EASE: floating point number >= 1.2. Corresponds to `AF' in SM8 algorithm. @@ -959,6 +1105,7 @@ The factor by which the last interval should be multiplied to give the next interval. Corresponds to `RF' or `OF'." (+ 1.2 (* (- ease 1.2) (expt org-drill-learn-fraction (log repetition 2))))) + (defun org-drill-simple8-quality->ease (quality) "Returns the ease (`AF' in the SM8 algorithm) which corresponds to a mean item quality of QUALITY." @@ -968,6 +1115,7 @@ to a mean item quality of QUALITY." (* -1.2403 quality) 1.4515)) + (defun determine-next-interval-simple8 (last-interval repeats quality failures meanq totaln &optional delta-days) @@ -1034,7 +1182,11 @@ See the documentation for `org-drill-get-item-data' for a description of these." (org-drill-simple8-quality->ease meanq) failures meanq - totaln))) + totaln + ))) + + + ;;; Essentially copied from `org-learn.el', but modified to ;;; optionally call the SM2 or simple8 functions. @@ -1087,7 +1239,7 @@ item will be scheduled exactly this many days into the future." (cond ((= 0 days-ahead) - (org-schedule t)) + (org-schedule '(4))) ((minusp days-ahead) (org-schedule nil (current-time))) (t @@ -1207,13 +1359,14 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)" (sit-for 0.5))))) (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality)) (org-set-property "DRILL_LAST_REVIEWED" - (time-to-inactive-org-timestamp (current-time)))) + (time-to-active-org-timestamp (current-time)))) quality)) ((= ch ?e) 'edit) (t nil)))) + ;; (defun org-drill-hide-all-subheadings-except (heading-list) ;; "Returns a list containing the position of each immediate subheading of ;; the current topic." @@ -1234,6 +1387,8 @@ How well did you do? (0-5, ?=help, e=edit, t=tags, q=quit)" ;; "" 'tree)) ;; (reverse drill-sections))) + + (defun org-drill-hide-subheadings-if (test) "TEST is a function taking no arguments. TEST will be called for each of the immediate subheadings of the current drill item, with the point @@ -1256,11 +1411,13 @@ the current topic." "" 'tree)) (reverse drill-sections))) + (defun org-drill-hide-all-subheadings-except (heading-list) (org-drill-hide-subheadings-if (lambda () (let ((drill-heading (org-get-heading t))) (not (member drill-heading heading-list)))))) + (defun org-drill-presentation-prompt (&rest fmt-and-args) (let* ((item-start-time (current-time)) (input nil) @@ -1341,22 +1498,26 @@ Consider reformulating the item to make it easier to remember.\n" (?s 'skip) (otherwise t)))) + (defun org-pos-in-regexp (pos regexp &optional nlines) (save-excursion (goto-char pos) (org-in-regexp regexp nlines))) + (defun org-drill-hide-region (beg end &optional text) "Hide the buffer region between BEG and END with an 'invisible text' visual overlay, or with the string TEXT if it is supplied." (let ((ovl (make-overlay beg end))) (overlay-put ovl 'category 'org-drill-hidden-text-overlay) + (overlay-put ovl 'priority 9999) (when (stringp text) (overlay-put ovl 'invisible nil) (overlay-put ovl 'face 'default) (overlay-put ovl 'display text)))) + (defun org-drill-hide-heading-at-point (&optional text) (unless (org-at-heading-p) (error "Point is not on a heading.")) @@ -1365,11 +1526,13 @@ visual overlay, or with the string TEXT if it is supplied." (end-of-line) (org-drill-hide-region beg (point) text)))) + (defun org-drill-hide-comments () (save-excursion (while (re-search-forward "^#.*$" nil t) (org-drill-hide-region (match-beginning 0) (match-end 0))))) + (defun org-drill-unhide-text () ;; This will also unhide the item's heading. (save-excursion @@ -1377,16 +1540,20 @@ visual overlay, or with the string TEXT if it is supplied." (when (eql 'org-drill-hidden-text-overlay (overlay-get ovl 'category)) (delete-overlay ovl))))) + (defun org-drill-hide-clozed-text () (save-excursion (while (re-search-forward org-drill-cloze-regexp nil t) ;; Don't hide org links, partly because they might contain inline - ;; images which we want to keep visible + ;; images which we want to keep visible. + ;; And don't hide LaTeX math fragments. (unless (save-match-data - (org-pos-in-regexp (match-beginning 0) - org-bracket-link-regexp 1)) + (or (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1) + (org-inside-LaTeX-fragment-p))) (org-drill-hide-matched-cloze-text))))) + (defun org-drill-hide-matched-cloze-text () "Hide the current match with a 'cloze' visual overlay." (let ((ovl (make-overlay (match-beginning 0) (match-end 0))) @@ -1394,6 +1561,7 @@ visual overlay, or with the string TEXT if it is supplied." (match-string 0)))) (overlay-put ovl 'category 'org-drill-cloze-overlay-defaults) + (overlay-put ovl 'priority 9999) (when (and hint-sep-pos (> hint-sep-pos 1)) (let ((hint (substring-no-properties @@ -1407,6 +1575,7 @@ visual overlay, or with the string TEXT if it is supplied." (format (if (string-match-p (regexp-quote "...") hint) "[%s]" "[%s...]") hint)))))) + (defun org-drill-hide-cloze-hints () (save-excursion (while (re-search-forward org-drill-cloze-regexp nil t) @@ -1416,6 +1585,7 @@ visual overlay, or with the string TEXT if it is supplied." (null (match-beginning 2))) ; hint subexpression matched (org-drill-hide-region (match-beginning 2) (match-end 2)))))) + (defmacro with-replaced-entry-text (text &rest body) "During the execution of BODY, the entire text of the current entry is concealed by an overlay that displays the string TEXT." @@ -1426,6 +1596,7 @@ concealed by an overlay that displays the string TEXT." ,@body) (org-drill-unreplace-entry-text)))) + (defmacro with-replaced-entry-text-multi (replacements &rest body) "During the execution of BODY, the entire text of the current entry is concealed by an overlay that displays the overlays in REPLACEMENTS." @@ -1436,6 +1607,7 @@ concealed by an overlay that displays the overlays in REPLACEMENTS." ,@body) (org-drill-unreplace-entry-text)))) + (defun org-drill-replace-entry-text (text &optional multi-p) "Make an overlay that conceals the entire text of the item, not including properties or the contents of subheadings. The overlay shows @@ -1454,16 +1626,19 @@ Note: does not actually alter the item." (save-excursion (outline-next-heading) (point))))) + (overlay-put ovl 'priority 9999) (overlay-put ovl 'category 'org-drill-replaced-text-overlay) (overlay-put ovl 'display text))))) + (defun org-drill-unreplace-entry-text () (save-excursion (dolist (ovl (overlays-in (point-min) (point-max))) (when (eql 'org-drill-replaced-text-overlay (overlay-get ovl 'category)) (delete-overlay ovl))))) + (defun org-drill-replace-entry-text-multi (replacements) "Make overlays that conceal the entire text of the item, not including properties or the contents of subheadings. The overlay shows @@ -1480,10 +1655,12 @@ Note: does not actually alter the item." (if (= i (1- (length replacements))) p-max (+ p-min (* 2 i) 1)))) + (overlay-put ovl 'priority 9999) (overlay-put ovl 'category 'org-drill-replaced-text-overlay) (overlay-put ovl 'display (nth i replacements))))) + (defmacro with-replaced-entry-heading (heading &rest body) `(progn (org-drill-replace-entry-heading ,heading) @@ -1492,18 +1669,21 @@ Note: does not actually alter the item." ,@body) (org-drill-unhide-text)))) + (defun org-drill-replace-entry-heading (heading) "Make an overlay that conceals the heading of the item. The overlay shows the string TEXT. Note: does not actually alter the item." (org-drill-hide-heading-at-point heading)) + (defun org-drill-unhide-clozed-text () (save-excursion (dolist (ovl (overlays-in (point-min) (point-max))) (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category)) (delete-overlay ovl))))) + (defun org-drill-get-entry-text (&optional keep-properties-p) (let ((text (org-agenda-get-some-entry-text (point-marker) 100))) (if keep-properties-p @@ -1526,6 +1706,7 @@ Note: does not actually alter the item." (defun org-drill-entry-empty-p () (org-entry-empty-p)) + ;;; Presentation functions ==================================================== ;; ;; Each of these is called with point on topic heading. Each needs to show the @@ -1540,12 +1721,14 @@ Note: does not actually alter the item." (with-hidden-cloze-hints (with-hidden-cloze-text (org-drill-hide-all-subheadings-except nil) + (org-preview-latex-fragment) ; overlay all LaTeX fragments with images (ignore-errors (org-display-inline-images t)) (org-cycle-hide-drawers 'all) (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p)))))) + (defun org-drill-present-default-answer (reschedule-fn) (cond (drill-answer @@ -1557,12 +1740,14 @@ Note: does not actually alter the item." (t (org-drill-hide-subheadings-if 'org-drill-entry-p) (org-drill-unhide-clozed-text) + (org-preview-latex-fragment) (ignore-errors (org-display-inline-images t)) (org-cycle-hide-drawers 'all) (with-hidden-cloze-hints (funcall reschedule-fn))))) + (defun org-drill-present-two-sided-card () (with-hidden-comments (with-hidden-cloze-hints @@ -1573,12 +1758,15 @@ Note: does not actually alter the item." (goto-char (nth (random* (min 2 (length drill-sections))) drill-sections)) (org-show-subtree))) + (org-preview-latex-fragment) (ignore-errors (org-display-inline-images t)) (org-cycle-hide-drawers 'all) (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) + + (defun org-drill-present-multi-sided-card () (with-hidden-comments (with-hidden-cloze-hints @@ -1588,12 +1776,14 @@ Note: does not actually alter the item." (save-excursion (goto-char (nth (random* (length drill-sections)) drill-sections)) (org-show-subtree))) + (org-preview-latex-fragment) (ignore-errors (org-display-inline-images t)) (org-cycle-hide-drawers 'all) (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))))) + (defun org-drill-present-multicloze-hide-n (number-to-hide &optional force-show-first @@ -1628,7 +1818,8 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)." (let ((in-regexp? (save-match-data (org-pos-in-regexp (match-beginning 0) org-bracket-link-regexp 1)))) - (unless in-regexp? + (unless (or in-regexp? + (org-inside-LaTeX-fragment-p)) (incf match-count))))) (if (minusp number-to-hide) (setq number-to-hide (+ match-count number-to-hide))) @@ -1655,8 +1846,9 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)." (setq cnt 0) (while (re-search-forward org-drill-cloze-regexp item-end t) (unless (save-match-data - (org-pos-in-regexp (match-beginning 0) - org-bracket-link-regexp 1)) + (or (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1) + (org-inside-LaTeX-fragment-p))) (incf cnt) (if (memq cnt match-nums) (org-drill-hide-matched-cloze-text))))))) @@ -1666,6 +1858,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)." ;; while (org-pos-in-regexp (match-beginning 0) ;; org-bracket-link-regexp 1)) ;; (org-drill-hide-matched-cloze-text))))) + (org-preview-latex-fragment) (ignore-errors (org-display-inline-images t)) (org-cycle-hide-drawers 'all) @@ -1673,6 +1866,7 @@ items if FORCE-SHOW-FIRST or FORCE-SHOW-LAST is non-nil)." (org-drill-hide-subheadings-if 'org-drill-entry-p) (org-drill-unhide-clozed-text)))))) + (defun org-drill-present-multicloze-hide-nth (to-hide) "Hide the TO-HIDE'th piece of clozed text. 1 is the first piece. If TO-HIDE is negative, count backwards, so -1 means the last item, -2 @@ -1694,7 +1888,8 @@ the second to last, etc." (let ((in-regexp? (save-match-data (org-pos-in-regexp (match-beginning 0) org-bracket-link-regexp 1)))) - (unless in-regexp? + (unless (or in-regexp? + (org-inside-LaTeX-fragment-p)) (incf match-count))))) (if (minusp to-hide) (setq to-hide (+ 1 to-hide match-count))) @@ -1708,11 +1903,16 @@ the second to last, etc." (setq cnt 0) (while (re-search-forward org-drill-cloze-regexp item-end t) (unless (save-match-data - (org-pos-in-regexp (match-beginning 0) - org-bracket-link-regexp 1)) + ;; Don't consider this a cloze region if it is part of an + ;; org link, or if it occurs inside a LaTeX math + ;; fragment + (or (org-pos-in-regexp (match-beginning 0) + org-bracket-link-regexp 1) + (org-inside-LaTeX-fragment-p))) (incf cnt) (if (= cnt to-hide) (org-drill-hide-matched-cloze-text))))))) + (org-preview-latex-fragment) (ignore-errors (org-display-inline-images t)) (org-cycle-hide-drawers 'all) @@ -1720,24 +1920,29 @@ the second to last, etc." (org-drill-hide-subheadings-if 'org-drill-entry-p) (org-drill-unhide-clozed-text)))))) + (defun org-drill-present-multicloze-hide1 () "Hides one of the pieces of text that are marked for cloze deletion, chosen at random." (org-drill-present-multicloze-hide-n 1)) + (defun org-drill-present-multicloze-hide2 () "Hides two of the pieces of text that are marked for cloze deletion, chosen at random." (org-drill-present-multicloze-hide-n 2)) + (defun org-drill-present-multicloze-hide-first () "Hides the first piece of text that is marked for cloze deletion." (org-drill-present-multicloze-hide-nth 1)) + (defun org-drill-present-multicloze-hide-last () "Hides the last piece of text that is marked for cloze deletion." (org-drill-present-multicloze-hide-nth -1)) + (defun org-drill-present-multicloze-hide1-firstmore () "Commonly, hides the FIRST piece of text that is marked for cloze deletion. Uncommonly, hide one of the other pieces of text, @@ -1767,6 +1972,7 @@ the value of `org-drill-cloze-text-weight'." ;; Commonly, hide first item (org-drill-present-multicloze-hide-first)))) + (defun org-drill-present-multicloze-show1-lastmore () "Commonly, hides all pieces except the last. Uncommonly, shows any random piece. The effect is similar to 'show1cloze' except @@ -1791,6 +1997,7 @@ the value of `org-drill-cloze-text-weight'." ;; Commonly, show the LAST item (org-drill-present-multicloze-hide-n -1 nil t)))) + (defun org-drill-present-multicloze-show1-firstless () "Commonly, hides all pieces except one, where the shown piece is guaranteed NOT to be the first piece. Uncommonly, shows any @@ -1816,49 +2023,19 @@ the value of `org-drill-cloze-text-weight'." ;; Commonly, show any item, except the first (org-drill-present-multicloze-hide-n -1 nil nil t)))) + (defun org-drill-present-multicloze-show1 () "Similar to `org-drill-present-multicloze-hide1', but hides all the pieces of text that are marked for cloze deletion, except for one piece which is chosen at random." (org-drill-present-multicloze-hide-n -1)) + (defun org-drill-present-multicloze-show2 () "Similar to `org-drill-present-multicloze-show1', but reveals two pieces rather than one." (org-drill-present-multicloze-hide-n -2)) -;; (defun org-drill-present-multicloze-show1 () -;; "Similar to `org-drill-present-multicloze-hide1', but hides all -;; the pieces of text that are marked for cloze deletion, except for one -;; piece which is chosen at random." -;; (with-hidden-comments -;; (with-hidden-cloze-hints -;; (let ((item-end nil) -;; (match-count 0) -;; (body-start (or (cdr (org-get-property-block)) -;; (point)))) -;; (org-drill-hide-all-subheadings-except nil) -;; (save-excursion -;; (outline-next-heading) -;; (setq item-end (point))) -;; (save-excursion -;; (goto-char body-start) -;; (while (re-search-forward org-drill-cloze-regexp item-end t) -;; (incf match-count))) -;; (when (plusp match-count) -;; (let ((match-to-hide (random* match-count))) -;; (save-excursion -;; (goto-char body-start) -;; (dotimes (n match-count) -;; (re-search-forward org-drill-cloze-regexp -;; item-end t) -;; (unless (= n match-to-hide) -;; (org-drill-hide-matched-cloze-text)))))) -;; (org-display-inline-images t) -;; (org-cycle-hide-drawers 'all) -;; (prog1 (org-drill-presentation-prompt) -;; (org-drill-hide-subheadings-if 'org-drill-entry-p) -;; (org-drill-unhide-clozed-text)))))) (defun org-drill-present-card-using-text (question &optional answer) "Present the string QUESTION as the only visible content of the card. @@ -1874,6 +2051,7 @@ If ANSWER is supplied, set the global variable `drill-answer' to its value." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))) + (defun org-drill-present-card-using-multiple-overlays (replacements &optional answer) "TEXTS is a list of valid values for the 'display' text property. Present these overlays, in sequence, as the only @@ -1890,6 +2068,7 @@ If ANSWER is supplied, set the global variable `drill-answer' to its value." (prog1 (org-drill-presentation-prompt) (org-drill-hide-subheadings-if 'org-drill-entry-p))))) + (defun org-drill-entry () "Present the current topic for interactive review, as in `org-drill'. Review will occur regardless of whether the topic is due for review or whether @@ -1907,7 +2086,7 @@ See `org-drill' for more details." ;; (error "Point is not inside a drill entry")) ;;(unless (org-at-heading-p) ;; (org-back-to-heading)) - (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE")) + (let ((card-type (org-entry-get (point) "DRILL_CARD_TYPE" t)) (answer-fn 'org-drill-present-default-answer) (present-empty-cards nil) (cont nil) @@ -1949,6 +2128,7 @@ See `org-drill' for more details." (funcall answer-fn (lambda () (org-drill-reschedule))))))))))))) + (defun org-drill-entries-pending-p () (or *org-drill-again-entries* *org-drill-current-item* @@ -1961,6 +2141,7 @@ See `org-drill' for more details." *org-drill-overdue-entries* *org-drill-again-entries*)))) + (defun org-drill-pending-entry-count () (+ (if (markerp *org-drill-current-item*) 1 0) (length *org-drill-new-entries*) @@ -1970,6 +2151,7 @@ See `org-drill' for more details." (length *org-drill-overdue-entries*) (length *org-drill-again-entries*))) + (defun org-drill-maximum-duration-reached-p () "Returns true if the current drill session has continued past its maximum duration." @@ -1979,6 +2161,7 @@ maximum duration." (> (- (float-time (current-time)) *org-drill-start-time*) (* org-drill-maximum-duration 60)))) + (defun org-drill-maximum-item-count-reached-p () "Returns true if the current drill session has reached the maximum number of items." @@ -1987,6 +2170,7 @@ maximum number of items." (>= (length *org-drill-done-entries*) org-drill-maximum-items-per-session))) + (defun org-drill-pop-next-pending-entry () (block org-drill-pop-next-pending-entry (let ((m nil)) @@ -2034,6 +2218,7 @@ maximum number of items." (return-from org-drill-pop-next-pending-entry nil))))) m))) + (defun org-drill-entries (&optional resuming-p) "Returns nil, t, or a list of markers representing entries that were 'failed' and need to be presented again before the session ends. @@ -2086,6 +2271,8 @@ RESUMING-P is true if we are resuming a suspended drill session." (push m *org-drill-done-entries*))) (setq *org-drill-current-item* nil)))))))))) + + (defun org-drill-final-report () (let ((pass-percent (round (* 100 (count-if (lambda (qual) @@ -2172,7 +2359,10 @@ order to make items appear more frequently over time." *org-drill-overdue-entry-count* (round (* 100 *org-drill-overdue-entry-count*) (+ *org-drill-dormant-entry-count* - *org-drill-due-entry-count*))))))) + *org-drill-due-entry-count*))) + )))) + + (defun org-drill-free-markers (markers) "MARKERS is a list of markers, all of which will be freed (set to @@ -2268,7 +2458,7 @@ one of the following values: sym1))))) -(defun org-drill (&optional scope resume-p) +(defun org-drill (&optional scope drill-match resume-p) "Begin an interactive 'drill session'. The user is asked to review a series of topics (headers). Each topic is initially presented as a 'question', often with part of the topic content @@ -2296,6 +2486,10 @@ SCOPE determines the scope in which to search for questions. It accepts the same values as `org-drill-scope', which see. +DRILL-MATCH, if supplied, is a string specifying a tags/property/ +todo query. Only items matching the query will be considered. +It accepts the same values as `org-drill-match', which see. + If RESUME-P is non-nil, resume a suspended drill session rather than starting a new one." @@ -2368,7 +2562,7 @@ than starting a new one." (:old (push (point-marker) *org-drill-old-mature-entries*)) ))))) - scope) + scope drill-match) (org-drill-order-overdue-entries overdue-data) (setq *org-drill-overdue-entry-count* (length *org-drill-overdue-entries*)))) @@ -2405,7 +2599,8 @@ than starting a new one." (org-drill-save-optimal-factor-matrix)) (if org-drill-save-buffers-after-drill-sessions-p (save-some-buffers)) - (message "Drill session finished!"))))) + (message "Drill session finished!") + )))) (defun org-drill-save-optimal-factor-matrix () @@ -2414,14 +2609,14 @@ than starting a new one." org-drill-optimal-factor-matrix)) -(defun org-drill-cram (&optional scope) +(defun org-drill-cram (&optional scope drill-match) "Run an interactive drill session in 'cram mode'. In cram mode, all drill items are considered to be due for review, unless they have been reviewed within the last `org-drill-cram-hours' hours." (interactive) (setq *org-drill-cram-mode* t) - (org-drill scope)) + (org-drill scope drill-match)) (defun org-drill-tree () @@ -2438,7 +2633,7 @@ files in the same directory as the current file." (org-drill 'directory)) -(defun org-drill-again (&optional scope) +(defun org-drill-again (&optional scope drill-match) "Run a new drill session, but try to use leftover due items that were not reviewed during the last session, rather than scanning for unreviewed items. If there are no leftover items in memory, a full @@ -2453,9 +2648,9 @@ scan will be performed." (setq *org-drill-start-time* (float-time (current-time)) *org-drill-done-entries* nil *org-drill-current-item* nil) - (org-drill scope t)) + (org-drill scope drill-match t)) (t - (org-drill scope)))) + (org-drill scope drill-match)))) @@ -2465,7 +2660,7 @@ exiting them with the `edit' or `quit' options." (interactive) (cond ((org-drill-entries-pending-p) - (org-drill nil t)) + (org-drill nil nil t)) ((and (plusp (org-drill-pending-entry-count)) ;; Current drill session is finished, but there are still ;; more items which need to be reviewed. @@ -2478,10 +2673,18 @@ need reviewing. Start a new drill session? " (message "You have finished the drill session.")))) +(defun org-drill-relearn-item () + "Make the current item due for revision, and set its last interval to 0. +Makes the item behave as if it has been failed, without actually recording a +failure. This command can be used to 'reset' repetitions for an item." + (interactive) + (org-drill-smart-reschedule 4 0)) + + (defun org-drill-strip-entry-data () (dolist (prop org-drill-scheduling-properties) (org-delete-property prop)) - (org-schedule t)) + (org-schedule '(4))) (defun org-drill-strip-all-data (&optional scope) @@ -2499,7 +2702,7 @@ values as `org-drill-scope'." ;; `org-delete-property-globally', which is faster. (dolist (prop org-drill-scheduling-properties) (org-delete-property-globally prop)) - (org-map-drill-entries (lambda () (org-schedule t)) scope)) + (org-map-drill-entries (lambda () (org-schedule '(4))) scope)) (t (org-map-drill-entries 'org-drill-strip-entry-data scope))) (message "Done."))) @@ -2507,12 +2710,20 @@ values as `org-drill-scope'." (defun org-drill-add-cloze-fontification () - (when org-drill-use-visible-cloze-face-p - (font-lock-add-keywords 'org-mode - org-drill-cloze-keywords - nil))) + (when (eql major-mode 'org-mode) + ;; Compute local versions of the regexp for cloze deletions, in case + ;; the left and right delimiters are redefined locally. + (setq-local org-drill-cloze-regexp (org-drill--compute-cloze-regexp)) + (setq-local org-drill-cloze-keywords (org-drill--compute-cloze-keywords)) + (when org-drill-use-visible-cloze-face-p + (font-lock-add-keywords nil ;'org-mode + org-drill-cloze-keywords + nil)))) -(add-hook 'org-mode-hook 'org-drill-add-cloze-fontification) +;; Can't add to org-mode-hook, because local variables won't have been loaded +;; yet. +(add-hook 'hack-local-variables-hook + 'org-drill-add-cloze-fontification) (org-drill-add-cloze-fontification) @@ -2530,18 +2741,18 @@ the tag 'imported'." (save-excursion (let ((src (current-buffer)) (m nil)) - (flet ((paste-tree-here (&optional level) - (org-paste-subtree level) - (org-drill-strip-entry-data) - (org-toggle-tag "imported" 'on) - (org-map-drill-entries - (lambda () - (let ((id (org-id-get))) - (org-drill-strip-entry-data) - (unless (gethash id *org-drill-dest-id-table*) - (puthash id (point-marker) - *org-drill-dest-id-table*)))) - 'tree))) + (cl-flet ((paste-tree-here (&optional level) + (org-paste-subtree level) + (org-drill-strip-entry-data) + (org-toggle-tag "imported" 'on) + (org-map-drill-entries + (lambda () + (let ((id (org-id-get))) + (org-drill-strip-entry-data) + (unless (gethash id *org-drill-dest-id-table*) + (puthash id (point-marker) + *org-drill-dest-id-table*)))) + 'tree))) (unless path (setq path (org-get-outline-path))) (org-copy-subtree) @@ -2565,7 +2776,9 @@ the tag 'imported'." (outline-next-heading) (newline) (forward-line -1) - (paste-tree-here (1+ (or (org-current-level) 0)))))))) + (paste-tree-here (1+ (or (org-current-level) 0))) + ))))) + (defun org-drill-merge-buffers (src &optional dest ignore-new-items-p) @@ -2658,12 +2871,15 @@ copy them across." (free-marker m)) *org-drill-dest-id-table*)))) + + ;;; Card types for learning languages ========================================= ;;; Get spell-number.el from: ;;; http://www.emacswiki.org/emacs/spell-number.el (autoload 'spelln-integer-in-words "spell-number") + ;;; `conjugate' card type ===================================================== ;;; See spanish.org for usage @@ -2726,15 +2942,15 @@ the name of the tense.") (defun org-drill-present-verb-conjugation () "Present a drill entry whose card type is 'conjugate'." - (flet ((tense-and-mood-to-string - (tense mood) - (cond - ((and tense mood) - (format "%s tense, %s mood" tense mood)) - (tense - (format "%s tense" tense)) - (mood - (format "%s mood" mood))))) + (cl-flet ((tense-and-mood-to-string + (tense mood) + (cond + ((and tense mood) + (format "%s tense, %s mood" tense mood)) + (tense + (format "%s tense" tense)) + (mood + (format "%s mood" mood))))) (destructuring-bind (infinitive inf-hint translation tense mood) (org-drill-get-verb-conjugation-info) (org-drill-present-card-using-text @@ -2915,6 +3131,7 @@ returns its return value." 'face highlight-face)) (spelln-integer-in-language drilled-number language)))))))) + ;; (defun org-drill-show-answer-translate-number (reschedule-fn) ;; (let* ((language (read (org-entry-get (point) "DRILL_LANGUAGE" t))) ;; (highlight-face 'font-lock-warning-face) From 818c8216846b79f2e74aeca714e6eee24467f090 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Sun, 17 Nov 2013 21:31:03 +0100 Subject: [PATCH 133/166] org-test: fix macro definitions so that eager macro expansion doesn't fail * testing/org-test.el (org-test-with-temp-text, org-test-with-temp-text-in-file): Correct quoting of macro expansion. Macro arguments must not be used during macro expansion since they are not available at that time; conversely, bindings established during macro expansion generally can not be used at macro execution time (unless un-quoted during expansion). --- testing/org-test.el | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/testing/org-test.el b/testing/org-test.el index 4f705102c..da55dd69e 100644 --- a/testing/org-test.el +++ b/testing/org-test.el @@ -205,31 +205,32 @@ mode holding TEXT. If the string \"\" appears in TEXT then remove it and place the point there before running BODY, otherwise place the point at the beginning of the inserted text." (declare (indent 1)) - (let ((inside-text (if (stringp text) text (eval text)))) - `(with-temp-buffer + `(let ((inside-text (if (stringp ,text) ,text (eval ,text)))) + (with-temp-buffer (org-mode) - ,(let ((point (string-match (regexp-quote "") inside-text))) + (let ((point (string-match (regexp-quote "") inside-text))) (if point - `(progn (insert `(replace-match "" nil nil inside-text)) - (goto-char ,(match-beginning 0))) - `(progn (insert ,inside-text) - (goto-char (point-min))))) + (progn (insert (replace-match "" nil nil inside-text)) + (goto-char (match-beginning 0))) + (progn (insert inside-text) + (goto-char (point-min))))) ,@body))) (def-edebug-spec org-test-with-temp-text (form body)) (defmacro org-test-with-temp-text-in-file (text &rest body) "Run body in a temporary file buffer with Org-mode as the active mode." (declare (indent 1)) - (let ((file (make-temp-file "org-test")) - (inside-text (if (stringp text) text (eval text))) - (results (gensym))) - `(let ((kill-buffer-query-functions nil) ,results) - (with-temp-file ,file (insert ,inside-text)) - (find-file ,file) + (let ((results (gensym))) + `(let ((file (make-temp-file "org-test")) + (kill-buffer-query-functions nil) + (inside-text (if (stringp ,text) ,text (eval ,text))) + ,results) + (with-temp-file file (insert inside-text)) + (find-file file) (org-mode) (setq ,results (progn ,@body)) (save-buffer) (kill-buffer (current-buffer)) - (delete-file ,file) + (delete-file file) ,results))) (def-edebug-spec org-test-with-temp-text-in-file (form body)) From c5aad89f5a7a5d3ea5ff4db3f099c828e9f76c42 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 18 Nov 2013 19:11:17 +0100 Subject: [PATCH 134/166] Fix export of links to attachements * lisp/org.el (org-entry-properties): Ignore narrowing when retrieving current headline properties. --- lisp/org.el | 191 ++++++++++++++++++++++++++-------------------------- 1 file changed, 95 insertions(+), 96 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index f47caa11a..13a99ff18 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -15183,103 +15183,102 @@ is a string only get exactly this property. SPECIFIC can be a string, the specific property we are interested in. Specifying it can speed things up because then unnecessary parsing is avoided." (setq which (or which 'all)) - (org-with-point-at pom - (let ((clockstr (substring org-clock-string 0 -1)) - (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) - (case-fold-search nil) - beg end range props sum-props key key1 value string clocksum clocksumt) - (save-excursion - (when (condition-case nil - (and (derived-mode-p 'org-mode) (org-back-to-heading t)) - (error nil)) - (setq beg (point)) - (setq sum-props (get-text-property (point) 'org-summaries)) - (setq clocksum (get-text-property (point) :org-clock-minutes) - clocksumt (get-text-property (point) :org-clock-minutes-today)) - (outline-next-heading) - (setq end (point)) - (when (memq which '(all special)) - ;; Get the special properties, like TODO and tags - (goto-char beg) - (when (and (or (not specific) (string= specific "TODO")) - (looking-at org-todo-line-regexp) (match-end 2)) - (push (cons "TODO" (org-match-string-no-properties 2)) props)) - (when (and (or (not specific) (string= specific "PRIORITY")) - (looking-at org-priority-regexp)) - (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) - (when (or (not specific) (string= specific "FILE")) - (push (cons "FILE" buffer-file-name) props)) - (when (and (or (not specific) (string= specific "TAGS")) - (setq value (org-get-tags-string)) - (string-match "\\S-" value)) - (push (cons "TAGS" value) props)) - (when (and (or (not specific) (string= specific "ALLTAGS")) - (setq value (org-get-tags-at))) - (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") - ":")) - props)) - (when (or (not specific) (string= specific "BLOCKED")) - (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) - (when (or (not specific) - (member specific - '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" - "TIMESTAMP" "TIMESTAMP_IA"))) - (catch 'match - (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) - (substring (org-match-string-no-properties 1) - 0 -1)) - string (if (equal key clockstr) - (org-trim - (buffer-substring-no-properties - (match-beginning 3) (goto-char - (point-at-eol)))) - (substring (org-match-string-no-properties 3) - 1 -1))) - ;; Get the correct property name from the key. This is - ;; necessary if the user has configured time keywords. - (setq key1 (concat key ":")) - (cond - ((not key) - (setq key - (if (= (char-after (match-beginning 3)) ?\[) - "TIMESTAMP_IA" "TIMESTAMP"))) - ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) - ((equal key1 org-deadline-string) (setq key "DEADLINE")) - ((equal key1 org-closed-string) (setq key "CLOSED")) - ((equal key1 org-clock-string) (setq key "CLOCK"))) - (if (and specific (equal key specific) (not (equal key "CLOCK"))) - (progn - (push (cons key string) props) - ;; no need to search further if match is found - (throw 'match t)) - (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props))))))) + (org-with-wide-buffer + (org-with-point-at pom + (let ((clockstr (substring org-clock-string 0 -1)) + (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) + (case-fold-search nil) + beg end range props sum-props key key1 value string clocksum clocksumt) + (when (and (derived-mode-p 'org-mode) + (ignore-errors (org-back-to-heading t))) + (setq beg (point)) + (setq sum-props (get-text-property (point) 'org-summaries)) + (setq clocksum (get-text-property (point) :org-clock-minutes) + clocksumt (get-text-property (point) :org-clock-minutes-today)) + (outline-next-heading) + (setq end (point)) + (when (memq which '(all special)) + ;; Get the special properties, like TODO and tags + (goto-char beg) + (when (and (or (not specific) (string= specific "TODO")) + (looking-at org-todo-line-regexp) (match-end 2)) + (push (cons "TODO" (org-match-string-no-properties 2)) props)) + (when (and (or (not specific) (string= specific "PRIORITY")) + (looking-at org-priority-regexp)) + (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) + (when (or (not specific) (string= specific "FILE")) + (push (cons "FILE" buffer-file-name) props)) + (when (and (or (not specific) (string= specific "TAGS")) + (setq value (org-get-tags-string)) + (string-match "\\S-" value)) + (push (cons "TAGS" value) props)) + (when (and (or (not specific) (string= specific "ALLTAGS")) + (setq value (org-get-tags-at))) + (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") + ":")) + props)) + (when (or (not specific) (string= specific "BLOCKED")) + (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) + (when (or (not specific) + (member specific + '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" + "TIMESTAMP" "TIMESTAMP_IA"))) + (catch 'match + (while (re-search-forward org-maybe-keyword-time-regexp end t) + (setq key (if (match-end 1) + (substring (org-match-string-no-properties 1) + 0 -1)) + string (if (equal key clockstr) + (org-trim + (buffer-substring-no-properties + (match-beginning 3) (goto-char + (point-at-eol)))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (if (and specific (equal key specific) (not (equal key "CLOCK"))) + (progn + (push (cons key string) props) + ;; no need to search further if match is found + (throw 'match t)) + (when (or (equal key "CLOCK") (not (assoc key props))) + (push (cons key string) props))))))) - (when (memq which '(all standard)) - ;; Get the standard properties, like :PROP: ... - (setq range (org-get-property-block beg end)) - (when range - (goto-char (car range)) - (while (re-search-forward org-property-re - (cdr range) t) - (setq key (org-match-string-no-properties 2) - value (org-trim (or (org-match-string-no-properties 3) ""))) - (unless (member key excluded) - (push (cons key (or value "")) props))))) - (if clocksum - (push (cons "CLOCKSUM" - (org-columns-number-to-string (/ (float clocksum) 60.) - 'add_times)) - props)) - (if clocksumt - (push (cons "CLOCKSUM_T" - (org-columns-number-to-string (/ (float clocksumt) 60.) - 'add_times)) - props)) - (unless (assoc "CATEGORY" props) - (push (cons "CATEGORY" (org-get-category)) props)) - (append sum-props (nreverse props))))))) + (when (memq which '(all standard)) + ;; Get the standard properties, like :PROP: ... + (setq range (org-get-property-block beg end)) + (when range + (goto-char (car range)) + (while (re-search-forward org-property-re + (cdr range) t) + (setq key (org-match-string-no-properties 2) + value (org-trim (or (org-match-string-no-properties 3) ""))) + (unless (member key excluded) + (push (cons key (or value "")) props))))) + (if clocksum + (push (cons "CLOCKSUM" + (org-columns-number-to-string (/ (float clocksum) 60.) + 'add_times)) + props)) + (if clocksumt + (push (cons "CLOCKSUM_T" + (org-columns-number-to-string (/ (float clocksumt) 60.) + 'add_times)) + props)) + (unless (assoc "CATEGORY" props) + (push (cons "CATEGORY" (org-get-category)) props)) + (append sum-props (nreverse props))))))) (defun org-entry-get (pom property &optional inherit literal-nil) "Get value of PROPERTY for entry or content at point-or-marker POM. From bb97f5cdffe86d64d263879e7156869231b0f846 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Tue, 19 Nov 2013 09:05:17 -0700 Subject: [PATCH 135/166] rm redundant value/output splitting of lisp blocks * lisp/ob-lisp.el (org-babel-execute:lisp): The car/cadr are now taken previously in the function and need not be taken within the call to `org-babel-result-cond'. --- lisp/ob-lisp.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index 3f156d025..07134895b 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -91,10 +91,10 @@ current directory string." (point-min) (point-max))))) (cdr (assoc :package params))))))) (org-babel-result-cond (cdr (assoc :result-params params)) - (car result) + result (condition-case nil - (read (org-babel-lisp-vector-to-list (cadr result))) - (error (cadr result))))) + (read (org-babel-lisp-vector-to-list result)) + (error result)))) (org-babel-pick-name (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) (org-babel-pick-name (cdr (assoc :rowname-names params)) From 3e87d5893dcf3c796dee57452406ad0b05f04b3a Mon Sep 17 00:00:00 2001 From: Thierry Volpiatto Date: Wed, 20 Nov 2013 19:26:12 +0100 Subject: [PATCH 136/166] org-crypt.el: Fix warning * org-crypt.el (org-encrypt-string, org-encrypt-entry) (org-decrypt-entry): Fix warning. TINYCHANGE epg-context is let-bounded in org-crypt and then epg local set it in this context. It should just be set as local var instead of being let bounded. See http://debbugs.gnu.org/cgi/bugreport.cgi?bug=15081 --- lisp/org-crypt.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index b02a7ceff..1fbcf8e42 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -161,8 +161,8 @@ See `org-crypt-disable-auto-save'." (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) (get-text-property 0 'org-crypt-text str) - (let ((epg-context (epg-make-context nil t t))) - (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))) (defun org-encrypt-entry () "Encrypt the content of the current headline." @@ -170,11 +170,11 @@ See `org-crypt-disable-auto-save'." (require 'epg) (save-excursion (org-back-to-heading t) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) (let ((start-heading (point))) (forward-line) (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) (let ((folded (outline-invisible-p)) - (epg-context (epg-make-context nil t t)) (crypt-key (org-crypt-key-for-heading)) (beg (point)) end encrypted-text) @@ -206,11 +206,11 @@ See `org-crypt-disable-auto-save'." (forward-line) (when (looking-at "-----BEGIN PGP MESSAGE-----") (org-crypt-check-auto-save) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) (let* ((end (save-excursion (search-forward "-----END PGP MESSAGE-----") (forward-line) (point))) - (epg-context (epg-make-context nil t t)) (encrypted-text (buffer-substring-no-properties (point) end)) (decrypted-text (decode-coding-string From 2dcd6dace94b7e88c51592c55841679b72c77838 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 20 Nov 2013 22:01:10 +0100 Subject: [PATCH 137/166] org.texi: Fix export snippet syntax in ODT backend * doc/org.texi (Creating one-off styles): Use new export snippet syntax. --- doc/org.texi | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 210eabb26..487eabae4 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -12543,13 +12543,13 @@ file. The use of this feature is better illustrated with couple of examples. @enumerate @item Embedding ODT tags as part of regular text -You can include simple OpenDocument tags by prefixing them with -@samp{@@}. For example, to highlight a region of text do the following: +You can inline OpenDocument syntax by enclosing it within +@samp{@@@@odt:...@@@@} markup. For example, to highlight a region of text do +the following: @example -@@This is a -highlighted text@@. But this is a -regular text. +@@@@odt:This is a highlighted +text@@@@. But this is a regular text. @end example @strong{Hint:} To see the above example in action, edit your From 5ea02285bacb9592b20c95d4797ca7c2ec68ecac Mon Sep 17 00:00:00 2001 From: Nick Dokos Date: Thu, 21 Nov 2013 00:30:05 -0500 Subject: [PATCH 138/166] Ensure that file local variables are set * lisp/org.el (org-mode): Call `hack-local-variables' at the end of `org-mode' to set file local variables. Cribbed from `normal-mode'. Reported by Tom Dye: C-c C-c on e.g an #+OPTIONS line would lose file local variable settings. --- lisp/org.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index febee759c..8539f51b5 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5512,7 +5512,10 @@ The following commands are available: (unless org-inhibit-startup-visibility-stuff (org-set-startup-visibility)))) ;; Try to set org-hide correctly - (set-face-foreground 'org-hide (org-find-invisible-foreground))) + (set-face-foreground 'org-hide (org-find-invisible-foreground)) + ;; Make sure that file local variables are set. + (report-errors "File local-variables error: %s" + (hack-local-variables))) ;; Update `customize-package-emacs-version-alist' (add-to-list 'customize-package-emacs-version-alist From 03c141a00e38d66f29f84950002fea0b10d5816f Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Thu, 21 Nov 2013 14:08:42 -0700 Subject: [PATCH 139/166] "cite" link type in contrib/org-bibtex-extras --- contrib/lisp/org-bibtex-extras.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index 93c97a912..3b2ad8885 100644 --- a/contrib/lisp/org-bibtex-extras.el +++ b/contrib/lisp/org-bibtex-extras.el @@ -94,6 +94,14 @@ For example, to point to your `obe-bibtex-file' use the following. (outline-previous-visible-heading 1) t))) +(defun obe-citation-export (path desc format) + (cond + ((eq format 'html) (format "%s" desc)) + ((eq format 'latex) (format "\\cite{%s}" path)) + (t desc))) + +(org-add-link-type "cite" 'obe-goto-citation 'obe-citation-export) + (defun obe-html-export-citations () "Convert all \\cite{...} citations in the current file into HTML links." (save-excursion From 4547be972ad44a143511f8b0fa343c4286c0a4ad Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Thu, 21 Nov 2013 20:54:59 -0700 Subject: [PATCH 140/166] raise useful error when obe-bibtex-file isn't set --- contrib/lisp/org-bibtex-extras.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index 3b2ad8885..d9a623fbd 100644 --- a/contrib/lisp/org-bibtex-extras.el +++ b/contrib/lisp/org-bibtex-extras.el @@ -75,7 +75,8 @@ For example, to point to your `obe-bibtex-file' use the following. "Return all citations from `obe-bibtex-file'." (or obe-citations (save-window-excursion - (find-file obe-bibtex-file) + (find-file (or obe-bibtex-file + (error "`obe-bibtex-file' has not been configured"))) (goto-char (point-min)) (while (re-search-forward " :CUSTOM_ID: \\(.+\\)$" nil t) (push (org-no-properties (match-string 1)) @@ -88,7 +89,8 @@ For example, to point to your `obe-bibtex-file' use the following. (let ((citation (or citation (org-icompleting-read "Citation: " (obe-citations))))) - (find-file obe-bibtex-file) + (find-file (or obe-bibtex-file + (error "`obe-bibtex-file' has not been configured"))) (goto-char (point-min)) (when (re-search-forward (format " :CUSTOM_ID: %s" citation) nil t) (outline-previous-visible-heading 1) From 97e8bc15e7c4537d5bd63b1c470b6326784fd9d6 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Thu, 21 Nov 2013 20:55:53 -0700 Subject: [PATCH 141/166] Revert ""cite" link type in contrib/org-bibtex-extras" This reverts commit 03c141a00e38d66f29f84950002fea0b10d5816f. --- contrib/lisp/org-bibtex-extras.el | 8 -------- 1 file changed, 8 deletions(-) diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index d9a623fbd..6143fdaf3 100644 --- a/contrib/lisp/org-bibtex-extras.el +++ b/contrib/lisp/org-bibtex-extras.el @@ -96,14 +96,6 @@ For example, to point to your `obe-bibtex-file' use the following. (outline-previous-visible-heading 1) t))) -(defun obe-citation-export (path desc format) - (cond - ((eq format 'html) (format "%s" desc)) - ((eq format 'latex) (format "\\cite{%s}" path)) - (t desc))) - -(org-add-link-type "cite" 'obe-goto-citation 'obe-citation-export) - (defun obe-html-export-citations () "Convert all \\cite{...} citations in the current file into HTML links." (save-excursion From 336430f6e862efe99bca2efd747bb105f031b546 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Thu, 21 Nov 2013 20:56:07 -0700 Subject: [PATCH 142/166] ox-bibtex handle missing ebib or bibtex2html If ebib is missing then the jump function from org-bibtex-extras.el will be used if defined, else no jump function will be used. Only call `org-bibtex-process-bib-files' on html export so that ox-bibtex may be used for latex export without bibtex2html being installed. --- contrib/lisp/ox-bibtex.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/contrib/lisp/ox-bibtex.el b/contrib/lisp/ox-bibtex.el index 29a97ebea..a0f823609 100644 --- a/contrib/lisp/ox-bibtex.el +++ b/contrib/lisp/ox-bibtex.el @@ -77,8 +77,8 @@ ;; Initialization (eval-when-compile (require 'cl)) -(org-add-link-type "cite" 'ebib) - +(let ((jump-fn (car (org-remove-if-not #'fboundp '(ebib obe-goto-citation))))) + (org-add-link-type "cite" jump-fn)) ;;; Internal Functions @@ -284,7 +284,8 @@ Return new parse tree. This function assumes current back-end is HTML." (eval-after-load 'ox '(add-to-list 'org-export-filter-parse-tree-functions - 'org-bibtex-process-bib-files)) + (lambda (e b i) (when (eql b 'html) + (org-bibtex-process-bib-files e b i))))) From 23e6c72133b690711ab0247ae5b15ada4ad2a7e8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 22 Nov 2013 09:26:58 +0100 Subject: [PATCH 143/166] ox-html: Fix TOC entries * lisp/ox-html.el (org-html--format-toc-headline): Add missing headline number in TOC entries. This fixes commit 4c94c4d062ce7aa28bc21301ec34857745029f5c. --- lisp/ox-html.el | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/lisp/ox-html.el b/lisp/ox-html.el index 7edbf2ca4..12e6bbca1 100644 --- a/lisp/ox-html.el +++ b/lisp/ox-html.el @@ -1980,7 +1980,8 @@ and value is its relative level, as an integer." (defun org-html--format-toc-headline (headline info) "Return an appropriate table of contents entry for HEADLINE. INFO is a plist used as a communication channel." - (let* ((todo (and (plist-get info :with-todo-keywords) + (let* ((headline-number (org-export-get-headline-number headline info)) + (todo (and (plist-get info :with-todo-keywords) (let ((todo (org-element-property :todo-keyword headline))) (and todo (org-export-data todo info))))) (todo-type (and todo (org-element-property :todo-type headline))) @@ -2001,19 +2002,23 @@ INFO is a plist used as a communication channel." (tags (and (eq (plist-get info :with-tags) t) (org-export-get-tags headline info)))) (format "%s" + ;; Label. (org-export-solidify-link-text (or (org-element-property :CUSTOM_ID headline) (concat "sec-" - (mapconcat - #'number-to-string - (org-export-get-headline-number headline info) - "-")))) - (apply (if (not (eq org-html-format-headline-function 'ignore)) - (lambda (todo todo-type priority text tags &rest ignore) - (funcall org-html-format-headline-function - todo todo-type priority text tags)) - #'org-html-format-headline) - todo todo-type priority text tags :section-number nil)))) + (mapconcat #'number-to-string headline-number "-")))) + ;; Body. + (concat + (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (concat (mapconcat #'number-to-string headline-number ".") + ". ")) + (apply (if (not (eq org-html-format-headline-function 'ignore)) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags)) + #'org-html-format-headline) + todo todo-type priority text tags :section-number nil))))) (defun org-html-list-of-listings (info) "Build a list of listings. From b88b5d4fd17728b84c8c7e3a0043e6eb8869dba0 Mon Sep 17 00:00:00 2001 From: Alexander Vorobiev Date: Sun, 17 Nov 2013 18:27:14 -0600 Subject: [PATCH 144/166] org-compat: Support for getting data from Windows clipboard * lisp/org-compat.el (org-get-x-clipboard): Use w32-get-clipboard-data to get the clipboard data under Windows. TINYCHANGE --- lisp/org-compat.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index b714f13a6..a3eb960e1 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -190,10 +190,12 @@ If DELETE is non-nil, delete all those overlays." found)) (defun org-get-x-clipboard (value) - "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." - (if (eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x))))) + "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21." + (cond ((eq window-system 'x) + (let ((x (org-get-x-clipboard-compat value))) + (if x (org-no-properties x)))) + ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) + (w32-get-clipboard-data)))) (defsubst org-decompose-region (beg end) "Decompose from BEG to END." From 5ae3a25755a6283f68e829ebd045ee17a94346a1 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 22 Nov 2013 12:39:15 +0100 Subject: [PATCH 145/166] Fix export of links to attachments (part 2) * lisp/org.el (org-entry-get): Widen buffer in order to retrieve a property, as both `org-entry-properties' and `org-entry-get-with-inheritance' already do. --- lisp/org.el | 48 +++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 8539f51b5..3e83043db 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -15362,30 +15362,32 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." t)) (org-entry-get-with-inheritance property literal-nil) (if (member property org-special-properties) - ;; We need a special property. Use `org-entry-properties' to - ;; retrieve it, but specify the wanted property + ;; We need a special property. Use `org-entry-properties' + ;; to retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (org-get-property-block))) - (when (and range (not (eq (car range) (cdr range)))) - (let* ((props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - (ap (lambda (key) - (when (re-search-forward - (org-re-property key) (cdr range) t) - (setq props - (org-update-property-plist - key - (if (match-end 3) - (org-match-string-no-properties 3) "") - props))))) - val) - (goto-char (car range)) - (funcall ap property) - (goto-char (car range)) - (while (funcall ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val)))))))))) + (org-with-wide-buffer + (let ((range (org-get-property-block))) + (when (and range (not (eq (car range) (cdr range)))) + (let* ((props + (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) + (when (re-search-forward + (org-re-property key) (cdr range) t) + (setq props + (org-update-property-plist + key + (if (match-end 3) + (org-match-string-no-properties 3) "") + props))))) + val) + (goto-char (car range)) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val))))))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. From 72a81dd06a816cb98e3ed5eeab178098d1665113 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 22 Nov 2013 12:42:41 +0100 Subject: [PATCH 146/166] Fix export of links to attachements (part 2) * lisp/org.el (org-entry-get): Widen buffer in order to retrieve properties, as `org-entry-properties' and `org-entry-get-with-inheritance' already do. --- lisp/org.el | 48 +++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 13a99ff18..f18919875 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -15298,30 +15298,32 @@ when a \"nil\" value can supersede a non-nil value higher up the hierarchy." t)) (org-entry-get-with-inheritance property literal-nil) (if (member property org-special-properties) - ;; We need a special property. Use `org-entry-properties' to - ;; retrieve it, but specify the wanted property + ;; We need a special property. Use `org-entry-properties' + ;; to retrieve it, but specify the wanted property (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (org-get-property-block))) - (when (and range (not (eq (car range) (cdr range)))) - (let* ((props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - (ap (lambda (key) - (when (re-search-forward - (org-re-property key) (cdr range) t) - (setq props - (org-update-property-plist - key - (if (match-end 3) - (org-match-string-no-properties 3) "") - props))))) - val) - (goto-char (car range)) - (funcall ap property) - (goto-char (car range)) - (while (funcall ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val)))))))))) + (org-with-wide-buffer + (let ((range (org-get-property-block))) + (when (and range (not (eq (car range) (cdr range)))) + (let* ((props + (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) + (when (re-search-forward + (org-re-property key) (cdr range) t) + (setq props + (org-update-property-plist + key + (if (match-end 3) + (org-match-string-no-properties 3) "") + props))))) + val) + (goto-char (car range)) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val))))))))))) (defun org-property-or-variable-value (var &optional inherit) "Check if there is a property fixing the value of VAR. From 060d79f08078cd98f2be77eeac367affa5c02de9 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Fri, 22 Nov 2013 08:11:34 -0700 Subject: [PATCH 147/166] whitespace fixes --- lisp/ob-core.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 2e9b1882c..3df0f5c56 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -217,7 +217,7 @@ not match KEY should be returned." (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) params))) -(defun org-babel-get-inline-src-block-matches() +(defun org-babel-get-inline-src-block-matches () "Set match data if within body of an inline source block. Returns non-nil if match-data set" (let ((src-at-0-p (save-excursion @@ -240,7 +240,7 @@ Returns non-nil if match-data set" t )))))) (defvar org-babel-inline-lob-one-liner-regexp) -(defun org-babel-get-lob-one-liner-matches() +(defun org-babel-get-lob-one-liner-matches () "Set match data if on line of an lob one liner. Returns non-nil if match-data set" (save-excursion From bbcf17b96920e5c8cfe220e308b96e4f7b4ad9ed Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Fri, 22 Nov 2013 08:18:05 -0700 Subject: [PATCH 148/166] set location info parameter for inline src blocks * lisp/ob-core.el (org-babel-execute-src-block): Set location info parameter for inline src blocks. (org-babel-get-src-block-info): Set location info parameter for inline src blocks. --- lisp/ob-core.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 3df0f5c56..ba69b2c89 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -277,6 +277,7 @@ Returns a list (setq name (org-no-properties (match-string 3))))) ;; inline source block (when (org-babel-get-inline-src-block-matches) + (setq head (match-beginning 0)) (setq info (org-babel-parse-inline-src-block-match)))) ;; resolve variable references and add summary parameters (when (and info (not light)) @@ -615,7 +616,10 @@ block." (let* ((org-babel-current-src-block-location (or org-babel-current-src-block-location (nth 6 info) - (org-babel-where-is-src-block-head))) + (org-babel-where-is-src-block-head) + ;; inline src block + (and (org-babel-get-inline-src-block-matches) + (match-beginning 0)))) (info (if info (copy-tree info) (org-babel-get-src-block-info))) From 89a35bc1473469d796253651668902f56e23cf7e Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Fri, 22 Nov 2013 08:27:40 -0700 Subject: [PATCH 149/166] inline src block parser set "switches" in info * lisp/ob-core.el (org-babel-parse-inline-src-block-match): Inline src block parser set "switches" in info, otherwise later offset are broken. --- lisp/ob-core.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index ba69b2c89..fb803046e 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1454,7 +1454,8 @@ specified in the properties of the current outline entry." (append (org-babel-params-from-properties lang) (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) ""))))))))) + (org-no-properties (or (match-string 4) "")))))) + nil))) (defun org-babel-balanced-split (string alts) "Split STRING on instances of ALTS. From a598e9c163428be457424a64b2edb0391a3e965a Mon Sep 17 00:00:00 2001 From: Nicolas Richard Date: Thu, 7 Nov 2013 09:15:36 +0100 Subject: [PATCH 150/166] Remove old comment The comment was introduced (in git) at commit 4be4c56239c224094e717dcd57068f58f99c2dfc ; it refers to a FIXME located ~40 lines above it. The FIXME was removed in dc8bc8e39230bde1eca569c564e65bf85c43de54. --- lisp/org.el | 3 --- 1 file changed, 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index f18919875..b84855a91 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -19505,9 +19505,6 @@ because, in this case the deletion might narrow the column." (put 'org-self-insert-command 'pabbrev-expand-after-command t) (put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) -;; How to do this: Measure non-white length of current string -;; If equal to column width, we should realign. - (defun org-remap (map &rest commands) "In MAP, remap the functions given in COMMANDS. COMMANDS is a list of alternating OLDDEF NEWDEF command names." From 9ff70abc14e901ce481cb605c0d572581dd40716 Mon Sep 17 00:00:00 2001 From: Nicolas Richard Date: Tue, 12 Nov 2013 09:02:23 +0100 Subject: [PATCH 151/166] Use key-description on the keys mentionned by the functions defined by `orgtbl-mode'. --- lisp/org-table.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index fa66ed0a1..8418cf6fb 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -4124,7 +4124,7 @@ to execute outside of tables." '(arg) (concat "In tables, run `" (symbol-name fun) "'.\n" "Outside of tables, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") + (mapconcat #'key-description keys "' or `") "'.") '(interactive "p") (list 'if From cdbdb9ee668f4aa5e4aaa1cc24df11776fe53cbf Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 22 Nov 2013 21:55:27 +0100 Subject: [PATCH 152/166] org-inlinetask: Small clean-up --- lisp/org-inlinetask.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index ca7572bcc..72b652937 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -107,7 +107,6 @@ When nil, the first star is not shown." (defvar org-odd-levels-only) (defvar org-keyword-time-regexp) -(defvar org-drawer-regexp) (defvar org-complex-heading-regexp) (defvar org-property-end-re) From 402c310f004218322cfd0287a125837508920dcc Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 22 Nov 2013 21:56:23 +0100 Subject: [PATCH 153/166] Fix some defconst and docstrings * lisp/org.el (org-drawer-regexp, org-clock-drawer-start-re, org-clock-drawer-end-re): Fix docstring. (org-clock-drawer-re): Fix value --- lisp/org.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 3001640fe..f9785ae4b 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -377,8 +377,8 @@ Matched keyword is in group 1.") ;;;; Drawer (defconst org-drawer-regexp "^[ \t]*:\\(\\(?:\\w\\|[-_]\\)+\\):[ \t]*$" - "Matches first line of a hidden block. -Group 1 contains drawer's name.") + "Matches first or last line of a hidden block. +Group 1 contains drawer's name or \"END\".") (defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" "Regular expression matching the first line of a property drawer.") @@ -387,10 +387,10 @@ Group 1 contains drawer's name.") "Regular expression matching the last line of a property drawer.") (defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" - "Regular expression matching the first line of a property drawer.") + "Regular expression matching the first line of a clock drawer.") (defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the first line of a property drawer.") + "Regular expression matching the last line of a clock drawer.") (defconst org-property-drawer-re (concat "\\(" org-property-start-re "\\)[^\000]*?\\(" @@ -399,7 +399,7 @@ Group 1 contains drawer's name.") (defconst org-clock-drawer-re (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*?\\(" - org-property-end-re "\\)\n?") + org-clock-drawer-end-re "\\)\n?") "Matches an entire clock drawer.") ;;;; Headline From e8bafdd04f21784e189a4da647795f660a4ef1ce Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 22 Nov 2013 22:11:44 +0100 Subject: [PATCH 154/166] Optimize hiding all drawers in a buffer * lisp/org.el (org-cycle-hide-drawers): Make sure each drawer is only flagged once. --- lisp/org.el | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index f9785ae4b..bb478083b 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7101,7 +7101,13 @@ specifying which drawers should not be hidden." (goto-char beg) (while (re-search-forward org-drawer-regexp end t) (unless (member-ignore-case (match-string 1) exceptions) - (org-flag-drawer t))))))) + (let ((drawer (org-element-at-point))) + (when (memq (org-element-type drawer) '(drawer property-drawer)) + (org-flag-drawer t drawer) + ;; Make sure to skip drawer entirely or we might flag + ;; it another time when matching its ending line with + ;; `org-drawer-regexp'. + (goto-char (org-element-property :end drawer)))))))))) (defun org-cycle-hide-inline-tasks (state) "Re-hide inline tasks when switching to 'contents or 'children From 5213e0f704ca46bdbc49ca27a09da88a6450bd1f Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Sat, 23 Nov 2013 16:15:45 +0100 Subject: [PATCH 155/166] org-crypt: fix 3e87d5893d MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * lisp/org-crypt.el: Declare `epg-context´. (org-encrypt-string): Correct indentation. --- lisp/org-crypt.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index 1fbcf8e42..2024144fa 100644 --- a/lisp/org-crypt.el +++ b/lisp/org-crypt.el @@ -73,6 +73,8 @@ compress-algorithm)) (declare-function epg-encrypt-string "epg" (context plain recipients &optional sign always-trust)) +(defvar epg-context) + (defgroup org-crypt nil "Org Crypt." @@ -161,7 +163,7 @@ See `org-crypt-disable-auto-save'." (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) (get-text-property 0 'org-crypt-text str) - (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))) (defun org-encrypt-entry () From 1f498c93f297cf39f9afc609433eb764c1480f9e Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Sat, 23 Nov 2013 09:14:27 -0700 Subject: [PATCH 156/166] change default sh code block shell to bash * lisp/ob-sh.el (org-babel-sh-command): Change default sh code block shell to bash. --- lisp/ob-sh.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index 4984ff9bf..1b55ec7fa 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -38,7 +38,7 @@ (defvar org-babel-default-header-args:sh '()) -(defvar org-babel-sh-command "sh" +(defvar org-babel-sh-command "bash" "Command used to invoke a shell. This will be passed to `shell-command-on-region'") From 9b6cff94aa84eaa3fcf155ff0caf861408c57095 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Tue, 5 Nov 2013 18:50:06 +0100 Subject: [PATCH 157/166] Revert "added Makefile targets to check single tests" This reverts commit 2c5251f0dab97a5101f15a5b574fdf66bbb71b6a. --- mk/default.mk | 3 ++- mk/targets.mk | 9 ++------- 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/mk/default.mk b/mk/default.mk index 5cb75c357..a39ecec24 100644 --- a/mk/default.mk +++ b/mk/default.mk @@ -60,7 +60,8 @@ BTEST = $(BATCH) \ -l testing/org-test.el \ $(foreach ob-lang,$(BTEST_OB_LANGUAGES),$(req-ob-lang)) \ $(foreach req,$(BTEST_EXTRA),$(req-extra)) \ - --eval '(setq org-confirm-babel-evaluate nil)' + --eval '(setq org-confirm-babel-evaluate nil)' \ + -f org-test-run-batch-tests # Using emacs in batch mode. # BATCH = $(EMACS) -batch -vanilla # XEmacs diff --git a/mk/targets.mk b/mk/targets.mk index cc4e032cc..aef11eb14 100644 --- a/mk/targets.mk +++ b/mk/targets.mk @@ -94,15 +94,10 @@ compile compile-dirty:: all clean-install:: $(foreach dir, $(SUBDIRS), $(MAKE) -C $(dir) $@;) -check test single-test:: compile +check test:: compile check test test-dirty:: -$(MKDIR) $(testdir) - TMPDIR=$(testdir) $(BTEST) -f org-test-run-batch-tests - -single-test single-test-dirty:: - -$(MKDIR) $(testdir) - TMPDIR=$(testdir) $(BTEST) --eval "(org-test-load)" --eval "(ert '$(TEST))" - + TMPDIR=$(testdir) $(BTEST) ifeq ($(TEST_NO_AUTOCLEAN),) # define this variable to leave $(testdir) around for inspection $(MAKE) cleantest endif From 1b0fb1a4846cdc767ec47115b7c7f26cff40b436 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Sat, 23 Nov 2013 17:46:35 +0100 Subject: [PATCH 158/166] testing: allow to select tests * mk/default.mk: Add default for new variable BTEST_RE to select all tests. (BTEST_OB_LANGUAGES): Remove sh (always needed, as emacs-lisp) and add comment for ruby. (BTEST): Use BTEST_RE to select tests from the test suite. Reorganize pre-loading of Org, Babel, Ox and babel languages into a known clean environment. * mk/targets.mk (CONF_TEST): Add BTEST_RE to the output of config-test. * testing/org-batch-test-init.el: New file. Remove all traces of any Org built into Emacs or otherwise present in the environment so it can not be picked up spuriously during testing or conceal errors in the Org version under test. * testing/org-test.el (org-test-run-batch-tests): Showtest selection in messages. (org-test-run-all-tests): Update ID locations. --- mk/default.mk | 23 ++++++++++++++++------- mk/targets.mk | 2 +- testing/org-batch-test-init.el | 20 ++++++++++++++++++++ testing/org-test.el | 2 ++ 4 files changed, 39 insertions(+), 8 deletions(-) create mode 100644 testing/org-batch-test-init.el diff --git a/mk/default.mk b/mk/default.mk index a39ecec24..dda261084 100644 --- a/mk/default.mk +++ b/mk/default.mk @@ -39,8 +39,9 @@ BTEST_POST = # -L /ert # needed for Emacs23, Emacs24 has ert built in # -L /ess # needed for running R tests # -L /htmlize # need at least version 1.34 for source code formatting -BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave python sh perl +BTEST_OB_LANGUAGES = awk C fortran maxima lilypond octave perl python # R # requires ESS to be installed and configured + # ruby # requires inf-ruby to be installed and configured # extra packages to require for testing BTEST_EXTRA = # ess-site # load ESS for R tests @@ -50,18 +51,26 @@ BTEST_EXTRA = # How to run tests req-ob-lang = --eval '(require '"'"'ob-$(ob-lang))' +lst-ob-lang = ($(ob-lang) . t) req-extra = --eval '(require '"'"'$(req))' +BTEST_RE ?= \\(org\\|ob\\) BTEST = $(BATCH) \ $(BTEST_PRE) \ - --eval '(add-to-list '"'"'load-path "./lisp")' \ - --eval '(add-to-list '"'"'load-path "./testing")' \ + --eval '(add-to-list '"'"'load-path (concat default-directory "lisp"))' \ + --eval '(add-to-list '"'"'load-path (concat default-directory "testing"))' \ $(BTEST_POST) \ + -l org-batch-test-init \ + --eval '(setq \ + org-batch-test t \ + org-babel-load-languages \ + (quote ($(foreach ob-lang,$(BTEST_OB_LANGUAGES) emacs-lisp sh org,$(lst-ob-lang)))) \ + org-test-select-re "$(BTEST_RE)" \ + )' \ -l org-loaddefs.el \ - -l testing/org-test.el \ - $(foreach ob-lang,$(BTEST_OB_LANGUAGES),$(req-ob-lang)) \ + -l cl -l testing/org-test.el \ + -l ert -l org -l ox \ $(foreach req,$(BTEST_EXTRA),$(req-extra)) \ - --eval '(setq org-confirm-babel-evaluate nil)' \ - -f org-test-run-batch-tests + --eval '(org-test-run-batch-tests org-test-select-re)' # Using emacs in batch mode. # BATCH = $(EMACS) -batch -vanilla # XEmacs diff --git a/mk/targets.mk b/mk/targets.mk index aef11eb14..b753957ba 100644 --- a/mk/targets.mk +++ b/mk/targets.mk @@ -35,7 +35,7 @@ endif CONF_BASE = EMACS DESTDIR ORGCM ORG_MAKE_DOC CONF_DEST = lispdir infodir datadir testdir -CONF_TEST = BTEST_PRE BTEST_POST BTEST_OB_LANGUAGES BTEST_EXTRA +CONF_TEST = BTEST_PRE BTEST_POST BTEST_OB_LANGUAGES BTEST_EXTRA BTEST_RE CONF_EXEC = CP MKDIR RM RMR FIND SUDO PDFTEX TEXI2PDF TEXI2HTML MAKEINFO INSTALL_INFO CONF_CALL = BATCH BATCHL ELC ELCDIR BTEST MAKE_LOCAL_MK MAKE_ORG_INSTALL MAKE_ORG_VERSION config-eol:: EOL = \# diff --git a/testing/org-batch-test-init.el b/testing/org-batch-test-init.el new file mode 100644 index 000000000..863875617 --- /dev/null +++ b/testing/org-batch-test-init.el @@ -0,0 +1,20 @@ +;; +;; Remove Org remnants built into Emacs +;; + +;; clean load-path +(setq load-path + (delq nil (mapcar + (function (lambda (p) + (unless (string-match "lisp\\(/packages\\)?/org$" p) + p))) + load-path))) +;; remove property list to defeat cus-load and remove autoloads +(mapatoms (function (lambda (s) + (let ((sn (symbol-name s))) + (when (string-match "^\\(org\\|ob\\|ox\\)\\(-.*\\)?$" sn) + (setplist s nil) + (when (eq 'autoload (car-safe s)) + (unintern s))))))) + +;; we should now start from a clean slate diff --git a/testing/org-test.el b/testing/org-test.el index da55dd69e..565a384d0 100644 --- a/testing/org-test.el +++ b/testing/org-test.el @@ -424,6 +424,7 @@ Load all test files first." (org-test-touch-all-examples) (org-test-update-id-locations) (org-test-load) + (message "selected tests: %s" org-test-selector) (ert-run-tests-batch-and-exit org-test-selector))) (defun org-test-run-all-tests () @@ -431,6 +432,7 @@ Load all test files first." Load all test files first." (interactive) (org-test-touch-all-examples) + (org-test-update-id-locations) (org-test-load) (ert "\\(org\\|ob\\)") (org-test-kill-all-examples)) From 6a4dfd318296925b3b895ca6ab85e31309acf84d Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Sat, 23 Nov 2013 12:24:34 -0700 Subject: [PATCH 159/166] fixed export of inline src blocks * lisp/ob-exp.el (org-babel-exp-non-block-elements): Fixed export of inline src blocks. --- lisp/ob-exp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 2f6359060..0a8edc261 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -178,7 +178,9 @@ this template." (end-el (org-element-property :end element))) (case type (inline-src-block - (let* ((info (org-babel-parse-inline-src-block-match)) + (let* ((head (match-beginning 0)) + (info (append (org-babel-parse-inline-src-block-match) + (list nil nil head))) (params (nth 2 info))) (setf (nth 1 info) (if (and (cdr (assoc :noweb params)) From 39070b7fc70b46bbc555d49356f69f3699907efe Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Sat, 23 Nov 2013 15:57:29 -0700 Subject: [PATCH 160/166] sometimes remove common indentation when trimming * lisp/ob-C.el (org-babel-C-execute): Remove common indentation when trimming. * lisp/ob-core.el (org-babel-read-result): Remove common indentation when trimming. (org-babel-update-block-body): Remove common indentation when trimming. * lisp/ob-fortran.el (org-babel-execute:fortran): Remove common indentation when trimming. * lisp/ob-tangle.el (org-babel-process-comment-text): Better default to process tangled comments. --- lisp/ob-C.el | 5 +++-- lisp/ob-core.el | 5 +++-- lisp/ob-fortran.el | 5 +++-- lisp/ob-tangle.el | 4 ++-- 4 files changed, 11 insertions(+), 8 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index bac292017..b5fb1bd3d 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -107,8 +107,9 @@ or `org-babel-execute:C++'." (org-babel-process-file-name tmp-src-file)) "")))) (let ((results (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-remove-indentation + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (org-babel-reassemble-table (org-babel-result-cond (cdr (assoc :result-params params)) (org-babel-read results t) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index fb803046e..0bf7ae8a0 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -1975,7 +1975,7 @@ following the source block." ((org-at-table-p) (org-babel-read-table)) ((org-at-item-p) (org-babel-read-list)) ((looking-at org-bracket-link-regexp) (org-babel-read-link)) - ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) + ((looking-at org-block-regexp) (org-remove-indentation (match-string 4))) ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) (setq result-string (org-babel-trim @@ -2307,7 +2307,8 @@ file's directory then expand relative links." (if (not (org-babel-where-is-src-block-head)) (error "Not in a source block") (save-match-data - (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) + (replace-match (concat (org-babel-trim (org-remove-indentation new-body)) + "\n") nil t nil 5)) (indent-rigidly (match-beginning 5) (match-end 5) 2))) (defun org-babel-merge-params (&rest plists) diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index 61cb19a56..007debbde 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -62,8 +62,9 @@ (org-babel-process-file-name tmp-src-file)) "")))) (let ((results (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-remove-indentation + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) ""))))) (org-babel-reassemble-table (org-babel-result-cond (cdr (assoc :result-params params)) (org-babel-read results) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 7b06c39ff..1f872784d 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -106,11 +106,11 @@ controlled by the :comments header argument." :version "24.1" :type 'string) -(defcustom org-babel-process-comment-text #'org-babel-trim +(defcustom org-babel-process-comment-text #'org-remove-indentation "Function called to process raw Org-mode text collected to be inserted as comments in tangled source-code files. The function should take a single string argument and return a string -result. The default value is `org-babel-trim'." +result. The default value is `org-remove-indentation'." :group 'org-babel :version "24.1" :type 'function) From 8c98879d7c356d7fdd1ab6e214b8b1f16324669c Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Sat, 23 Nov 2013 17:00:24 -0700 Subject: [PATCH 161/166] declare function to appease compiler * lisp/ob-C.el (org-remove-indentation): Declare function to appease compiler. * lisp/ob-core.el (org-remove-indentation): Declare function to appease compiler. * lisp/ob-fortran.el (org-remove-indentation): Declare function to appease compiler. --- lisp/ob-C.el | 2 +- lisp/ob-core.el | 1 + lisp/ob-fortran.el | 1 + 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index b5fb1bd3d..35e8c621f 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -37,7 +37,7 @@ (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) - +(declare-function org-remove-indentation "org" (code &optional n)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp")) diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 0bf7ae8a0..d5fa78f25 100644 --- a/lisp/ob-core.el +++ b/lisp/ob-core.el @@ -38,6 +38,7 @@ (defvar org-src-lang-modes) (defvar org-babel-library-of-babel) (declare-function show-all "outline" ()) +(declare-function org-remove-indentation "org" (code &optional n)) (declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) (declare-function org-mark-ring-push "org" (&optional pos buffer)) (declare-function tramp-compat-make-temp-file "tramp-compat" diff --git a/lisp/ob-fortran.el b/lisp/ob-fortran.el index 007debbde..8a6458b6a 100644 --- a/lisp/ob-fortran.el +++ b/lisp/ob-fortran.el @@ -33,6 +33,7 @@ (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-every "org" (pred seq)) +(declare-function org-remove-indentation "org" (code &optional n)) (defvar org-babel-tangle-lang-exts) (add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90")) From 4a27c2b4b67201e0b23f431bdaeb6460b31e1394 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 21 Nov 2013 18:33:56 +0100 Subject: [PATCH 162/166] Improved Flyspell checks * lisp/org.el (org-mode-flyspell-verify): Rewrite function using Org parser. As a consequence, Org is more cautious about areas where checks are allowed. (org-fontify-meta-lines-and-blocks-1, org-activate-footnote-links): Be subtler when removing flyspell overlays. (org-unfontify-region): Remove reference to unused `org-no-flyspell' property. (org-fontify-drawers): New function. (org-set-font-lock-defaults): Use new function to fontify drawers. * contrib/lisp/org-wikinodes.el (org-wikinodes-activate-links): Remove reference to unused `org-no-flyspell' property. --- contrib/lisp/org-wikinodes.el | 2 - lisp/org.el | 167 ++++++++++++++++++++++++++-------- 2 files changed, 127 insertions(+), 42 deletions(-) diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el index 4efc37394..6f1a4f14d 100644 --- a/contrib/lisp/org-wikinodes.el +++ b/contrib/lisp/org-wikinodes.el @@ -82,8 +82,6 @@ to `directory'." ;; in heading - deactivate flyspell (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - '(org-no-flyspell t)) t) ;; this is a wiki link (org-remove-flyspell-overlays-in (match-beginning 0) diff --git a/lisp/org.el b/lisp/org.el index bb478083b..7a4d24438 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5534,8 +5534,6 @@ The following commands are available: (abbrev-table-put org-mode-abbrev-table :parents (list text-mode-abbrev-table))) -(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) - (defsubst org-fix-ellipsis-at-bol () (save-excursion (goto-char (window-start)) (recenter 0))) @@ -5878,14 +5876,16 @@ by a #." end1 (min (point-max) (1- (match-beginning 0)))) (setq block-end (match-beginning 0)) (when quoting + (org-remove-flyspell-overlays-in beg1 end1) (remove-text-properties beg end '(display t invisible t intangible t))) (add-text-properties - beg end - '(font-lock-fontified t font-lock-multiline t)) + beg end '(font-lock-fontified t font-lock-multiline t)) (add-text-properties beg beg1 '(face org-meta-line)) - (add-text-properties end1 (min (point-max) (1+ end)) - '(face org-meta-line)) ; for end_src + (org-remove-flyspell-overlays-in beg beg1) + (add-text-properties ; For end_src + end1 (min (point-max) (1+ end)) '(face org-meta-line)) + (org-remove-flyspell-overlays-in end1 end) (cond ((and lang (not (string= lang "")) org-src-fontify-natively) (org-src-font-lock-fontify-block lang block-start block-end) @@ -5897,7 +5897,7 @@ by a #." ;; add a background overlay (setq ovl (make-overlay beg1 block-end)) (overlay-put ovl 'face 'org-block-background) - (overlay-put ovl 'evaporate t)) ;; make it go away when empty + (overlay-put ovl 'evaporate t)) ; make it go away when empty (quoting (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-block))) ; end of source block @@ -5906,11 +5906,14 @@ by a #." (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) ((string= block-type "verse") (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) - (add-text-properties beg beg1 '(face org-block-begin-line)) - (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) + (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)) t)) ((member dc1 '("+title:" "+author:" "+email:" "+date:")) + (org-remove-flyspell-overlays-in + (match-beginning 0) + (if (equal "+title:" dc1) (match-end 2) (match-end 0))) (add-text-properties beg (match-end 3) (if (member (intern (substring dc1 0 -1)) org-hidden-keywords) @@ -5919,29 +5922,43 @@ by a #." (add-text-properties (match-beginning 6) (min (point-max) (1+ (match-end 6))) (if (string-equal dc1 "+title:") - '(font-lock-fontified t face org-document-title) + '(font-lock-fontified t face org-document-title) '(font-lock-fontified t face org-document-info)))) ((or (equal dc1 "+results") (member dc1 '("+begin:" "+end:" "+caption:" "+label:" "+orgtbl:" "+tblfm:" "+tblname:" "+results:" "+call:" "+header:" "+headers:" "+name:")) (and (match-end 4) (equal dc3 "+attr"))) + (org-remove-flyspell-overlays-in + (match-beginning 0) + (if (equal "+caption:" dc1) (match-end 2) (match-end 0))) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) t) ((member dc3 '(" " "")) + (org-remove-flyspell-overlays-in beg (match-end 0)) (add-text-properties beg (match-end 0) '(font-lock-fontified t face font-lock-comment-face))) ((not (member (char-after beg) '(?\ ?\t))) ;; just any other in-buffer setting, but not indented + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) (add-text-properties beg (match-end 0) '(font-lock-fontified t face org-meta-line)) t) (t nil)))))) +(defun org-fontify-drawers (limit) + "Fontify drawers." + (when (re-search-forward org-drawer-regexp limit t) + (add-text-properties + (match-beginning 0) (match-end 0) + '(font-lock-fontified t face org-special-keyword)) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + t)) + (defun org-activate-angle-links (limit) "Run through the buffer and add overlays to links." (if (and (re-search-forward org-angle-link-re limit t) @@ -5958,15 +5975,21 @@ by a #." "Run through the buffer and add overlays to footnotes." (let ((fn (org-footnote-next-reference-or-definition limit))) (when fn - (let ((beg (nth 1 fn)) (end (nth 2 fn))) - (org-remove-flyspell-overlays-in beg end) + (let* ((beg (nth 1 fn)) + (end (nth 2 fn)) + (label (car fn)) + (referencep (/= (line-beginning-position) beg))) + (when (and referencep (nth 3 fn)) + (save-excursion + (goto-char beg) + (search-forward (or label "fn:")) + (org-remove-flyspell-overlays-in beg (match-end 0)))) (add-text-properties beg end (list 'mouse-face 'highlight 'keymap org-mouse-map 'help-echo - (if (= (point-at-bol) beg) - "Footnote definition" - "Footnote reference") + (if referencep "Footnote reference" + "Footnote definition") 'font-lock-fontified t 'font-lock-multiline t 'face 'org-footnote)))))) @@ -6231,8 +6254,7 @@ needs to be inserted at a specific position in the font-lock sequence.") '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) ;; Drawers - (list org-drawer-regexp '(0 'org-special-keyword t)) - (list "^[ \t]*:END:" '(0 'org-special-keyword t)) + '(org-fontify-drawers) ;; Properties (list org-property-re '(1 'org-special-keyword t) @@ -6465,7 +6487,7 @@ If KWD is a number, get the corresponding match group." (remove-text-properties beg end '(mouse-face t keymap t org-linked-text t invisible t intangible t - org-no-flyspell t org-emphasis t)) + org-emphasis t)) (org-remove-font-lock-display-properties beg end))) (defconst org-script-display '(((raise -0.3) (height 0.7)) @@ -23958,34 +23980,99 @@ To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." ;;; Fixes and Hacks for problems with other packages -;; Make flyspell not check words in links, to not mess up our keymap -(defvar org-element-affiliated-keywords) ; From org-element.el -(defvar org-element-block-name-alist) ; From org-element.el (defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons, or on - {todo,all-time,additional-option-like}-keywords." - (require 'org-element) ; For `org-element-affiliated-keywords' - (let ((pos (max (1- (point)) (point-min))) - (word (thing-at-point 'word))) - (and (not (get-text-property pos 'keymap)) - (not (get-text-property pos 'org-no-flyspell)) - (not (member word org-todo-keywords-1)) - (not (member word org-all-time-keywords)) - (not (member word org-options-keywords)) - (not (member word (mapcar 'car org-startup-options))) - (not (member-ignore-case word org-element-affiliated-keywords)) - (not (member-ignore-case word (org-get-export-keywords))) - (not (member-ignore-case - word (mapcar 'car org-element-block-name-alist))) - (not (member-ignore-case word '("BEGIN" "END" "ATTR"))) - (not (org-in-src-block-p))))) + "Function used for `flyspell-generic-check-word-predicate'." + (if (org-at-heading-p) + ;; At a headline or an inlinetask, check title only. This is + ;; faster than relying on `org-element-at-point'. + (and (save-excursion (beginning-of-line) + (and (let ((case-fold-search t)) + (not (looking-at "\\*+ END[ \t]*$"))) + (looking-at org-complex-heading-regexp))) + (match-beginning 4) + (>= (point) (match-beginning 4)) + (or (not (match-beginning 5)) + (< (point) (match-beginning 5)))) + (let* ((element (org-element-at-point)) + (post-affiliated (org-element-property :post-affiliated element)) + (object-check + (function + ;; Non-nil if checks can be done for object at point. + (lambda () + (let ((object (save-excursion + (when (org-looking-at-p "\\>") (backward-char)) + (org-element-context element)))) + (case (org-element-type object) + ;; Prevent checks in links due to keybinding conflict + ;; with Flyspell. + ((code entity export-snippet inline-babel-call + inline-src-block line-break latex-fragment link macro + statistics-cookie target timestamp verbatim) + nil) + (footnote-reference + ;; Only in inline footnotes, within the definition. + (and (eq (org-element-property :type object) 'inline) + (< (save-excursion + (goto-char (org-element-property :begin object)) + (search-forward ":" nil t 2)) + (point)))) + (otherwise t))))))) + (cond + ;; Ignore checks in all affiliated keywords but captions. + ((and post-affiliated (< (point) post-affiliated)) + (and (save-excursion + (beginning-of-line) + (let ((case-fold-search t)) (looking-at "[ \t]*#\\+CAPTION:"))) + (> (point) (match-end 0)) + (funcall object-check))) + ;; Ignore checks in LOGBOOK (or equivalent) drawer. + ((and org-log-into-drawer + (let ((log (or (org-string-nw-p org-log-into-drawer) "LOGBOOK")) + (parent element)) + (while (and parent (not (eq (org-element-type parent) 'drawer))) + (setq parent (org-element-property :parent parent))) + (and parent + (eq (compare-strings + log nil nil + (org-element-property :drawer-name parent) nil nil t) + t)))) + nil) + (t + (case (org-element-type element) + ((comment quote-section) t) + (comment-block + ;; Allow checks between block markers, not on them. + (and (> (line-beginning-position) + (org-element-property :post-affiliated element)) + (save-excursion + (end-of-line) + (skip-chars-forward " \r\t\n") + (< (point) (org-element-property :end element))))) + ;; Arbitrary list of keywords where checks are meaningful. + ;; Make sure point is on the value part of the element. + (keyword + (and (member (org-element-property :key element) + '("DESCRIPTION" "TITLE")) + (< (save-excursion + (beginning-of-line) (search-forward ":") (point)) + (point)))) + ;; Check is globally allowed in paragraphs verse blocks and + ;; table rows (after affiliated keywords) but some objects + ;; must not be affected. + ((paragraph table-row verse-block) + (and (>= (point) (org-element-property :contents-begin element)) + (< (point) (org-element-property :contents-end element)) + (funcall object-check))))))))) +(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) (defun org-remove-flyspell-overlays-in (beg end) "Remove flyspell overlays in region." (and (org-bound-and-true-p flyspell-mode) (fboundp 'flyspell-delete-region-overlays) - (flyspell-delete-region-overlays beg end)) - (add-text-properties beg end '(org-no-flyspell t))) + (flyspell-delete-region-overlays beg end))) + +(eval-after-load "flyspell" + '(add-to-list 'flyspell-delayed-commands 'org-self-insert-command)) ;; Make `bookmark-jump' shows the jump location if it was hidden. (eval-after-load "bookmark" From 06d1f7c3fa7f53228736975c0ae7c85653aa0501 Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Sun, 24 Nov 2013 21:38:27 +0100 Subject: [PATCH 163/166] org-license.el: add public domain functions --- contrib/lisp/org-license.el | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el index dc6d78664..48643dc6e 100644 --- a/contrib/lisp/org-license.el +++ b/contrib/lisp/org-license.el @@ -35,7 +35,10 @@ ;; ;; You can download the images from http://www.davidam/img/licenses.tar.gz ;; -;; TODO: create a function to test all combinations of licenses +;;; CHANGELOG: +;; v 0.2 - add public domain functions +;; v 0.1 - Initial release + (defvar org-license-images-directory "") @@ -69,7 +72,6 @@ Testua [[" org-license-cc-url "][Aitortu 3.0 Espainia]] lizentziari jarraituz er (setq org-license-cc-url "http://creativecommons.org/licenses/by/1.0/fi/deed.fi") (insert (concat "* Lisenssi Teksti on saatavilla [[" org-license-cc-url "][Nimeä 1.0 Suomi]] lisenssillä\n"))) -;;Nimeä 1.0 Suomi ((equal language "fr") (setq org-license-cc-url "http://creativecommons.org/licenses/by/3.0/fr/deed.fr") (insert (concat "* Licence @@ -413,11 +415,38 @@ Copyright (C) 2013 " user-full-name (insert "\n[[https://www.gnu.org/copyleft/fdl.html][file:https://upload.wikimedia.org/wikipedia/commons/thumb/4/42/GFDL_Logo.svg/200px-GFDL_Logo.svg.png]]\n") (insert (concat "\n[[https://www.gnu.org/copyleft/fdl.html][file:" org-license-images-directory "/gfdl/gfdl.png]]\n")))) +(defun org-license-publicdomain-zero (language) + (interactive "MLanguage ( en | es ): " language) + (setq org-license-pd-url "http://creativecommons.org/publicdomain/zero/1.0/") + (cond ((equal language "es") + (insert (concat "* Licencia +Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n"))) + (t + (insert (concat "* License +This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n")))) + (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))) + +(defun org-license-publicdomain-mark (language) + (interactive "MLanguage ( en | es ): " language) + (setq org-license-pd-url "http://creativecommons.org/publicdomain/mark/1.0/") + (setq org-license-pd-file "file:http://i.creativecommons.org/p/mark/1.0/80x15.png") + (cond ((equal language "es") + (insert (concat "* Licencia +Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de Dominio Público 1.0]]\n")) + (t + (insert (concat "* License +This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n")))))) + + (defun org-license-print-all () "Print all combinations of licenses and languages, it's useful to find bugs" (interactive) (org-license-gfdl "es") (org-license-gfdl "en") + (org-license-pd-mark "es") + (org-license-pd-mark "en") + (org-license-pd-zero "es") + (org-license-pd-zero "en") (org-license-cc-by "br") (org-license-cc-by "ca") (org-license-cc-by "de") From be8a1a2d69c10118985a607710a4defb823d1112 Mon Sep 17 00:00:00 2001 From: David Arroyo Menendez Date: Sun, 24 Nov 2013 22:09:37 +0100 Subject: [PATCH 164/166] org-license.el: add images directory to public domain functions --- contrib/lisp/org-license.el | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el index 48643dc6e..44a1ea743 100644 --- a/contrib/lisp/org-license.el +++ b/contrib/lisp/org-license.el @@ -418,35 +418,38 @@ Copyright (C) 2013 " user-full-name (defun org-license-publicdomain-zero (language) (interactive "MLanguage ( en | es ): " language) (setq org-license-pd-url "http://creativecommons.org/publicdomain/zero/1.0/") - (cond ((equal language "es") + (setq org-license-pd-file "zero/1.0/80x15.png") + (if (equal language "es") (insert (concat "* Licencia -Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n"))) - (t - (insert (concat "* License -This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n")))) - (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/zero/1.0/80x15.png]]\n"))) +Este documento está bajo una licencia [[" org-license-pd-url "][Public Domain Zero]]\n")) + (insert (concat "* License +This documento is under a [[" org-license-pd-url "][Public Domain Zero]] license\n"))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/zero/1.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n")))) (defun org-license-publicdomain-mark (language) (interactive "MLanguage ( en | es ): " language) (setq org-license-pd-url "http://creativecommons.org/publicdomain/mark/1.0/") - (setq org-license-pd-file "file:http://i.creativecommons.org/p/mark/1.0/80x15.png") - (cond ((equal language "es") + (setq org-license-pd-file "mark/1.0/80x15.png") + (if (equal language "es") (insert (concat "* Licencia Este documento está bajo una licencia [[" org-license-pd-url "][Etiqueta de Dominio Público 1.0]]\n")) - (t - (insert (concat "* License -This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n")))))) - + (insert (concat "* License +This documento is under a [[" org-license-pd-url "][Public Domain Mark]] license\n"))) + (if (string= "" org-license-images-directory) + (insert (concat "\n[[" org-license-pd-url "][file:http://i.creativecommons.org/p/mark/1.0/80x15.png]]\n")) + (insert (concat "\n[[" org-license-pd-url "][file:" org-license-images-directory org-license-pd-file "]]\n")))) (defun org-license-print-all () "Print all combinations of licenses and languages, it's useful to find bugs" (interactive) (org-license-gfdl "es") (org-license-gfdl "en") - (org-license-pd-mark "es") - (org-license-pd-mark "en") - (org-license-pd-zero "es") - (org-license-pd-zero "en") + (org-license-publicdomain-mark "es") + (org-license-publicdomain-mark "en") + (org-license-publicdomain-zero "es") + (org-license-publicdomain-zero "en") (org-license-cc-by "br") (org-license-cc-by "ca") (org-license-cc-by "de") From 7bee47120b71c3e87e528b809d2661b6b2633c45 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 25 Nov 2013 23:19:48 +0100 Subject: [PATCH 165/166] org-element: Update paragraph separate regexp * lisp/org-element.el (org-element-paragraph-separate): More accurate regexp. --- lisp/org-element.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/org-element.el b/lisp/org-element.el index 55efb5008..61623833f 100644 --- a/lisp/org-element.el +++ b/lisp/org-element.el @@ -143,10 +143,12 @@ "$" "\\|" ;; Tables (any type). "\\(?:|\\|\\+-[-+]\\)" "\\|" - ;; Blocks (any type), Babel calls, drawers (any type), - ;; fixed-width areas and keywords. Note: this is only an - ;; indication and need some thorough check. - "[#:]" "\\|" + ;; Blocks (any type), Babel calls and keywords. Note: this + ;; is only an indication and need some thorough check. + "#\\(?:[+ ]\\|$\\)" "\\|" + ;; Drawers (any type) and fixed-width areas. This is also + ;; only an indication. + ":" "\\|" ;; Horizontal rules. "-\\{5,\\}[ \t]*$" "\\|" ;; LaTeX environments. From 3ead82a3211c011428289930c33ea9094e602312 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 25 Nov 2013 23:31:35 +0100 Subject: [PATCH 166/166] ox-publish: Error when publishing non-existent file * lisp/ox-publish.el (org-publish-cache-ctime-of-src): Return an error when publishing a non-existent file. Suggested-by: Arne Babenhauserheide --- lisp/ox-publish.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index 67a57fa38..d87326d56 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -1225,8 +1225,9 @@ Returns value on success, else nil." (let ((attr (file-attributes (expand-file-name (or (file-symlink-p file) file) (file-name-directory file))))) - (+ (lsh (car (nth 5 attr)) 16) - (cadr (nth 5 attr))))) + (if (not attr) (error "No such file: \"%s\"" file) + (+ (lsh (car (nth 5 attr)) 16) + (cadr (nth 5 attr)))))) (provide 'ox-publish)