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 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 diff --git a/contrib/lisp/org-bibtex-extras.el b/contrib/lisp/org-bibtex-extras.el index 93c97a912..6143fdaf3 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) 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 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/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) diff --git a/contrib/lisp/org-effectiveness.el b/contrib/lisp/org-effectiveness.el new file mode 100644 index 000000000..a872cb201 --- /dev/null +++ b/contrib/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 "* CANCEL+ED")))) + +(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 "* CANCEL+ED.*\n.*")))) + (if (and (= done canc) (zerop done)) + (setq effectiveness 0) + (setq effectiveness (* 100 (/ done (+ done canc))))) + (message "Effectiveness: %f" effectiveness)))) + +(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-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-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-effectiveness-canceled-in-date(date) + (interactive "sGive me a date: " date) + (setq count (count-matches (concat "CANCEL+ED.*\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 "* CANCEL+ED.*\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/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..a670cd68b --- /dev/null +++ b/contrib/lisp/org-index.el @@ -0,0 +1,1943 @@ +;;; 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 diff --git a/contrib/lisp/org-license.el b/contrib/lisp/org-license.el new file mode 100644 index 000000000..44a1ea743 --- /dev/null +++ b/contrib/lisp/org-license.el @@ -0,0 +1,539 @@ +;;; 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 +;; +;;; CHANGELOG: +;; v 0.2 - add public domain functions +;; v 0.1 - Initial release + + +(defvar org-license-images-directory "") + +(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"))) + ((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-publicdomain-zero (language) + (interactive "MLanguage ( en | es ): " language) + (setq org-license-pd-url "http://creativecommons.org/publicdomain/zero/1.0/") + (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")) + (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 "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")) + (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-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") + (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") +) + + 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/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))))) diff --git a/contrib/lisp/ox-confluence.el b/contrib/lisp/ox-confluence.el index f5bf2474a..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. @@ -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) diff --git a/contrib/lisp/ox-rss.el b/contrib/lisp/ox-rss.el index a09366d49..2de1dbc77 100644 --- a/contrib/lisp/ox-rss.el +++ b/contrib/lisp/ox-rss.el @@ -242,7 +242,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")))))) @@ -315,7 +315,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)) diff --git a/doc/org.texi b/doc/org.texi index cf4621708..13afc89cb 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -1365,7 +1365,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. @@ -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 @@ -3876,7 +3872,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. @@ -6252,6 +6248,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}, @@ -7337,12 +7336,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}. @@ -8057,7 +8051,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}.}. @@ -9634,7 +9628,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). @@ -10875,7 +10869,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 @@ -10994,7 +10988,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. @@ -11017,11 +11011,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 @@ -11048,7 +11042,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 @@ -11195,7 +11189,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}. @@ -11792,10 +11786,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 @@ -11857,7 +11851,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. @@ -12561,13 +12555,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 @@ -12877,7 +12871,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. @@ -12910,8 +12904,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}. @@ -15858,10 +15852,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. @@ -17978,7 +17968,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-C.el b/lisp/ob-C.el index e9eec934d..35e8c621f 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -32,10 +32,12 @@ ;;; Code: (require 'ob) (require 'cc-mode) +(eval-when-compile + (require 'cl)) (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")) @@ -103,20 +105,22 @@ 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-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) + (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..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) @@ -65,7 +66,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." @@ -85,21 +99,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 +339,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 255fe8d31..e18fa7695 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -24,30 +24,39 @@ ;;; 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) +(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)) +(declare-function nrepl-current-tooling-session "ext:nrepl-client" ()) -(declare-function slime-eval "ext:slime" (sexp &optional package)) (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 +66,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 +100,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 diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index 8b03e2dcc..496c38087 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -48,12 +48,13 @@ 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 + (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) @@ -69,46 +70,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 + (let* ((string-buffer "") + (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))) + 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 diff --git a/lisp/ob-core.el b/lisp/ob-core.el index 8fafd4bb6..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" @@ -96,6 +97,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." @@ -158,6 +160,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 @@ -211,7 +218,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 @@ -234,7 +241,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 @@ -271,6 +278,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)) @@ -321,7 +329,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) @@ -480,14 +488,55 @@ 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")) "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")) + '((: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)) (defvar org-babel-data-names '("tblname" "results" "name")) @@ -568,7 +617,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))) @@ -635,15 +687,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)) @@ -651,7 +702,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 @@ -902,6 +953,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." @@ -1166,18 +1219,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." @@ -1402,7 +1455,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. @@ -1462,9 +1516,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. @@ -1607,12 +1660,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 () @@ -1649,9 +1701,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) @@ -1772,14 +1823,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. @@ -1885,7 +1935,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) @@ -1923,7 +1976,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 @@ -2255,7 +2308,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) @@ -2461,7 +2515,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) @@ -2480,119 +2534,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. @@ -2698,11 +2751,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))) - ;; 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 (org-babel-local-file-name (expand-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)) @@ -2785,6 +2835,24 @@ of `org-babel-temporary-directory'." (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +(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))))))) + (provide 'ob-core) ;; Local variables: 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-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 diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index 450512910..e8a5f2ff7 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -53,25 +53,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..0a8edc261 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))) @@ -110,12 +112,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 "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")) @@ -174,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)) @@ -372,7 +378,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..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")) @@ -60,20 +61,21 @@ (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-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) + (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-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-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 0f37653d9..07134895b 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -75,30 +75,26 @@ 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)) - 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 + (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)) + result + (condition-case nil + (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)) 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-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 17da109ca..3c3f66468 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -54,7 +54,7 @@ This will typically be either 'python or 'python-mode." :group 'org-babel :version "24.4" :package-version '(Org . "8.0") - :type 'function) + :type 'symbol) (defvar org-src-preserve-indentation) @@ -70,7 +70,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. @@ -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*"))) @@ -157,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)))) @@ -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 @@ -189,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 @@ -207,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 @@ -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-ref.el b/lisp/ob-ref.el index 5a3c8ba2e..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]*") @@ -85,7 +87,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) @@ -120,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." @@ -184,6 +189,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) @@ -199,6 +209,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))))) diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index eea517df3..cee9b0fc3 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. @@ -139,13 +137,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 +201,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..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'") @@ -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 29415c47c..1f872784d 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)) @@ -38,6 +36,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 @@ -107,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) @@ -149,16 +148,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." @@ -179,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 @@ -213,8 +214,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) @@ -227,9 +228,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) @@ -331,9 +332,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")) @@ -355,16 +355,16 @@ 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) - (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) (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 @@ -426,11 +426,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" @@ -442,28 +441,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)))) @@ -498,9 +498,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 0bfba27f0..68099b123 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" ()) @@ -863,7 +864,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 @@ -1419,13 +1420,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 +1748,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. @@ -2840,6 +2841,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. @@ -3642,7 +3645,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 +3684,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) @@ -3817,6 +3818,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 @@ -3985,6 +3988,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. @@ -4581,7 +4585,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) @@ -4591,7 +4595,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) @@ -5449,6 +5453,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?" @@ -5765,7 +5770,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." @@ -7083,6 +7087,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 @@ -7532,9 +7537,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 @@ -8627,15 +8634,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) @@ -9150,7 +9152,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 @@ -9916,11 +9918,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)))) @@ -9928,11 +9931,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)))) 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-bibtex.el b/lisp/org-bibtex.el index 1f71d91ae..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."))) ;; @@ -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-capture.el b/lisp/org-capture.el index 0a6e4e462..39804ac3c 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. @@ -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))) @@ -787,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." @@ -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")) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 3195dc178..541eeb9eb 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 @@ -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))) (hour (nth 2 dt)) (day (nth 3 dt))) @@ -1378,12 +1378,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))) @@ -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) @@ -1873,6 +1873,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 @@ -2145,6 +2146,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 @@ -2754,6 +2756,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 8790ad45f..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) @@ -416,6 +417,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." @@ -666,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) @@ -901,10 +907,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) @@ -951,6 +953,8 @@ Don't set this, this is meant for dynamic scoping.") (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 @@ 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-compat.el b/lisp/org-compat.el index c4d15d8e6..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." @@ -335,10 +337,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)))) diff --git a/lisp/org-crypt.el b/lisp/org-crypt.el index b02a7ceff..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,8 +163,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 +172,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 +208,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 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-element.el b/lisp/org-element.el index 329d00a4d..bbc0f3862 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: @@ -143,10 +144,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. @@ -513,9 +516,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 @@ -566,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 @@ -624,8 +626,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 @@ -686,8 +687,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 @@ -859,7 +859,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)) @@ -962,8 +962,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 @@ -1062,9 +1061,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 @@ -1146,9 +1145,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 +1217,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)))))))) @@ -1242,15 +1238,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 @@ -1308,8 +1309,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 @@ -1359,8 +1359,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 @@ -1446,8 +1445,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 @@ -1503,8 +1501,7 @@ containing `:begin', `:end', `:value', `:post-blank' and (line-end-position)))) (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 @@ -1606,8 +1603,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 @@ -1652,8 +1648,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 @@ -1692,8 +1687,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 @@ -1711,35 +1705,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 +1734,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,17 +1756,16 @@ 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))) (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 @@ -1821,10 +1784,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"))) @@ -1860,8 +1827,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 @@ -1915,8 +1881,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 @@ -1954,8 +1919,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 @@ -1992,8 +1956,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 @@ -2040,8 +2003,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 @@ -2173,8 +2135,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 @@ -2324,9 +2285,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,18 +2306,17 @@ 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))) ;; 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 @@ -2383,15 +2342,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)) @@ -2432,8 +2393,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 @@ -2533,8 +2493,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 @@ -3593,100 +3552,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. @@ -4430,71 +4386,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. @@ -4646,7 +4622,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. @@ -4654,8 +4630,432 @@ 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--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 +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 (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)) + (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--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--cache-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 + (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 (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)))))) ;;;###autoload (defun org-element-at-point (&optional keep-trail) @@ -4687,96 +5087,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) @@ -4798,20 +5226,20 @@ 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. ((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))) @@ -4832,8 +5260,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 "* ") @@ -4859,44 +5286,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." @@ -4972,6 +5447,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/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-footnote.el b/lisp/org-footnote.el index 3c0d97c3a..f4c9273b4 100644 --- a/lisp/org-footnote.el +++ b/lisp/org-footnote.el @@ -106,8 +106,18 @@ 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-default + :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))) 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-inlinetask.el b/lisp/org-inlinetask.el index 112d3df20..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) @@ -315,7 +314,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 () diff --git a/lisp/org-list.el b/lisp/org-list.el index 4a3d471f0..78729af7c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -88,11 +88,11 @@ (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) (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)) @@ -430,9 +430,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 +473,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 +544,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 +628,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 +690,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 +756,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 +2316,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 +2337,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-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-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-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-src.el b/lisp/org-src.el index 6ec3adc47..8db73c64f 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" @@ -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)) @@ -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-table.el b/lisp/org-table.el index 7be77ccba..65261663d 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 @@ -921,6 +921,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." @@ -934,6 +935,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." @@ -1205,6 +1207,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) @@ -3016,6 +3019,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 @@ -4136,7 +4141,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 diff --git a/lisp/org.el b/lisp/org.el index 0fd531d10..7a4d24438 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 @@ -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" ()) @@ -140,6 +149,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" @@ -160,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) @@ -198,7 +212,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) @@ -304,18 +319,214 @@ 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))) + (if message (message version1)) + version1))) (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 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.") + +(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 clock drawer.") + +(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the last line of a clock 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-clock-drawer-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 @@ -357,7 +568,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. @@ -654,11 +866,17 @@ 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'. `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 +\"_\" 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,13 +884,14 @@ 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" + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Always interpret" t) (const :tag "Only with braces" {}) @@ -713,7 +932,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 @@ -824,34 +1043,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 @@ -860,35 +1051,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-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" @@ -1003,7 +1165,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) @@ -1037,7 +1205,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 @@ -1072,23 +1240,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 @@ -1731,7 +1882,12 @@ In tables, the special behavior of RET has precedence." 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") + :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. @@ -2054,16 +2210,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 +2247,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 @@ -2346,7 +2499,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.") @@ -2666,12 +2818,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)) @@ -2851,10 +3003,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. @@ -3522,13 +3670,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")) @@ -4224,36 +4365,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.") - -;; 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.") - ;;;###autoload (defun turn-on-orgtbl () "Unconditionally turn on `orgtbl-mode'." @@ -4331,12 +4442,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" @@ -4362,11 +4467,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." @@ -4461,16 +4561,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 @@ -4566,39 +4656,21 @@ 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 -(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) @@ -4784,22 +4856,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'." @@ -4807,6 +4863,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 @@ -4977,8 +5035,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 +5090,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 +5149,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 @@ -5267,7 +5318,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. @@ -5391,6 +5441,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) @@ -5460,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 @@ -5479,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))) @@ -5662,35 +5715,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) @@ -5705,7 +5729,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) @@ -5852,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) @@ -5871,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 @@ -5880,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) @@ -5893,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) @@ -5932,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)))))) @@ -6205,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) @@ -6439,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)) @@ -6624,11 +6672,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. @@ -6717,6 +6764,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) @@ -7058,8 +7107,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,27 +7122,45 @@ 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) + (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 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. -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?" @@ -7477,7 +7546,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 +7577,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) @@ -7570,7 +7643,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) ",* " "* ")) @@ -7632,9 +7706,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 @@ -7770,7 +7844,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. @@ -7938,8 +8012,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 @@ -8522,8 +8594,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) @@ -8609,7 +8680,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 @@ -8843,13 +8916,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 @@ -9010,8 +9083,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)) @@ -9037,14 +9110,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 @@ -10024,7 +10096,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))) @@ -10323,6 +10396,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. @@ -10477,11 +10551,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))) @@ -10539,7 +10631,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)) @@ -10684,7 +10777,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 @@ -11097,7 +11189,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))) @@ -11747,7 +11841,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) @@ -11833,13 +11929,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." @@ -12121,6 +12210,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, @@ -12141,8 +12245,9 @@ 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. -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 @@ -12160,6 +12265,7 @@ For calling through lisp, 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) @@ -12453,7 +12559,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") @@ -12825,7 +12931,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 (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)) @@ -12948,6 +13054,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) @@ -13018,6 +13125,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) @@ -13090,6 +13198,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. @@ -13370,9 +13481,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) @@ -13417,17 +13526,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) @@ -14404,7 +14516,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) @@ -14553,7 +14665,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))) @@ -14953,7 +15065,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) @@ -15035,28 +15146,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) @@ -15186,103 +15275,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. @@ -15302,30 +15390,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. @@ -15335,13 +15425,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)) @@ -15350,9 +15437,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))))) @@ -15631,23 +15716,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 @@ -15783,17 +15859,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"))) @@ -16021,8 +16095,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) @@ -16211,6 +16283,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. @@ -16357,9 +16433,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 @@ -18048,10 +18121,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 @@ -18061,6 +18134,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) @@ -18080,8 +18154,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 @@ -18104,7 +18176,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 @@ -18202,17 +18275,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 @@ -18834,63 +18896,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 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. -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)) + (not (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") @@ -19506,9 +19618,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." @@ -19523,7 +19632,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))) @@ -20382,7 +20491,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) @@ -21076,7 +21185,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) @@ -21129,7 +21238,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))))) @@ -21678,15 +21787,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." @@ -21747,10 +21854,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. @@ -22152,7 +22255,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))))) @@ -22477,65 +22580,97 @@ 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 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))) + (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)))))))) +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 @@ -23845,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" diff --git a/lisp/ox-ascii.el b/lisp/ox-ascii.el index 8e750078e..b278ab663 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 @@ -336,7 +338,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 +350,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) @@ -489,7 +461,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 @@ -710,7 +682,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 @@ -748,7 +720,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 @@ -1071,11 +1043,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 +1196,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-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 b425e55d8..951f6c3bc 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 @@ -152,7 +154,7 @@ \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">") ("xhtml-transitional" . "") - ("xhtml-framset" . "") ("xhtml-11" . "") @@ -185,7 +187,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 @@ -382,7 +384,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 @@ -543,6 +545,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)) @@ -564,7 +568,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: @@ -576,10 +581,10 @@ 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") :type 'function) ;;;; Footnotes @@ -621,7 +626,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: @@ -633,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 "24.4" + :package-version '(Org . "8.0") :type 'function) ;;;; HTML-specific @@ -648,7 +655,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: @@ -661,6 +668,8 @@ The function must accept six parameters: The function should return the string to be exported." :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") :type 'function) ;;;; LaTeX @@ -1118,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 @@ -1971,33 +1982,44 @@ and value is its relative level, as an integer." "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 ".") ". "))) + (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 "-")))) + (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 + (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. @@ -2237,7 +2259,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))) @@ -2364,9 +2386,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 @@ -3074,7 +3096,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-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 b0cc4bb91..3faeb5340 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 @@ -343,7 +345,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 +491,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 +509,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. @@ -525,20 +532,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}") @@ -568,7 +561,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: @@ -577,19 +571,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: @@ -669,8 +660,9 @@ into previewing problems, please consult :group 'org-export-latex :type '(choice (const :tag "Use listings" t) - (const :tag "Use minted" 'minted) - (const :tag "Export verbatim" nil))) + (const :tag "Use minted" minted) + (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") @@ -1077,6 +1069,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 @@ -1224,12 +1221,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))) @@ -1337,13 +1330,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) @@ -1514,7 +1507,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. @@ -1634,7 +1627,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 @@ -2649,7 +2642,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 +2653,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") @@ -2903,9 +2896,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))))) diff --git a/lisp/ox-md.el b/lisp/ox-md.el index 14e881d24..71a3e628d 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 @@ -20,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 775fe1d55..1743854fe 100644 --- a/lisp/ox-odt.el +++ b/lisp/ox-odt.el @@ -224,7 +224,7 @@ standard Emacs.") (defconst org-odt-table-style-format " - + " "Template for auto-generated Table styles.") @@ -450,7 +450,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. @@ -499,7 +499,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 @@ -597,7 +598,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. @@ -646,7 +647,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 +657,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 +685,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: @@ -747,6 +744,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 "24.4" + :package-version '(Org . "8.0") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -758,6 +757,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 "24.4" + :package-version '(Org . "8.0") :type '(alist :key-type (string :tag "Type") :value-type (regexp :tag "Path"))) @@ -920,7 +921,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 @@ -930,6 +931,8 @@ the application UI or through a custom styles file. See `org-odt--build-date-styles' for implementation details." :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") :type 'boolean) @@ -1437,7 +1440,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 @@ -1457,7 +1460,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 @@ -1620,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)) @@ -1722,7 +1721,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)) @@ -1806,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)))) @@ -1932,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 @@ -2196,7 +2195,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 @@ -2343,7 +2342,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. @@ -2373,7 +2371,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 @@ -2411,7 +2409,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) @@ -2615,12 +2613,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." @@ -2709,7 +2707,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)) @@ -2722,7 +2720,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))) @@ -3114,9 +3112,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. @@ -3126,12 +3124,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 022474a82..32262e2b6 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 @@ -85,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) @@ -130,22 +133,62 @@ 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) "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 @@ -164,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. @@ -173,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 @@ -195,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. @@ -203,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) diff --git a/lisp/ox-publish.el b/lisp/ox-publish.el index cfa796743..4775e08ee 100644 --- a/lisp/ox-publish.el +++ b/lisp/ox-publish.el @@ -1226,8 +1226,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) diff --git a/lisp/ox-texinfo.el b/lisp/ox-texinfo.el index c834087f0..559f70927 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 @@ -144,7 +144,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")) @@ -203,7 +203,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: @@ -317,7 +317,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: @@ -326,18 +327,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: @@ -411,6 +409,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 @@ -696,9 +701,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" @@ -706,8 +709,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" @@ -869,12 +881,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 @@ -950,7 +958,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 @@ -986,10 +994,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) @@ -1023,7 +1031,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) @@ -1038,7 +1046,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) @@ -1140,7 +1148,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 d00bb17eb..ff9b9f744 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 @@ -88,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 ;; @@ -643,11 +650,20 @@ 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'. `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. 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 @@ -655,15 +671,14 @@ 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 + :version "24.4" + :package-version '(Org . "8.0") :type '(choice (const :tag "Interpret them" t) (const :tag "Curly brackets only" {}) @@ -839,15 +854,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)) + :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'. @@ -1242,7 +1265,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 @@ -1325,6 +1348,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 @@ -1779,7 +1806,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)))))) @@ -2891,7 +2919,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'." @@ -3194,8 +3222,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 @@ -4192,17 +4219,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) @@ -4646,7 +4677,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 @@ -4657,7 +4688,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. @@ -4667,7 +4698,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)) @@ -4676,7 +4707,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)) @@ -4704,7 +4735,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)) @@ -4951,6 +4982,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 "’’") @@ -5126,11 +5169,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. @@ -5183,14 +5221,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 @@ -5218,14 +5253,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 @@ -5272,6 +5304,22 @@ them." ("uk" :html "Автор" :utf-8 "Автор") ("zh-CN" :html "作者" :utf-8 "作者") ("zh-TW" :html "作者" :utf-8 "作者")) + ("Continued from previous page" + ("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" + ("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") @@ -5380,8 +5428,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") @@ -5389,7 +5437,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") @@ -5544,12 +5592,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. @@ -5916,7 +5969,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. @@ -5924,7 +5977,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. diff --git a/mk/default.mk b/mk/default.mk index 5cb75c357..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,17 +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)' + --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 cc4e032cc..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 = \# @@ -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 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"))) diff --git a/testing/lisp/test-ob.el b/testing/lisp/test-ob.el index 93c026b9a..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 () @@ -1181,6 +1184,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 diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 103ba99a3..e533b6520 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 @@ -276,8 +280,12 @@ Some other text ;; 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 @@ -285,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 @@ -295,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)) @@ -360,15 +366,19 @@ 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 " + (= (org-element-property :end (org-element-at-point)) (point-max))))) ;;;; Comment Block @@ -378,18 +388,20 @@ 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))) ;; 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 @@ -406,7 +418,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 @@ -415,21 +431,20 @@ 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))) + ;; 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 @@ -449,8 +464,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 @@ -504,16 +523,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" @@ -524,7 +535,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." @@ -654,20 +669,23 @@ Some other text 'export-block 'identity))) ;; 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 @@ -687,7 +705,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 @@ -709,8 +727,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 @@ -737,8 +758,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. @@ -858,25 +882,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." @@ -909,7 +937,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 @@ -1008,7 +1040,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 @@ -1074,14 +1110,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 @@ -1107,7 +1142,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 @@ -1148,7 +1187,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 @@ -1401,26 +1444,19 @@ 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" (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" @@ -1445,7 +1481,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 @@ -1509,26 +1549,27 @@ 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-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))) + ;; 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 @@ -1542,8 +1583,11 @@ Outside list" ;; 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 @@ -1624,7 +1668,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 @@ -1645,16 +1693,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" @@ -1665,7 +1705,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 @@ -1764,9 +1808,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 @@ -1931,34 +1977,37 @@ Outside list" ;; 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))))) ;;; 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 @@ -1970,7 +2019,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." @@ -1981,8 +2042,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 () @@ -2149,16 +2209,15 @@ 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\\]" + (org-test-parse-and-interpret "CLOCK: [2012-01-01 sun. 00:01]"))) ;; Closed clock. (should - (equal - (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"))) + (string-match + "CLOCK: \\[2012-01-01 .* 00:01\\]--\\[2012-01-01 .* 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." @@ -2254,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 - (equal - (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")))) + (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.]")))) (ert-deftest test-org-element/property-drawer-interpreter () "Test property drawer interpreter." @@ -2333,8 +2389,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 @@ -2342,8 +2399,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\\]" @@ -2352,9 +2410,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>" @@ -2364,9 +2423,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\\]" @@ -2379,8 +2439,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>" @@ -2407,9 +2468,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>" @@ -2492,20 +2554,12 @@ DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01> CLOSED: [2012-01-01]\n")))) (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." @@ -2884,6 +2938,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 diff --git a/testing/lisp/test-org-table.el b/testing/lisp/test-org-table.el index 5386726bc..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: @@ -421,7 +420,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 :: " @@ -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 diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 32fa69ebc..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))))) @@ -392,21 +410,41 @@ (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." + ;; 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))))) @@ -1274,6 +1312,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) diff --git a/testing/lisp/test-ox.el b/testing/lisp/test-ox.el index 5a066a56c..940beeb00 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." @@ -400,42 +400,36 @@ 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\\]" + (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 "" - (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?" @@ -468,11 +462,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:")) @@ -509,8 +504,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))))) @@ -523,24 +518,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." @@ -2756,6 +2751,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 @@ -2816,6 +2817,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 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 4f705102c..565a384d0 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)) @@ -423,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 () @@ -430,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))