diff --git a/Makefile b/Makefile index 66a637cb2..9dc4ba856 100644 --- a/Makefile +++ b/Makefile @@ -19,18 +19,18 @@ help:: $(info ============) $(info ) $(info make help - show brief help) - $(info make targets - dito) + $(info make targets - ditto) $(info make helpall - show extended help) $(info ) $(info Build and Check) $(info ===============) $(info make - build Org ELisp and all documentation) - $(info make all - dito) + $(info make all - ditto) $(info make compile - build Org ELisp files) $(info make autoloads - create org-install.el to load org in-place) $(info make check - build Org ELisp files and run test suite) helpall:: - $(info make test - dito) + $(info make test - ditto) $(info make compile-dirty - build only stale Org ELisp files) $(info make test-dirty - check without building first) $(info ) @@ -54,9 +54,9 @@ helpall:: $(info make cleandirs - clean in etc/, lisp/ and doc/) $(info make cleancontrib - remove remnants in contrib/) $(info make cleandoc - remove built documentation) - $(info make cleandocs - dito) + $(info make cleandocs - ditto) $(info make cleanlisp - remove built Org ELisp files) - $(info make cleanelc - dito) + $(info make cleanelc - ditto) $(info make cleanrel - remove release remnants) $(info make cleantest - remove check remnants) $(info make clean-install - remove previous Org installation) @@ -66,14 +66,14 @@ helpall:: help:: $(info make doc - build all documentation) helpall:: - $(info make docs - dito) + $(info make docs - ditto) help:: $(info make info - build Info documentation) helpall:: $(info make html - build HTML documentation) $(info make pdf - build PDF documentation) $(info make card - build reference cards) - $(info make refcard - dito) + $(info make refcard - ditto) help:: $(info ) $(info Installation) diff --git a/UTILITIES/manfull.pl b/UTILITIES/manfull.pl index bea192fbb..680b87862 100755 --- a/UTILITIES/manfull.pl +++ b/UTILITIES/manfull.pl @@ -12,10 +12,10 @@ while () { print OUT ''; } elsif (/
/) { print OUT; - print OUT '
'; + print OUT '

This is the official manual for the latest Org-mode release.

'; } elsif (/

Table of Contents<\/h2>/) { print OUT; - print OUT '
'; + print OUT 'http://orgmode.org
'; $toc = 1; } elsif (/<\/div>/ and $toc) { print OUT "

"; diff --git a/UTILITIES/mansplit.pl b/UTILITIES/mansplit.pl index e24b34fea..01ac85111 100755 --- a/UTILITIES/mansplit.pl +++ b/UTILITIES/mansplit.pl @@ -10,6 +10,7 @@ $contents = < +

This is the official manual for the latest Org-mode release.

Table of Contents

\n"))) -(defun org-html-export-list-line (line pos struct prevs) - "Insert list syntax in export buffer. Return LINE, maybe modified. +(defun org-html-export-list-line (org-line pos struct prevs) + "Insert list syntax in export buffer. Return ORG-LINE, maybe modified. -POS is the item position or line position the line had before +POS is the item position or org-line position the org-line had before modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type @@ -2626,10 +2626,10 @@ the alist of previous items." "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?" - "\\(.*\\)") line) - (let* ((checkbox (match-string 3 line)) - (desc-tag (or (match-string 4 line) "???")) - (body (or (match-string 5 line) "")) + "\\(.*\\)") org-line) + (let* ((checkbox (match-string 3 org-line)) + (desc-tag (or (match-string 4 org-line) "???")) + (body (or (match-string 5 org-line) "")) (list-beg (org-list-get-list-begin pos struct prevs)) (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in @@ -2663,9 +2663,9 @@ the alist of previous items." ;; Return modified line body)) ;; At a list ender: go to next line (side-effects only). - ((equal "ORG-LIST-END-MARKER" line) (throw 'nextline nil)) + ((equal "ORG-LIST-END-MARKER" org-line) (throw 'nextline nil)) ;; Not at an item: return line unchanged (side-effects only). - (t line)))) + (t org-line)))) (provide 'org-html) diff --git a/lisp/org-indent.el b/lisp/org-indent.el index 43de325be..97a1ec3ca 100644 --- a/lisp/org-indent.el +++ b/lisp/org-indent.el @@ -183,9 +183,11 @@ during idle time." nil " Ind" nil (org-set-local 'org-hide-leading-stars-before-indent-mode org-hide-leading-stars) (org-set-local 'org-hide-leading-stars t)) - (make-local-variable 'buffer-substring-filters) - (add-to-list 'buffer-substring-filters - 'org-indent-remove-properties-from-string) + (make-local-variable 'filter-buffer-substring-functions) + (add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) (org-add-hook 'before-change-functions 'org-indent-notify-modified-headline nil 'local) @@ -209,9 +211,10 @@ during idle time." nil " Ind" nil (when (boundp 'org-hide-leading-stars-before-indent-mode) (org-set-local 'org-hide-leading-stars org-hide-leading-stars-before-indent-mode)) - (setq buffer-substring-filters - (delq 'org-indent-remove-properties-from-string - buffer-substring-filters)) + (remove-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) (remove-hook 'before-change-functions 'org-indent-notify-modified-headline 'local) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 47472bb05..9f58456ac 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -1522,7 +1522,7 @@ OPT-PLIST is the options plist for current buffer." (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" (org-export-latex-fontify-headline keywords) (org-export-latex-fontify-headline description) - (concat "Emacs Org-mode version " org-version)) + (concat "Emacs Org-mode version " (org-version))) ;; beginning of the document "\n\\begin{document}\n\n" ;; insert the title command diff --git a/lisp/org-list.el b/lisp/org-list.el index 882ce3d24..dd0509459 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -714,15 +714,15 @@ Assume point is at an item." ;; equally indented than BEG-CELL's cdr. Also, store ending ;; position of items in END-LST-2. (catch 'exit - (while t - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (while t + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) (org-get-indentation)))) - (cond - ((>= (point) lim-down) + (cond + ((>= (point) lim-down) ;; At downward limit: this is de facto the end of the ;; list. Save point as an ending position, and jump to ;; part 3. - (throw 'exit + (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) ;; At a verbatim block, move to its end. Point is at bol ;; and 'org-example property is set by whole lines: @@ -1106,8 +1106,10 @@ It determines the number of whitespaces to append by looking at (defun org-list-swap-items (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. -Blank lines at the end of items are left in place. Return the -new structure after the changes. + +Blank lines at the end of items are left in place. Item +visibility is preserved. Return the new structure after the +changes. Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong to the same sub-list. @@ -1124,7 +1126,17 @@ This function modifies STRUCT." (body-B (buffer-substring beg-B end-B-no-blank)) (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) - (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct))) + ;; Store overlays responsible for visibility status. We + ;; also need to store their boundaries as they will be + ;; removed from buffer. + (overlays (cons + (mapcar (lambda (ov) + (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-A end-A)) + (mapcar (lambda (ov) + (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-B end-B))))) ;; 1. Move effectively items in buffer. (goto-char beg-A) (delete-region beg-A end-B-no-blank) @@ -1157,7 +1169,22 @@ This function modifies STRUCT." (setcar e (+ pos (- size-B size-A))) (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) struct) - (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) + (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + ;; Restore visibility status, by moving overlays to their new + ;; position. + (mapc (lambda (ov) + (move-overlay + (car ov) + (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) + (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) + (car overlays)) + (mapc (lambda (ov) + (move-overlay (car ov) + (+ (nth 1 ov) (- beg-A beg-B)) + (+ (nth 2 ov) (- beg-A beg-B)))) + (cdr overlays)) + ;; Return structure. + struct))) (defun org-list-separating-blank-lines-number (pos struct prevs) "Return number of blank lines that should separate items in list. @@ -1374,8 +1401,8 @@ If DEST is a buffer position, the function will assume it points to another item in the same list as ITEM, and will move the latter just before the former. -If DEST is `begin' \(respectively `end'\), ITEM will be moved at -the beginning \(respectively end\) of the list it belongs to. +If DEST is `begin' (respectively `end'), ITEM will be moved at +the beginning (respectively end) of the list it belongs to. If DEST is a string like \"N\", where N is an integer, ITEM will be moved at the Nth position in the list. @@ -1385,6 +1412,8 @@ added to the kill-ring. If DEST is `delete', ITEM will be deleted. +Visibility of item is preserved. + This function returns, destructively, the new list structure." (let* ((prevs (org-list-prevs-alist struct)) (item-end (org-list-get-item-end item struct)) @@ -1427,7 +1456,9 @@ This function returns, destructively, the new list structure." (org-list-get-last-item item struct prevs)) (point-at-eol))))) (t dest))) - (org-M-RET-may-split-line nil)) + (org-M-RET-may-split-line nil) + ;; Store visibility. + (visibility (overlays-in item item-end))) (cond ((eq dest 'delete) (org-list-delete-item item struct)) ((eq dest 'kill) @@ -1463,9 +1494,14 @@ This function returns, destructively, the new list structure." (+ end shift))))))) moved-items)) (lambda (e1 e2) (< (car e1) (car e2)))))) - ;; 2. Eventually delete extra copy of the item and clean marker. - (prog1 - (org-list-delete-item (marker-position item) struct) + ;; 2. Restore visibility. + (mapc (lambda (ov) + (move-overlay ov + (+ (overlay-start ov) (- (point) item)) + (+ (overlay-end ov) (- (point) item)))) + visibility) + ;; 3. Eventually delete extra copy of the item and clean marker. + (prog1 (org-list-delete-item (marker-position item) struct) (move-marker item nil))) (t struct)))) @@ -2182,13 +2218,15 @@ item is invisible." "Mark the current list. If this is a sublist, only mark the sublist." (interactive) - (let* ((item (org-list-get-item-begin)) - (struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (lbeg (org-list-get-list-begin item struct prevs)) - (lend (org-list-get-list-end item struct prevs))) - (push-mark lend nil t) - (goto-char lbeg))) + (if (not (org-at-item-p)) + (error "Not on a list") + (let* ((item (org-list-get-item-begin)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (lbeg (org-list-get-list-begin item struct prevs)) + (lend (org-list-get-list-end item struct prevs))) + (push-mark lend nil t) + (goto-char lbeg)))) (defun org-list-repair () "Fix indentation, bullets and checkboxes is the list at point." diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 481558fed..1c2524933 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -372,7 +372,8 @@ point nowhere." (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." - `(let* ((org-outline-regexp (org-get-limited-outline-regexp)) + `(let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) (outline-regexp org-outline-regexp) (org-outline-regexp-at-bol (concat "^" org-outline-regexp))) ,@body)) diff --git a/lisp/org-odt.el b/lisp/org-odt.el index 1560bbafe..cec0e8c73 100644 --- a/lisp/org-odt.el +++ b/lisp/org-odt.el @@ -2383,8 +2383,7 @@ visually." (org-odt-format-tags '("\n" . "") (when org-export-creator-info (format "Org-%s/Emacs-%s" - (if (boundp 'org-version) org-version - "Unknown") + (org-version) emacs-version))) (org-odt-format-tags '("\n" . "") keywords) (org-odt-format-tags '("\n" . "") description) diff --git a/lisp/org-remember.el b/lisp/org-remember.el index 46e346064..7af235b81 100644 --- a/lisp/org-remember.el +++ b/lisp/org-remember.el @@ -277,9 +277,6 @@ opposite case, the default, t, is more useful." :group 'org-remember :type 'boolean) -(defvar annotation) ; from remember.el, dynamically scoped in `remember-mode' -(defvar initial) ; from remember.el, dynamically scoped in `remember-mode' - ;;;###autoload (defun org-remember-insinuate () "Setup remember.el for use with Org-mode." @@ -431,10 +428,10 @@ to be run from that hook to function properly." ;; `initial' and `annotation' are bound in `remember'. ;; But if the property list has them, we prefer those values (v-i (or (plist-get org-store-link-plist :initial) - (and (boundp 'initial) initial) + (and (boundp 'initial) (symbol-value 'initial)) "")) (v-a (or (plist-get org-store-link-plist :annotation) - (and (boundp 'annotation) annotation) + (and (boundp 'annotation) (symbol-value 'annotation)) "")) ;; Is the link empty? Then we do not want it... (v-a (if (equal v-a "[[]]") "" v-a)) @@ -476,7 +473,7 @@ to be run from that hook to function properly." (erase-buffer) (insert (substitute-command-keys (format -"## %s \"%s\" -> \"* %s\" + "## %s \"%s\" -> \"* %s\" ## C-u C-c C-c like C-c C-c, and immediately visit note at target location ## C-0 C-c C-c \"%s\" -> \"* %s\" ## %s to select file and header location interactively. @@ -505,18 +502,20 @@ to be run from that hook to function properly." filename error))))))) ;; Simple %-escapes (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) - (unless (org-remember-escaped-%) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match - (or (eval (intern (concat "v-" (match-string 1)))) "") - t t))) + (let ((init (and (boundp 'initial) + (symbol-value 'initial)))) + (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t) + (unless (org-remember-escaped-%) + (when (and init (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string init "\n") + (concat "\n" lead)))))) + (replace-match + (or (eval (intern (concat "v-" (match-string 1)))) "") + t t)))) ;; %() embedded elisp (goto-char (point-min)) @@ -536,10 +535,10 @@ to be run from that hook to function properly." (when plist-p (goto-char (point-min)) (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-remember-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) + (unless (org-remember-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) ;; Turn on org-mode in the remember buffer, set local variables (let ((org-inhibit-startup t)) (org-mode) (org-remember-mode 1)) diff --git a/lisp/org-special-blocks.el b/lisp/org-special-blocks.el index 43b37c640..89161f378 100644 --- a/lisp/org-special-blocks.el +++ b/lisp/org-special-blocks.el @@ -80,17 +80,17 @@ seen. This is run after a few special cases are taken care of." (add-hook 'org-export-latex-after-blockquotes-hook 'org-special-blocks-convert-latex-special-cookies) -(defvar line) +(defvar org-line) (defun org-special-blocks-convert-html-special-cookies () "Converts the special cookies into div blocks." - ;; Uses the dynamically-bound variable `line'. - (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" line) + ;; Uses the dynamically-bound variable `org-line'. + (when (string-match "^ORG-\\(.*\\)-\\(START\\|END\\)$" org-line) (message "%s" (match-string 1)) - (when (equal (match-string 2 line) "START") + (when (equal (match-string 2 org-line) "START") (org-close-par-maybe) - (insert "\n
") + (insert "\n
") (org-open-par)) - (when (equal (match-string 2 line) "END") + (when (equal (match-string 2 org-line) "END") (org-close-par-maybe) (insert "\n
") (org-open-par)) diff --git a/lisp/org-table.el b/lisp/org-table.el index 618c0a792..5b3a09e0a 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2090,22 +2090,23 @@ When NAMED is non-nil, look for a named equation." (defun org-table-store-formulas (alist) "Store the list of formulas below the current table." (setq alist (sort alist 'org-table-formula-less-p)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 3)) - (delete-region (match-beginning 3) (match-end 0))) - (org-indent-line-function) - (insert (match-string 2))) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n"))) + (let ((case-fold-search t)) + (save-excursion + (goto-char (org-table-end)) + (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") + (progn + ;; don't overwrite TBLFM, we might use text properties to store stuff + (goto-char (match-beginning 3)) + (delete-region (match-beginning 3) (match-end 0))) + (org-indent-line-function) + (insert (or (match-string 2) "#+TBLFM:"))) + (insert " " + (mapconcat (lambda (x) + (concat + (if (equal (string-to-char (car x)) ?@) "" "$") + (car x) "=" (cdr x))) + alist "::") + "\n")))) (defsubst org-table-formula-make-cmp-string (a) (when (string-match "\\`$[<>]" a) @@ -2277,7 +2278,7 @@ If yes, store the formula and apply it." (when org-table-formula-evaluate-inline (let* ((field (org-trim (or (org-table-get-field) ""))) named eq) - (when (string-match "^:?=\\(.*\\)" field) + (when (string-match "^:?=\\(.*[^=]\\)$" field) (setq named (equal (string-to-char field) ?:) eq (match-string 1 field)) (if (or (fboundp 'calc-eval) @@ -2370,7 +2371,7 @@ of the new mark." (looking-at org-table-auto-recalculate-regexp)) (org-table-recalculate) t)) -(defvar org-table-modes) +(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula' (defsubst org-set-calc-mode (var &optional value) (if (stringp var) (setq var (assoc var '(("D" calc-angle-mode deg) @@ -2378,10 +2379,10 @@ of the new mark." ("F" calc-prefer-frac t) ("S" calc-symbolic-mode t))) value (nth 2 var) var (nth 1 var))) - (if (memq var org-table-modes) - (setcar (cdr (memq var org-table-modes)) value) - (cons var (cons value org-table-modes))) - org-table-modes) + (if (memq var org-tbl-calc-modes) + (setcar (cdr (memq var org-tbl-calc-modes)) value) + (cons var (cons value org-tbl-calc-modes))) + org-tbl-calc-modes) (defun org-table-eval-formula (&optional arg equation suppress-align suppress-const @@ -2439,7 +2440,7 @@ not overwrite the stored one." equation (org-table-get-formula equation (equal arg '(4))))) (n0 (org-table-current-column)) - (modes (copy-sequence org-calc-default-modes)) + (org-tbl-calc-modes (copy-sequence org-calc-default-modes)) (numbers nil) ; was a variable, now fixed default (keep-empty nil) n form form0 formrpl formrg bw fmt x ev orig c lispp literal @@ -2455,12 +2456,13 @@ not overwrite the stored one." (setq c (string-to-char (match-string 1 fmt)) n (string-to-number (match-string 2 fmt))) (if (= c ?p) - (setq modes (org-set-calc-mode 'calc-internal-prec n)) - (setq modes (org-set-calc-mode - 'calc-float-format - (list (cdr (assoc c '((?n . float) (?f . fix) - (?s . sci) (?e . eng)))) - n)))) + (setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n)) + (setq org-tbl-calc-modes + (org-set-calc-mode + 'calc-float-format + (list (cdr (assoc c '((?n . float) (?f . fix) + (?s . sci) (?e . eng)))) + n)))) (setq fmt (replace-match "" t t fmt))) (if (string-match "T" fmt) (setq duration t numbers t @@ -2481,7 +2483,7 @@ not overwrite the stored one." (setq keep-empty t fmt (replace-match "" t t fmt))) (while (string-match "[DRFS]" fmt) - (setq modes (org-set-calc-mode (match-string 0 fmt))) + (setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt))) (setq fmt (replace-match "" t t fmt))) (unless (string-match "\\S-" fmt) (setq fmt nil)))) @@ -2590,10 +2592,15 @@ not overwrite the stored one." duration-output-format) ev)) (or (fboundp 'calc-eval) (error "Calc does not seem to be installed, and is needed to evaluate the formula")) - (setq ev (calc-eval (cons form modes) (if numbers 'num)) + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) + form + (calc-eval (cons form org-tbl-calc-modes) (if numbers 'num))) ev (if duration (org-table-time-seconds-to-string - (string-to-number ev) - duration-output-format) ev))) + (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) + (string-to-number (org-table-time-string-to-seconds ev)) + (string-to-number ev)) + duration-output-format) + ev))) (when org-table-formula-debug (with-output-to-temp-buffer "*Substitution History*" @@ -3288,8 +3295,10 @@ For example: 28 -> AB." "Convert a time string into numerical duration in seconds. S can be a string matching either -?HH:MM:SS or -?HH:MM. If S is a string representing a number, keep this number." - (let (hour minus min sec res) - (cond + (if (equal s "") + s + (let (hour minus min sec res) + (cond ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) (setq minus (< 0 (length (match-string 1 s))) hour (string-to-number (match-string 2 s)) @@ -3307,21 +3316,24 @@ If S is a string representing a number, keep this number." (setq res (- (+ (* hour 3600) (* min 60)))) (setq res (+ (* hour 3600) (* min 60))))) (t (setq res (string-to-number s)))) - (number-to-string res))) + (number-to-string res)))) (defun org-table-time-seconds-to-string (secs &optional output-format) "Convert a number of seconds to a time string. If OUTPUT-FORMAT is non-nil, return a number of days, hours, minutes or seconds." - (cond ((eq output-format 'days) - (format "%.3f" (/ (float secs) 86400))) - ((eq output-format 'hours) - (format "%.2f" (/ (float secs) 3600))) - ((eq output-format 'minutes) - (format "%.1f" (/ (float secs) 60))) - ((eq output-format 'seconds) - (format "%d" secs)) - (t (org-format-seconds "%.2h:%.2m:%.2s" secs)))) + (let* ((secs0 (abs secs)) + (res + (cond ((eq output-format 'days) + (format "%.3f" (/ (float secs0) 86400))) + ((eq output-format 'hours) + (format "%.2f" (/ (float secs0) 3600))) + ((eq output-format 'minutes) + (format "%.1f" (/ (float secs0) 60))) + ((eq output-format 'seconds) + (format "%d" secs0)) + (t (org-format-seconds "%.2h:%.2m:%.2s" secs0))))) + (if (< secs 0) (concat "-" res) res))) (defun org-table-fedit-convert-buffer (function) "Convert all references in this buffer, using FUNCTION." diff --git a/lisp/org.el b/lisp/org.el index ae3f44ce6..66f9c3e92 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -218,13 +218,15 @@ With prefix arg HERE, insert it at point." (let* ((origin default-directory) (version (if (boundp 'org-release) org-release "N/A")) (git-version (if (boundp 'org-git-version) org-git-version "N/A")) - (org-install (ignore-errors (find-library-name "org-install")))) - (setq version (format "Org-mode version %s (%s @ %s)" - version - git-version - (if org-install org-install "org-install.el can not be found!"))) - (if here (insert version)) - (message version))) + (org-install (ignore-errors (find-library-name "org-install"))) + (version_ (format "Org-mode version %s (%s @ %s)" + version + git-version + (if org-install org-install "org-install.el can not be found!")))) + (if (org-called-interactively-p 'interactive) + (if here (insert version_) + (message version_)) + version))) ;;; Compatibility constants @@ -3071,7 +3073,8 @@ and the clock summary: (org-minutes-to-hh:mm-string (- effort clocksum))))))" :group 'org-properties :version "24.1" - :type 'alist) + :type '(alist :key-type (string :tag "Property") + :value-type (function :tag "Function"))) (defcustom org-use-property-inheritance nil "Non-nil means properties apply also for sublevels. @@ -4806,10 +4809,11 @@ but the stars and the body are.") "\\|" org-clock-string "\\)\\)?" " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") org-planning-or-clock-line-re - (concat "\\(?:^[ \t]*\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string "\\|" org-clock-string - "\\)\\>\\)") + (concat "^[ \t]*\\(" + org-scheduled-string "\\|" + org-deadline-string "\\|" + org-closed-string "\\|" + org-clock-string "\\)") org-all-time-keywords (mapcar (lambda (w) (substring w 0 -1)) (list org-scheduled-string org-deadline-string @@ -4940,12 +4944,6 @@ Stars are put in group 1 and the trimmed body in group 2.") (defvar bidi-paragraph-direction) (defvar buffer-face-mode-face) -(defvar org-auto-fill-fallback-function nil) -(defvar org-indent-line-fallback-function nil) -(defvar org-fill-paragraph-fallback-function nil) -(make-variable-buffer-local 'org-auto-fill-fallback-function) -(make-variable-buffer-local 'org-indent-line-fallback-function) -(make-variable-buffer-local 'org-fill-paragraph-fallback-function) ;;;###autoload (define-derived-mode org-mode outline-mode "Org" @@ -5413,6 +5411,21 @@ will be prompted for." :group 'org-appearance :group 'org-babel) +(defcustom org-src-prevent-auto-filling nil + "When non-nil, prevent auto-filling in src blocks." + :type 'boolean + :version "24.1" + :group 'org-appearance + :group 'org-babel) + +(defcustom org-allow-promoting-top-level-subtree nil + "When non-nil, allow promoting a top level subtree. +The leading star of the top level headline will be replaced +by a #." + :type 'boolean + :version "24.1" + :group 'org-appearance) + (defun org-fontify-meta-lines-and-blocks (limit) (condition-case nil (org-fontify-meta-lines-and-blocks-1 limit) @@ -5941,16 +5954,19 @@ needs to be inserted at a specific position in the font-lock sequence.") (when org-pretty-entities (catch 'match (while (re-search-forward - "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|[^[:alpha:]\n]\\)" + "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" limit t) (if (and (not (org-in-indented-comment-line)) (setq ee (org-entity-get (match-string 1))) (= (length (nth 6 ee)) 1)) - (progn + (let* + ((end (if (equal (match-string 2) "{}") + (match-end 2) + (match-end 1)))) (add-text-properties - (match-beginning 0) (match-end 1) + (match-beginning 0) end (list 'font-lock-fontified t)) - (compose-region (match-beginning 0) (match-end 1) + (compose-region (match-beginning 0) end (nth 6 ee) nil) (backward-char 1) (throw 'match t)))) @@ -7458,6 +7474,8 @@ 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 @@ -7468,11 +7486,16 @@ in the region." after-change-functions)) (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) (diff (abs (- level (length up-head) -1)))) - (if (= level 1) (error "Cannot promote to level 0. UNDO to recover if necessary")) - (replace-match up-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff))) + (cond ((and (= level 1) org-called-with-limited-levels + org-allow-promoting-top-level-subtree) + (replace-match "# " nil t)) + ((= level 1) + (error "Cannot promote to level 0. UNDO to recover if necessary")) + (t (replace-match up-head nil t))) + ;; Fixup tag positioning + (unless (= level 1) + (and org-auto-align-tags (org-set-tags nil t)) + (if org-adapt-indentation (org-fixup-indentation (- diff)))) (run-hooks 'org-after-promote-entry-hook))) (defun org-demote () @@ -8363,23 +8386,23 @@ C-c C-c Set tags / toggle checkbox" "Unconditionally turn on `orgstruct-mode'." (orgstruct-mode 1)) +(defvar org-fb-vars nil) +(make-variable-buffer-local 'org-fb-vars) (defun orgstruct++-mode (&optional arg) "Toggle `orgstruct-mode', the enhanced version of it. -In addition to setting orgstruct-mode, this also exports all indentation -and autofilling variables from org-mode into the buffer. It will also -recognize item context in multiline items. -Note that turning off orgstruct-mode will *not* remove the -indentation/paragraph settings. This can only be done by refreshing the -major mode, for example with \\[normal-mode]." +In addition to setting orgstruct-mode, this also exports all +indentation and autofilling variables from org-mode into the +buffer. It will also recognize item context in multiline items." (interactive "P") - (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1))) - ;; Set fallback functions - org-auto-fill-fallback-function auto-fill-function - org-indent-line-fallback-function indent-line-function - org-fill-paragraph-fallback-function fill-paragraph-function) + (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) (if (< arg 1) - (orgstruct-mode -1) + (progn (orgstruct-mode -1) + (mapc (lambda(v) + (org-set-local (car v) + (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) + org-fb-vars)) (orgstruct-mode 1) + (setq org-fb-vars nil) (let (var val) (mapc (lambda (x) @@ -8387,6 +8410,7 @@ major mode, for example with \\[normal-mode]." "^\\(paragraph-\\|auto-fill\\|fill-paragraph\\|adaptive-fill\\|indent-\\)" (symbol-name (car x))) (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) org-local-vars) (org-set-local 'orgstruct-is-++ t)))) @@ -8610,7 +8634,7 @@ call CMD." ;;; Link abbreviations (defun org-link-expand-abbrev (link) - "Apply replacements as defined in `org-link-abbrev-alist." + "Apply replacements as defined in `org-link-abbrev-alist'." (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link) (let* ((key (match-string 1 link)) (as (or (assoc key org-link-abbrev-alist-local) @@ -9474,7 +9498,7 @@ If the link is in hidden text, expose it." (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) (progn (setq s (funcall org-link-translation-function - (match-string 1) (match-string 2))) + (match-string 1 s) (match-string 2 s))) (concat (car s) ":" (cdr s))) s)) @@ -10685,7 +10709,7 @@ RFLOC can be a refile location obtained in a different way. See also `org-refile-use-outline-path' and `org-completion-use-ido'. If you are using target caching (see `org-refile-use-cache'), -You have to clear the target cache in order to find new targets. +you have to clear the target cache in order to find new targets. This can be done with a 0 prefix (`C-0 C-c C-w') or a triple prefix argument (`C-u C-u C-u C-c C-w')." @@ -10968,8 +10992,7 @@ this is used for the GOTO interface." rtn)) ((eq flag 'lambda) ;; exact match? - (assoc string thetable))) - )) + (assoc string thetable))))) args))) ;;;; Dynamic blocks @@ -12884,7 +12907,9 @@ headlines matching this string." " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) + (if todo-only + "\\>\\)\\)[ \t]+\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$" + "\\>\\)\\)? *\\([^ ].*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")))) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -13465,94 +13490,104 @@ If DATA is nil or the empty string, any tags will be removed." "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." (interactive "P") - (let* ((re org-outline-regexp-bol) - (current (unless arg (org-get-tags-string))) - (col (current-column)) - (org-setting-tags t) - table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl di tc level) - (if arg - (save-excursion - (goto-char (point-min)) - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) - (while (re-search-forward re nil t) - (org-set-tags nil t) - (end-of-line 1))) - (message "All tags realigned to column %d" org-tags-column)) - (if just-align - (setq tags current) - ;; Get a new set of tags from the user - (save-excursion - (setq table (append org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags)) - (and - org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table - (org-agenda-files)))) - org-last-tags-completion-table table - current-tags (org-split-string current ":") - inherited-tags (nreverse - (nthcdr (length current-tags) - (nreverse (org-get-tags-at)))) - tags - (if (or (eq t org-use-fast-tag-selection) - (and org-use-fast-tag-selection - (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection - current-tags inherited-tags table - (if org-fast-tag-selection-include-todo - org-todo-key-alist)) - (let ((org-add-colon-after-tag-completion (< 1 (length table)))) - (org-trim - (org-icompleting-read "Tags: " - 'org-tags-completion-function - nil nil current 'org-tags-history)))))) - (while (string-match "[-+&]+" tags) - ;; No boolean logic, just a list - (setq tags (replace-match ":" t t tags)))) + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + ;; We don't use ARG and JUST-ALIGN here these args are not + ;; useful when looping over headlines + `(org-set-tags) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (let* ((re org-outline-regexp-bol) + (current (unless arg (org-get-tags-string))) + (col (current-column)) + (org-setting-tags t) + table current-tags inherited-tags ; computed below when needed + tags p0 c0 c1 rpl di tc level) + (if arg + (save-excursion + (goto-char (point-min)) + (let ((buffer-invisibility-spec (org-inhibit-invisibility))) + (while (re-search-forward re nil t) + (org-set-tags nil t) + (end-of-line 1))) + (message "All tags realigned to column %d" org-tags-column)) + (if just-align + (setq tags current) + ;; Get a new set of tags from the user + (save-excursion + (setq table (append org-tag-persistent-alist + (or org-tag-alist (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))) + org-last-tags-completion-table table + current-tags (org-split-string current ":") + inherited-tags (nreverse + (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))) + tags + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection + (delq nil (mapcar 'cdr table)))) + (org-fast-tag-selection + current-tags inherited-tags table + (if org-fast-tag-selection-include-todo + org-todo-key-alist)) + (let ((org-add-colon-after-tag-completion (< 1 (length table)))) + (org-trim + (org-icompleting-read "Tags: " + 'org-tags-completion-function + nil nil current 'org-tags-history)))))) + (while (string-match "[-+&]+" tags) + ;; No boolean logic, just a list + (setq tags (replace-match ":" t t tags)))) - (setq tags (replace-regexp-in-string "[,]" ":" tags)) + (setq tags (replace-regexp-in-string "[,]" ":" tags)) - (if org-tags-sort-function - (setq tags (mapconcat 'identity - (sort (org-split-string - tags (org-re "[^[:alnum:]_@#%]+")) - org-tags-sort-function) ":"))) + (if org-tags-sort-function + (setq tags (mapconcat 'identity + (sort (org-split-string + tags (org-re "[^[:alnum:]_@#%]+")) + org-tags-sort-function) ":"))) - (if (string-match "\\`[\t ]*\\'" tags) - (setq tags "") - (unless (string-match ":$" tags) (setq tags (concat tags ":"))) - (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) + (if (string-match "\\`[\t ]*\\'" tags) + (setq tags "") + (unless (string-match ":$" tags) (setq tags (concat tags ":"))) + (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) - ;; Insert new tags at the correct column - (beginning-of-line 1) - (setq level (or (and (looking-at org-outline-regexp) - (- (match-end 0) (point) 1)) - 1)) - (cond - ((and (equal current "") (equal tags ""))) - ((re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (point-at-eol) t) - (if (equal tags "") - (setq rpl "") - (goto-char (match-beginning 0)) - (setq c0 (current-column) - ;; compute offset for the case of org-indent-mode active - di (if org-indent-mode - (* (1- org-indent-indentation-per-level) (1- level)) - 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)))) - 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))) - tags) - (t (error "Tags alignment failed"))) - (org-move-to-column col) - (unless just-align - (run-hooks 'org-after-tags-change-hook))))) + ;; Insert new tags at the correct column + (beginning-of-line 1) + (setq level (or (and (looking-at org-outline-regexp) + (- (match-end 0) (point) 1)) + 1)) + (cond + ((and (equal current "") (equal tags ""))) + ((re-search-forward + (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") + (point-at-eol) t) + (if (equal tags "") + (setq rpl "") + (goto-char (match-beginning 0)) + (setq c0 (current-column) + ;; compute offset for the case of org-indent-mode active + di (if org-indent-mode + (* (1- org-indent-indentation-per-level) (1- level)) + 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)))) + 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))) + tags) + (t (error "Tags alignment failed"))) + (org-move-to-column col) + (unless just-align + (run-hooks 'org-after-tags-change-hook)))))) (defun org-change-tag-in-region (beg end tag off) "Add or remove TAG for each entry in the region. @@ -14713,10 +14748,10 @@ in the current file." (interactive (list nil nil)) (let* ((property (or property (org-read-property-name))) (value (or value (org-read-property-value property))) - (fn (assoc property org-properties-postprocess-alist))) + (fn (cdr (assoc property org-properties-postprocess-alist)))) (setq org-last-set-property property) ;; Possibly postprocess the inserted value: - (when fn (setq value (funcall (cadr fn) value))) + (when fn (setq value (funcall fn value))) (unless (equal (org-entry-get nil property) value) (org-entry-put nil property value)))) @@ -16367,7 +16402,7 @@ effort string \"2hours\" is equivalent to 120 minutes." :type '(alist :key-type (string :tag "Modifier") :value-type (number :tag "Minutes"))) -(defun org-duration-string-to-minutes (s) +(defun org-duration-string-to-minutes (s &optional output-to-string) "Convert a duration string S to minutes. A bare number is interpreted as minutes, modifiers can be set by @@ -16376,15 +16411,16 @@ customizing `org-effort-durations' (which see). Entries containing a colon are interpreted as H:MM by `org-hh:mm-string-to-minutes'." (let ((result 0) - (re (concat "\\([0-9]+\\) *\\(" + (re (concat "\\([0-9.]+\\) *\\(" (regexp-opt (mapcar 'car org-effort-durations)) "\\)"))) (while (string-match re s) (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) (string-to-number (match-string 1 s)))) (setq s (replace-match "" nil t s))) + (setq result (floor result)) (incf result (org-hh:mm-string-to-minutes s)) - result)) + (if output-to-string (number-to-string result) result))) ;;;; Files @@ -17034,7 +17070,7 @@ Some of the options can be changed using the variable ((eq processing-type 'imagemagick) (unless executables-checked (org-check-external-command - "converte" "you need to install imagemagick") + "convert" "you need to install imagemagick") (setq executables-checked t)) (unless (file-exists-p movefile) (org-create-formula-image-with-imagemagick @@ -17237,7 +17273,8 @@ inspection." ;; Use the requested file name and clean up (copy-file pngfile tofile 'replace) (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do - (delete-file (concat texfilebase e))) + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) pngfile)))) (defvar org-latex-to-pdf-process) ;; Defined in org-latex.el @@ -17309,7 +17346,8 @@ inspection." (save-match-data (shell-quote-argument (file-name-directory texfile))) t t cmd))) - (shell-command cmd))) + (setq cmd (split-string cmd)) + (eval (append (list 'call-process (pop cmd) nil nil nil) cmd)))) (error nil)) (cd dir)) (if (not (file-exists-p pdffile)) @@ -17341,7 +17379,8 @@ inspection." ;; Use the requested file name and clean up (copy-file pngfile tofile 'replace) (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do - (delete-file (concat texfilebase e))) + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) pngfile)))) (defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) @@ -19055,13 +19094,18 @@ argument ARG, change each line in region into an item." "Convert headings to normal text, or items or text to headings. If there is no active region, only the current line is considered. -If the first non blank line is an headline, remove the stars from -all headlines in the region. +With a \\[universal-argument] prefix, convert the whole list at +point into heading. -If it is a plain list item, turn all plain list items into headings. +In a region: -If it is a normal line, turn each and every normal line (i.e. not -an heading or an item) in the region into a heading. +- If the first non blank line is an headline, remove the stars + from all headlines in the region. + +- If it is a normal line turn each and every normal line (i.e. not an + heading or an item) in the region into a heading. + +- If it is a plain list item, turn all plain list items into headings. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, @@ -19078,8 +19122,14 @@ stars to add." (skip-chars-forward " \r\t\n") (point-at-bol))))) beg end) - ;; Determine boundaries of changes. If region ends at a bol, do - ;; not consider the last line to be in the region. + ;; Determine boundaries of changes. If a universal prefix has + ;; been given, put the list in a region. If region ends at a bol, + ;; do not consider the last line to be in the region. + + (when (and current-prefix-arg (org-at-item-p)) + (if (equal current-prefix-arg '(4)) (setq current-prefix-arg 1)) + (org-mark-list)) + (if (org-region-active-p) (setq beg (funcall skip-blanks (region-beginning)) end (copy-marker (save-excursion @@ -20401,115 +20451,116 @@ If point is in an inline task, mark that task instead." (defun org-indent-line-function () "Indent line depending on context." (interactive) - (if org-indent-line-fallback-function - (funcall org-indent-line-fallback-function) - (let* ((pos (point)) - (itemp (org-at-item-p)) - (case-fold-search t) - (org-drawer-regexp (or org-drawer-regexp "\000")) - (inline-task-p (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p))) - (inline-re (and inline-task-p - (org-inlinetask-outline-regexp))) - column) - (beginning-of-line 1) + (let* ((pos (point)) + (itemp (org-at-item-p)) + (case-fold-search t) + (org-drawer-regexp (or org-drawer-regexp "\000")) + (inline-task-p (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (inline-re (and inline-task-p + (org-inlinetask-outline-regexp))) + column) + (beginning-of-line 1) + (cond + ;; Comments + ((looking-at "# ") (setq column 0)) + ;; Headings + ((looking-at org-outline-regexp) (setq column 0)) + ;; Included files + ((looking-at "#\\+include:") (setq column 0)) + ;; Footnote definition + ((looking-at org-footnote-definition-re) (setq column 0)) + ;; Literal examples + ((looking-at "[ \t]*:\\( \\|$\\)") + (setq column (org-get-indentation))) ; do nothing + ;; Lists + ((ignore-errors (goto-char (org-in-item-p))) + (setq column (if itemp + (org-get-indentation) + (org-list-item-body-column (point)))) + (goto-char pos)) + ;; Drawers + ((and (looking-at "[ \t]*:END:") + (save-excursion (re-search-backward org-drawer-regexp nil t))) + (save-excursion + (goto-char (1- (match-beginning 1))) + (setq column (current-column)))) + ;; Special blocks + ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") + (save-excursion + (re-search-backward + (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) + (setq column (org-get-indentation (match-string 0)))) + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (cond ((equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation)) + ((equal (downcase (match-string 1)) "example") + (max (org-get-indentation) + (org-get-indentation (match-string 0)))) + (t + (org-get-indentation (match-string 0)))))) + ;; This line has nothing special, look at the previous relevant + ;; line to compute indentation + (t + (beginning-of-line 0) + (while (and (not (bobp)) + (not (looking-at org-drawer-regexp)) + ;; When point started in an inline task, do not move + ;; above task starting line. + (not (and inline-task-p (looking-at inline-re))) + ;; Skip drawers, blocks, empty lines, verbatim, + ;; comments, tables, footnotes definitions, lists, + ;; inline tasks. + (or (and (looking-at "[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t)) + (and (looking-at "[ \t]*#\\+end_") + (re-search-backward "[ \t]*#\\+begin_"nil t)) + (looking-at "[ \t]*[\n:#|]") + (looking-at org-footnote-definition-re) + (and (ignore-errors (goto-char (org-in-item-p))) + (goto-char + (org-list-get-top-point (org-list-struct)))) + (and (not inline-task-p) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (or (org-inlinetask-goto-beginning) t)))) + (beginning-of-line 0)) (cond - ;; Comments - ((looking-at "# ") (setq column 0)) - ;; Headings - ((looking-at org-outline-regexp) (setq column 0)) - ;; Included files - ((looking-at "#\\+include:") (setq column 0)) - ;; Footnote definition - ((looking-at org-footnote-definition-re) (setq column 0)) - ;; Literal examples - ((looking-at "[ \t]*:\\( \\|$\\)") - (setq column (org-get-indentation))) ; do nothing - ;; Lists - ((ignore-errors (goto-char (org-in-item-p))) - (setq column (if itemp - (org-get-indentation) - (org-list-item-body-column (point)))) - (goto-char pos)) - ;; Drawers - ((and (looking-at "[ \t]*:END:") - (save-excursion (re-search-backward org-drawer-regexp nil t))) - (save-excursion - (goto-char (1- (match-beginning 1))) + ;; There was an heading above. + ((looking-at "\\*+[ \t]+") + (if (not org-adapt-indentation) + (setq column 0) + (goto-char (match-end 0)) (setq column (current-column)))) - ;; Special blocks - ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") - (save-excursion - (re-search-backward - (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) - (setq column (org-get-indentation (match-string 0)))) - ((and (not (looking-at "[ \t]*#\\+begin_")) - (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) - (save-excursion - (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) - (setq column - (cond ((equal (downcase (match-string 1)) "src") - ;; src blocks: let `org-edit-src-exit' handle them - (org-get-indentation)) - ((equal (downcase (match-string 1)) "example") - (max (org-get-indentation) - (org-get-indentation (match-string 0)))) - (t - (org-get-indentation (match-string 0)))))) - ;; This line has nothing special, look at the previous relevant - ;; line to compute indentation - (t - (beginning-of-line 0) - (while (and (not (bobp)) - (not (looking-at org-drawer-regexp)) - ;; When point started in an inline task, do not move - ;; above task starting line. - (not (and inline-task-p (looking-at inline-re))) - ;; Skip drawers, blocks, empty lines, verbatim, - ;; comments, tables, footnotes definitions, lists, - ;; inline tasks. - (or (and (looking-at "[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t)) - (and (looking-at "[ \t]*#\\+end_") - (re-search-backward "[ \t]*#\\+begin_"nil t)) - (looking-at "[ \t]*[\n:#|]") - (looking-at org-footnote-definition-re) - (and (ignore-errors (goto-char (org-in-item-p))) - (goto-char - (org-list-get-top-point (org-list-struct)))) - (and (not inline-task-p) - (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (or (org-inlinetask-goto-beginning) t)))) - (beginning-of-line 0)) - (cond - ;; There was an heading above. - ((looking-at "\\*+[ \t]+") - (if (not org-adapt-indentation) - (setq column 0) - (goto-char (match-end 0)) - (setq column (current-column)))) - ;; A drawer had started and is unfinished - ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ;; Else, nothing noticeable found: get indentation and go on. - (t (setq column (org-get-indentation)))))) - ;; Now apply indentation and move cursor accordingly - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (org-indent-line-to column) - (save-excursion (org-indent-line-to column))) - ;; Special polishing for properties, see `org-property-format' - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at - "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") - (replace-match (concat (match-string 1) - (format org-property-format - (match-string 2) (match-string 3))) - t t)) - (org-move-to-column column)))) + ;; A drawer had started and is unfinished + ((looking-at org-drawer-regexp) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; Else, nothing noticeable found: get indentation and go on. + (t (setq column (org-get-indentation)))))) + ;; Now apply indentation and move cursor accordingly + (goto-char pos) + (if (<= (current-column) (current-indentation)) + (org-indent-line-to column) + (save-excursion (org-indent-line-to column))) + ;; Special polishing for properties, see `org-property-format' + (setq column (current-column)) + (beginning-of-line 1) + (if (looking-at + "\\([ \t]+\\)\\(:[-_0-9a-zA-Z]+:\\)[ \t]*\\(\\S-.*\\(\\S-\\|$\\)\\)") + (replace-match (concat (match-string 1) + (format org-property-format + (match-string 2) (match-string 3))) + t t)) + (org-move-to-column column) + (when (and orgstruct-is-++ (eq pos (point))) + (org-let org-fb-vars + '(indent-according-to-mode))))) (defun org-indent-drawer () "Indent the drawer at point." @@ -20552,6 +20603,8 @@ If point is in an inline task, mark that task instead." (when folded (org-cycle))) (message "Block at point indented")) +;; For reference, this is the default value of adaptive-fill-regexp +;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" (defvar org-adaptive-fill-regexp-backup adaptive-fill-regexp "Variable to store copy of `adaptive-fill-regexp'. Since `adaptive-fill-regexp' is set to never match, we need to @@ -20704,15 +20757,13 @@ the functionality can be provided as a fall-back.") (narrow-to-region (1+ (match-end 0)) (save-excursion (forward-paragraph 1) (point))) (fill-paragraph justify) t)) - ;; Else falls back on `org-fill-paragraph-fallback-function' - (org-fill-paragraph-fallback-function - (funcall org-fill-paragraph-fallback-function justify)) - ;; Else simply call `fill-paragraph'. + ;; Else fall back on fill-paragraph-function as possibly + ;; defined in `org-fb-vars' + (orgstruct-is-++ + (org-let org-fb-vars + '(fill-paragraph justify))) (t nil)))) -;; For reference, this is the default value of adaptive-fill-regexp -;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" - (defun org-adaptive-fill-function () "Return a fill prefix for org-mode files." (let (itemp) @@ -20742,19 +20793,19 @@ the functionality can be provided as a fall-back.") (defun org-auto-fill-function () "Auto-fill function." - (let (itemp prefix) - ;; When in a list, compute an appropriate fill-prefix and make - ;; sure it will be used by `do-auto-fill'. - (cond ((setq itemp (org-in-item-p)) - (progn - (setq prefix (make-string (org-list-item-body-column itemp) ?\ )) - (flet ((fill-context-prefix (from to &optional flr) prefix)) - (do-auto-fill)))) - (org-auto-fill-fallback-function - (let ((fill-prefix "")) - (funcall org-auto-fill-fallback-function))) - ;; Else just use `do-auto-fill'. - (t (do-auto-fill))))) + (unless (and org-src-prevent-auto-filling (org-in-src-block-p)) + (let (itemp prefix) + ;; When in a list, compute an appropriate fill-prefix and make + ;; sure it will be used by `do-auto-fill'. + (cond ((setq itemp (org-in-item-p)) + (progn + (setq prefix (make-string (org-list-item-body-column itemp) ?\ )) + (flet ((fill-context-prefix (from to &optional flr) prefix)) + (do-auto-fill)))) + (orgstruct-is-++ + (org-let org-fb-vars + '(do-auto-fill))) + (t (do-auto-fill)))))) ;;; Other stuff. diff --git a/testing/lisp/test-org-element.el b/testing/lisp/test-org-element.el index 59a5023ab..497de892f 100644 --- a/testing/lisp/test-org-element.el +++ b/testing/lisp/test-org-element.el @@ -17,10 +17,6 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . -;;; Commentary: - -;;; Code: - (unless (featurep 'org-element) (signal 'missing-test-dependency "org-element")) @@ -34,81 +30,311 @@ Return interpreted string." -;;; Tests: +;;; Test `org-element-map' - -;;;; Headlines - -(ert-deftest test-org-element/headline-quote-keyword () - "Test QUOTE keyword recognition." - ;; Reference test. - (org-test-with-temp-text "* Headline" - (let ((org-quote-string "QUOTE")) - (should-not (org-element-property :quotedp (org-element-at-point))))) - ;; Standard position. - (org-test-with-temp-text "* QUOTE Headline" - (let ((org-quote-string "QUOTE")) - (let ((headline (org-element-at-point))) - (should (org-element-property :quotedp headline)) - ;; Test removal from raw value. - (should (equal (org-element-property :raw-value headline) "Headline")))) - ;; Case sensitivity. - (let ((org-quote-string "Quote")) - (should-not (org-element-property :quotedp (org-element-at-point))))) - ;; With another keyword. - (org-test-with-temp-text "* TODO QUOTE Headline" - (let ((org-quote-string "QUOTE") - (org-todo-keywords '((sequence "TODO" "DONE")))) - (should (org-element-property :quotedp (org-element-at-point)))))) - -(ert-deftest test-org-element/headline-comment-keyword () - "Test COMMENT keyword recognition." - ;; Reference test. - (org-test-with-temp-text "* Headline" - (let ((org-comment-string "COMMENT")) - (should-not (org-element-property :commentedp (org-element-at-point))))) - ;; Standard position. - (org-test-with-temp-text "* COMMENT Headline" - (let ((org-comment-string "COMMENT")) - (let ((headline (org-element-at-point))) - (should (org-element-property :commentedp headline)) - ;; Test removal from raw value. - (should (equal (org-element-property :raw-value headline) "Headline")))) - ;; Case sensitivity. - (let ((org-comment-string "Comment")) - (should-not (org-element-property :commentedp (org-element-at-point))))) - ;; With another keyword. - (org-test-with-temp-text "* TODO COMMENT Headline" - (let ((org-comment-string "COMMENT") - (org-todo-keywords '((sequence "TODO" "DONE")))) - (should (org-element-property :commentedp (org-element-at-point)))))) - -(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))))) - ;; 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))))) - ;; 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:")))))) +(ert-deftest test-org-element/map () + "Test `org-element-map'." + ;; Can map to `plain-text' objects. + (should + (= 2 + (org-test-with-temp-text "Some text \alpha +#+BEGIN_CENTER +Some other text +#+END_CENTER" + (let ((count 0)) + (org-element-map + (org-element-parse-buffer) 'plain-text + (lambda (s) (when (string-match "text" s) (incf count)))) + count)))) + ;; Applies to secondary strings + (should + (org-element-map '("some " (bold nil "bold") "text") 'bold 'identity)) + ;; Enter secondary strings before entering contents. + (should + (equal + "alpha" + (org-element-property + :name + (org-test-with-temp-text "* Some \\alpha headline\n\\beta entity." + (org-element-map (org-element-parse-buffer) 'entity 'identity nil t))))) + ;; Apply NO-RECURSION argument. + (should-not + (org-test-with-temp-text "#+BEGIN_CENTER\n\\alpha\n#+END_CENTER" + (org-element-map + (org-element-parse-buffer) 'entity 'identity nil nil 'center-block)))) -;;;; Example-blocks and Src-blocks +;;; Test Parsers + +;;;; Babel Call + +(ert-deftest test-org-element/babel-call-parser () + "Test `babel-call' parsing." + ;; Standard test. + (should + (org-test-with-temp-text "#+CALL: test()" + (org-element-map (org-element-parse-buffer) 'babel-call 'identity))) + ;; Ignore case. + (should + (org-test-with-temp-text "#+call: test()" + (org-element-map (org-element-parse-buffer) 'babel-call 'identity)))) + + +;;;; Bold + +(ert-deftest test-org-element/bold-parser () + "Test `bold' parser." + ;; Standard test. + (should + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "*bold*" + (org-element-map (org-element-parse-buffer) 'bold 'identity nil t)))) + ;; Multi-line markup. + (should + (equal + (org-element-contents + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "*first line\nsecond line*" + (org-element-map (org-element-parse-buffer) 'bold 'identity nil t)))) + '("first line\nsecond line")))) + + +;;;; Center Block + +(ert-deftest test-org-element/center-block-parser () + "Test `center-block' parser." + ;; Standard test. + (should + (org-test-with-temp-text "#+BEGIN_CENTER\nText\n#+END_CENTER" + (org-element-map (org-element-parse-buffer) 'center-block 'identity))) + ;; Ignore case. + (should + (org-test-with-temp-text "#+begin_center\nText\n#+end_center" + (org-element-map (org-element-parse-buffer) 'center-block 'identity))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_CENTER\nText\n#+END_CENTER" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'center-block 'identity nil t)))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_CENTER" + (org-element-map + (org-element-parse-buffer) 'center-block 'identity nil t)))) + + +;;;; Clock + +(ert-deftest test-org-element/clock-parser () + "Test `clock' parser." + ;; Running clock. + (should + (equal + (let ((org-clock-string "CLOCK:")) + (org-test-with-temp-text "CLOCK: [2012-01-01 sun. 00:01]" + (org-element-map + (org-element-parse-buffer) 'clock 'identity nil t))) + '(clock + (:status running :value "[2012-01-01 sun. 00:01]" :time nil :begin 1 + :end 31 :post-blank 0)))) + ;; Closed clock. + (should + (equal + (let ((org-clock-string "CLOCK:")) + (org-test-with-temp-text " +CLOCK: [2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02] => 0:01" + (org-element-map + (org-element-parse-buffer) 'clock 'identity nil t))) + '(clock + (:status closed + :value "[2012-01-01 sun. 00:01]--[2012-01-01 sun. 00:02]" + :time "0:01" :begin 2 :end 66 :post-blank 0))))) + + +;;;; Code + +(ert-deftest test-org-element/code-parser () + "Test `code' parser." + ;; Regular test. + (should + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "~code~" + (org-element-map (org-element-parse-buffer) 'code 'identity)))) + ;; Multi-line markup. + (should + (equal + (org-element-property + :value + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "~first line\nsecond line~" + (org-element-map + (org-element-parse-buffer) 'code 'identity nil t)))) + "first line\nsecond line"))) + + +;;;; Comment + +(ert-deftest test-org-element/comment-parser () + "Test `comment' parser." + ;; Regular comment. + (should + (org-test-with-temp-text "# Comment" + (org-element-map (org-element-parse-buffer) 'comment 'identity))) + ;; Inline comment. + (should + (org-test-with-temp-text "#+ Comment" + (org-element-map (org-element-parse-buffer) 'comment 'identity))) + ;; Preserve indentation. + (should + (equal + (org-element-property + :value + (org-test-with-temp-text "#+ No blank\n#+ One blank" + (org-element-map (org-element-parse-buffer) 'comment 'identity nil t))) + "No blank\n One blank\n")) + ;; Comment with blank lines. + (should + (equal + (org-element-property + :value + (org-test-with-temp-text "#+ First part\n#+ \n#+\n#+ Second part" + (org-element-map (org-element-parse-buffer) 'comment 'identity nil t))) + "First part\n\n\nSecond part\n"))) + + +;;;; Comment Block + +(ert-deftest test-org-element/comment-block-parser () + "Test `comment-block' parser." + ;; Standard test. + (should + (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT" + (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))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_COMMENT\nText\n#+END_COMMENT" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'comment-block 'identity nil t)))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_COMMENT" + (org-element-map + (org-element-parse-buffer) 'comment-block 'identity nil t)))) + + +;;;; Drawer + +(ert-deftest test-org-element/drawer-parser () + "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)))) + ;; 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)))) + ;; 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))))) + + +;;;; Dynamic Block + +(ert-deftest test-org-element/dynamic-block-parser () + "Test `dynamic-block' parser." + ;; Standard test. + (should + (org-test-with-temp-text + "#+BEGIN: myblock :param1 val1 :param2 val2\nText\n#+END:" + (org-element-map (org-element-parse-buffer) 'dynamic-block 'identity))) + ;; Folded view + (org-test-with-temp-text + "#+BEGIN: myblock :param1 val1 :param2 val2\nText\n#+END:" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'dynamic-block 'identity nil t)))) + ;; Ignore case. + (should + (org-test-with-temp-text + "#+begin: myblock :param1 val1 :param2 val2\nText\n#+end:" + (org-element-map (org-element-parse-buffer) 'dynamic-block 'identity))) + ;; 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)))) + + +;;;; Entity + +(ert-deftest test-org-element/entity-parser () + "Test `entity' parser." + ;; Without brackets. + (should + (org-test-with-temp-text "\\sin" + (org-element-map (org-element-parse-buffer) 'entity 'identity))) + ;; With brackets. + (should + (org-element-property + :use-brackets-p + (org-test-with-temp-text "\\alpha{}text" + (org-element-map (org-element-parse-buffer) 'entity 'identity nil t)))) + ;; User-defined entity. + (should + (equal + (org-element-property + :name + (let ((org-entities-user + '(("test" "test" nil "test" "test" "test" "test")))) + (org-test-with-temp-text "\\test" + (org-element-map (org-element-parse-buffer) 'entity 'identity nil t)))) + "test"))) + + +;;;; Example Block + +(ert-deftest test-org-element/example-block-parser () + "Test `example-block' parser." + ;; Standard test. + (should + (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText\n#+END_EXAMPLE" + (org-element-map (org-element-parse-buffer) 'example-block 'identity))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_EXAMPLE\nText\n#+END_EXAMPLE" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'example-block 'identity nil t)))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_EXAMPLE" + (org-element-map + (org-element-parse-buffer) 'example-block 'identity nil t)))) (ert-deftest test-org-element/block-switches () "Test `example-block' and `src-block' switches parsing." @@ -210,180 +436,955 @@ Return interpreted string." (equal (org-element-property :label-fmt element) "[ref:%s]")))))) - -;;;; Footnotes references and definitions +;;;; Export Block -(ert-deftest test-org-element/footnote-reference () - "Test footnote-reference parsing." +(ert-deftest test-org-element/export-block-parser () + "Test `export-block' parser." + ;; Standard test. + (should + (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX" + (org-element-map (org-element-parse-buffer) 'export-block 'identity))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_LATEX\nText\n#+END_LATEX" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'export-block 'identity nil t)))) + ;; Ignore case. + (should + (org-test-with-temp-text "#+begin_latex\nText\n#+end_latex" + (org-element-map (org-element-parse-buffer) 'export-block 'identity))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_LATEX" + (org-element-map + (org-element-parse-buffer) 'export-block 'identity nil t)))) + + +;;;; Export Snippet + +(ert-deftest test-org-element/export-snippet-parser () + "Test `export-snippet' parser." + (should + (equal + '("back-end" . "contents") + (org-test-with-temp-text "" + (org-element-map + (org-element-parse-buffer) 'export-snippet + (lambda (snippet) (cons (org-element-property :back-end snippet) + (org-element-property :value snippet))) + nil t))))) + + +;;;; Fixed Width + +(ert-deftest test-org-element/fixed-width () + "Test fixed-width area parsing." + ;; Preserve indentation. + (should + (org-test-with-temp-text ": no blank\n: one blank" + (org-element-map (org-element-parse-buffer) 'fixed-width 'identity))) + ;; Fixed-width with empty lines. + (should + (org-test-with-temp-text ": first part\n:\n: \n: second part" + (org-element-map (org-element-parse-buffer) 'fixed-width 'identity))) + ;; Parse indented fixed-width markers. + (should + (org-test-with-temp-text "Text\n : no blank\n : one blank" + (org-element-map (org-element-parse-buffer) 'fixed-width 'identity))) + ;; Distinguish fixed-width areas within a list and outside of it. + (should + (= 2 + (length + (org-test-with-temp-text " +- Item + : fixed-width inside +: fixed-width outside" + (org-element-map + (org-element-parse-buffer) 'fixed-width 'identity)))))) + + +;;;; Footnote Definition + +(ert-deftest test-org-element/footnote-definition-parser () + "Test `footnote-definition' parser." + (should + (org-test-with-temp-text "[fn:1] Definition" + (org-element-map + (org-element-parse-buffer) 'footnote-definition 'identity nil t))) + ;; Footnote with more contents + (should + (= 28 + (org-element-property + :end + (org-test-with-temp-text "[fn:1] Definition\n| a | b |" + (org-element-map + (org-element-parse-buffer) + 'footnote-definition 'identity nil t)))))) + + +;;;; Footnotes Reference. + +(ert-deftest test-org-element/footnote-reference-parser () + "Test `footnote-reference' parser." ;; 1. Parse a standard reference. - (org-test-with-temp-text "[fn:label]" - (should (equal (org-element-footnote-reference-parser) - '(footnote-reference - (:label "fn:label" :type standard :inline-definition nil - :begin 1 :end 11 :post-blank 0))))) + (org-test-with-temp-text "Text[fn:label]" + (should + (org-element-map + (org-element-parse-buffer) 'footnote-reference 'identity))) ;; 2. Parse a normalized reference. - (org-test-with-temp-text "[1]" - (should (equal (org-element-footnote-reference-parser) - '(footnote-reference - (:label "1" :type standard :inline-definition nil - :begin 1 :end 4 :post-blank 0))))) + (org-test-with-temp-text "Text[1]" + (should + (org-element-map + (org-element-parse-buffer) 'footnote-reference 'identity))) ;; 3. Parse an inline reference. - (org-test-with-temp-text "[fn:test:def]" - (should (equal (org-element-footnote-reference-parser) - '(footnote-reference - (:label "fn:test" :type inline :inline-definition ("def") - :begin 1 :end 14 :post-blank 0))))) + (org-test-with-temp-text "Text[fn:test:def]" + (should + (org-element-map + (org-element-parse-buffer) 'footnote-reference 'identity))) ;; 4. Parse an anonymous reference. - (org-test-with-temp-text "[fn::def]" - (should (equal (org-element-footnote-reference-parser) - '(footnote-reference - (:label nil :type inline :inline-definition ("def") - :begin 1 :end 10 :post-blank 0))))) + (org-test-with-temp-text "Text[fn::def]" + (should + (org-element-map + (org-element-parse-buffer) 'footnote-reference 'identity))) ;; 5. Parse nested footnotes. - (org-test-with-temp-text "[fn::def [fn:label]]" + (org-test-with-temp-text "Text[fn::def [fn:label]]" (should - (equal - (org-element-footnote-reference-parser) - '(footnote-reference - (:label nil :type inline - :inline-definition - ("def " - (footnote-reference - (:label "fn:label" :type standard :inline-definition nil - :begin 5 :end 15 :post-blank 0))) - :begin 1 :end 21 :post-blank 0))))) + (= 2 + (length + (org-element-map + (org-element-parse-buffer) 'footnote-reference 'identity))))) ;; 6. Parse adjacent footnotes. - (org-test-with-temp-text "[fn:label1][fn:label2]" + (org-test-with-temp-text "Text[fn:label1][fn:label2]" (should - (equal - (org-element-footnote-reference-parser) - '(footnote-reference - (:label "fn:label1" :type standard :inline-definition nil :begin 1 - :end 12 :post-blank 0))))) + (= 2 + (length + (org-element-map + (org-element-parse-buffer) 'footnote-reference 'identity))))) ;; 7. Only properly closed footnotes are recognized as such. - (org-test-with-temp-text "Text [fn:label" + (org-test-with-temp-text "Text[fn:label" (should-not (org-element-map (org-element-parse-buffer) 'footnote-reference 'identity)))) - -;;;; Verse blocks +;;;; Headline -(ert-deftest test-org-element/verse-block () - "Test verse block parsing." +(ert-deftest test-org-element/headline-quote-keyword () + "Test QUOTE keyword recognition." + ;; Reference test. + (org-test-with-temp-text "* Headline" + (let ((org-quote-string "QUOTE")) + (should-not (org-element-property :quotedp (org-element-at-point))))) + ;; Standard position. + (org-test-with-temp-text "* QUOTE Headline" + (let ((org-quote-string "QUOTE")) + (let ((headline (org-element-at-point))) + (should (org-element-property :quotedp headline)) + ;; Test removal from raw value. + (should (equal (org-element-property :raw-value headline) "Headline")))) + ;; Case sensitivity. + (let ((org-quote-string "Quote")) + (should-not (org-element-property :quotedp (org-element-at-point))))) + ;; With another keyword. + (org-test-with-temp-text "* TODO QUOTE Headline" + (let ((org-quote-string "QUOTE") + (org-todo-keywords '((sequence "TODO" "DONE")))) + (should (org-element-property :quotedp (org-element-at-point)))))) + +(ert-deftest test-org-element/headline-comment-keyword () + "Test COMMENT keyword recognition." + ;; Reference test. + (org-test-with-temp-text "* Headline" + (let ((org-comment-string "COMMENT")) + (should-not (org-element-property :commentedp (org-element-at-point))))) + ;; Standard position. + (org-test-with-temp-text "* COMMENT Headline" + (let ((org-comment-string "COMMENT")) + (let ((headline (org-element-at-point))) + (should (org-element-property :commentedp headline)) + ;; Test removal from raw value. + (should (equal (org-element-property :raw-value headline) "Headline")))) + ;; Case sensitivity. + (let ((org-comment-string "Comment")) + (should-not (org-element-property :commentedp (org-element-at-point))))) + ;; With another keyword. + (org-test-with-temp-text "* TODO COMMENT Headline" + (let ((org-comment-string "COMMENT") + (org-todo-keywords '((sequence "TODO" "DONE")))) + (should (org-element-property :commentedp (org-element-at-point)))))) + +(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))))) + ;; 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))))) + ;; 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"))))))) + + +;;;; Horizontal Rule + +(ert-deftest test-org-element/horizontal-rule-parser () + "Test `horizontal-rule' parser." + ;; Standard. + (should + (org-test-with-temp-text "-----" + (org-element-map (org-element-parse-buffer) 'horizontal-rule 'identity))) + ;; Indented. + (should + (org-test-with-temp-text " -----" + (org-element-map (org-element-parse-buffer) 'horizontal-rule 'identity))) + ;; Hyphen must be alone on the line. + (should-not + (org-test-with-temp-text "-----wrong" + (org-element-map (org-element-parse-buffer) 'horizontal-rule 'identity))) + ;; 4 hyphens is too small. + (should-not + (org-test-with-temp-text "----" + (org-element-map (org-element-parse-buffer) 'horizontal-rule 'identity)))) + + +;;;; Inline Babel Call + +(ert-deftest test-org-element/inline-babel-call-parser () + "Test `inline-babel-call' parser." + (should + (org-test-with-temp-text "call_test()" + (org-element-map + (org-element-parse-buffer) 'inline-babel-call 'identity)))) + + +;;;; Inline Src Block + +(ert-deftest test-org-element/inline-src-block-parser () + "Test `inline-src-block' parser." + (should + (org-test-with-temp-text "src_emacs-lisp{(+ 1 1)}" + (org-element-map (org-element-parse-buffer) 'inline-src-block 'identity)))) + + +;;;; Inlinetask + +(ert-deftest test-org-element/inlinetask-parser () + "Test `inlinetask' parser." + (when (featurep 'org-inlinetask) + (let ((org-inlinetask-min-level 15)) + ;; 1. Regular inlinetask. + (should + (org-test-with-temp-text + "*************** Task\nTest\n*************** END" + (org-element-map (org-element-parse-buffer) 'inlinetask 'identity))) + ;; 2. Degenerate inlinetask. + (should + (org-test-with-temp-text "*************** Task" + (org-element-map (org-element-parse-buffer) 'inlinetask 'identity))) + ;; TODO keyword. + (should + (equal + "TODO" + (let ((org-todo-keywords '((sequence "TODO" "DONE")))) + (org-test-with-temp-text "*************** TODO Task" + (org-element-property + :todo-keyword + (org-element-map + (org-element-parse-buffer) 'inlinetask 'identity nil t)))))) + ;; Planning info. + (should + (equal + "2012-03-29 thu." + (org-test-with-temp-text " +*************** Task +DEADLINE: <2012-03-29 thu.>" + (org-element-property + :deadline + (org-element-map + (org-element-parse-buffer) 'inlinetask 'identity nil t))))) + ;; Priority. + (should + (equal + ?A + (org-test-with-temp-text " +*************** [#A] Task" + (org-element-property + :priority + (org-element-map + (org-element-parse-buffer) 'inlinetask 'identity nil t))))) + ;; Tags. + (should + (equal + '("test") + (org-test-with-temp-text " +*************** Task :test:" + (org-element-property + :tags + (org-element-map + (org-element-parse-buffer) 'inlinetask 'identity nil t)))))))) + + +;;;; Italic + +(ert-deftest test-org-element/italic-parser () + "Test `italic' parser." + ;; Regular test. + (should + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "/italic/" + (org-element-map (org-element-parse-buffer) 'italic 'identity nil t)))) + ;; Multi-line markup. + (should + (equal + (org-element-contents + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "/first line\nsecond line/" + (org-element-map (org-element-parse-buffer) 'italic 'identity nil t)))) + '("first line\nsecond line")))) + + +;;;; Item + +(ert-deftest test-org-element/item-parser () + "Test `item' parser." + ;; Standard test. + (should + (org-test-with-temp-text "- item" + (org-element-map (org-element-parse-buffer) 'item 'identity))) + ;; Counter. + (should + (= 6 + (org-element-property + :counter + (org-test-with-temp-text "6. [@6] item" + (org-element-map (org-element-parse-buffer) 'item 'identity nil t))))) + ;; Tag + (should + (equal + '("tag") + (org-element-property + :tag + (org-test-with-temp-text "- tag :: description" + (org-element-map (org-element-parse-buffer) 'item 'identity nil t))))) + ;; Check-boxes + (should + (equal + '(trans on off) + (org-test-with-temp-text " +- [-] item 1 + - [X] item 1.1 + - [ ] item 1.2" + (org-element-map + (org-element-parse-buffer) 'item + (lambda (item) (org-element-property :checkbox item)))))) + ;; Folded state. + (org-test-with-temp-text "* Headline +- item + + paragraph below" + (forward-line) + (let ((org-cycle-include-plain-lists t)) (org-cycle)) + (should + (org-element-property + :hiddenp + (org-element-map (org-element-parse-buffer) 'item 'identity nil t))))) + + +;;;; Keyword + +(ert-deftest test-org-element/keyword-parser () + "Test `keyword' parser." + ;; Standard test. + (should + (org-test-with-temp-text "#+KEYWORD: value" + (org-element-map (org-element-parse-buffer) 'keyword 'identity))) + ;; Keywords are case-insensitive. + (should + (equal + (org-test-with-temp-text "#+KEYWORD: value" + (org-element-map (org-element-parse-buffer) 'keyword 'identity)) + (org-test-with-temp-text "#+keyword: value" + (org-element-map (org-element-parse-buffer) 'keyword 'identity)))) + ;; Affiliated keywords are not keywords. + (should-not + (org-test-with-temp-text "#+NAME: value +Paragraph" + (org-element-map (org-element-parse-buffer) 'keyword 'identity))) + ;; Do not mix keywords with Babel calls and dynamic blocks. + (should-not + (org-test-with-temp-text "#+CALL: fun()" + (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)))) + + +;;;; Latex Environment + +(ert-deftest test-org-element/latex-environment-parser () + "Test `latex-environment' parser." + (should + (org-test-with-temp-text "\\begin{equation}\ne^{i\\pi}+1=0\n\\end{equation}" + (org-element-map + (org-element-parse-buffer) 'latex-environment 'identity)))) + + +;;;; Latex Fragment + +(ert-deftest test-org-element/latex-fragment-parser () + "Test `latex-fragment' parser." + (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 + (org-test-with-temp-text "$a$" + (org-element-map (org-element-parse-buffer) 'latex-fragment 'identity))) + (should + (org-test-with-temp-text "$$a$$" + (org-element-map (org-element-parse-buffer) 'latex-fragment 'identity))) + (should + (org-test-with-temp-text "\\(a\\)" + (org-element-map (org-element-parse-buffer) 'latex-fragment 'identity))) + (should + (org-test-with-temp-text "\\[a\\]" + (org-element-map + (org-element-parse-buffer) 'latex-fragment 'identity))))) + + +;;;; Line Break + +(ert-deftest test-org-element/line-break-parser () + "Test `line-break' parser." + ;; Regular test. + (should + (org-test-with-temp-text "Text \\\\" + (org-element-map (org-element-parse-buffer) 'line-break 'identity))) + ;; Line break with trailing white spaces. + (should + (org-test-with-temp-text "Text \\\\ " + (org-element-map (org-element-parse-buffer) 'line-break 'identity))) + ;; Three backslashes are too much. + (should-not + (org-test-with-temp-text "Text \\\\\\" + (org-element-map (org-element-parse-buffer) 'line-break 'identity)))) + + +;;;; Link + +(ert-deftest test-org-element/link-parser () + "Test `link' parser." + ;; 1. Radio target. + (should + (equal + "radio" + (org-test-with-temp-text "A radio link" + (org-element-property + :type + (org-element-map + (let ((org-target-link-regexp "radio")) (org-element-parse-buffer)) + 'link 'identity nil t))))) + ;; 2. Standard link. + ;; + ;; 2.1. With description. + (should + (equal + '("Orgmode.org") + (org-test-with-temp-text "[[http://orgmode.org][Orgmode.org]]" + (org-element-contents + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) + ;; 2.2. Without description. + (should + (equal + "http" + (org-test-with-temp-text "[[http://orgmode.org]]" + (org-element-property + :type + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) + ;; 2.3. With expansion. + (should + (equal + "//orgmode.org/worg" + (org-test-with-temp-text "[[Org:worg]]" + (let ((org-link-abbrev-alist '(("Org" . "http://orgmode.org/")))) + (org-element-property + :path + (org-element-map (org-element-parse-buffer) 'link 'identity nil t)))))) + ;; 2.4. With translation. + (should + (equal + "127.0.0.1" + (org-test-with-temp-text "[[http://orgmode.org]]" + (flet ((link-translate (type path) (cons type "127.0.0.1"))) + (let ((org-link-translation-function 'link-translate)) + (org-element-property + :path + (org-element-map + (org-element-parse-buffer) 'link 'identity nil t))))))) + ;; 2.5. Id link. + (should + (equal + "id" + (org-test-with-temp-text "[[id:aaaa]]" + (org-element-property + :type + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) + ;; 2.6. Custom-id link. + (should + (equal + "custom-id" + (org-test-with-temp-text "[[#some-id]]" + (org-element-property + :type + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) + ;; 2.7 Coderef link. + (should + (equal + "coderef" + (org-test-with-temp-text "[[(reference)]]" + (org-element-property + :type + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) + ;; 2.8 Fuzzy link. + (should + (equal + "fuzzy" + (org-test-with-temp-text "[[target-or-title]]" + (org-element-property + :type + (org-element-map (org-element-parse-buffer) 'link 'identity nil t))))) + ;; 3. Plain link. + (should + (org-test-with-temp-text "A link: http://orgmode.org" + (org-element-map (org-element-parse-buffer) 'link 'identity))) + ;; 4. Angular link. + (should + (org-test-with-temp-text "A link: " + (org-element-map (org-element-parse-buffer) 'link 'identity nil t)))) + + +;;;; Macro + +(ert-deftest test-org-element/macro-parser () + "Test `macro' parser." + ;; Without arguments. + (should + (org-test-with-temp-text "{{{macro}}}" + (org-element-map (org-element-parse-buffer) 'macro 'identity))) + ;; With arguments. + (should + (org-test-with-temp-text "{{{macro(arg1,arg2)}}}" + (org-element-map (org-element-parse-buffer) 'macro 'identity)))) + + +;;;; Plain List + +(ert-deftest test-org-element/plain-list-parser () + "Test `plain-list' parser." + (should + (org-test-with-temp-text "- item" + (org-element-map (org-element-parse-buffer) 'plain-list 'identity))) + ;; Blank lines after the list only belong to outer plain list. + (org-test-with-temp-text " +- outer + - inner + +Outside list" + (let ((endings (org-element-map + (org-element-parse-buffer) 'plain-list + (lambda (pl) (org-element-property :end pl))))) + ;; Move to ending of outer list. + (goto-char (car endings)) + (should (looking-at "Outside list")) + ;; Move to ending of inner list. + (goto-char (nth 1 endings)) + (should (looking-at "^$"))))) + + +;;;; Planning + +(ert-deftest test-org-element/planning-parser () + "Test `planning' parser." + (should + (equal + (org-element-property + :closed + (org-test-with-temp-text "CLOSED: [2012-03-29 thu.]" + (org-element-map (org-element-parse-buffer) 'planning 'identity nil t))) + "[2012-03-29 thu.]")) + (should + (equal + (org-element-property + :deadline + (org-test-with-temp-text "DEADLINE: <2012-03-29 thu.>" + (org-element-map (org-element-parse-buffer) 'planning 'identity nil t))) + "<2012-03-29 thu.>")) + (should + (equal + (org-element-property + :scheduled + (org-test-with-temp-text "SCHEDULED: <2012-03-29 thu.>" + (org-element-map (org-element-parse-buffer) 'planning 'identity nil t))) + "<2012-03-29 thu.>"))) + + +;;;; Property Drawer + +(ert-deftest test-org-element/property-drawer () + "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)))) + ;; 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)))) + ;; 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))))) + + +;;;; Quote Block + +(ert-deftest test-org-element/quote-block-parser () + "Test `quote-block' parser." + ;; Regular test. + (should + (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE" + (org-element-map (org-element-parse-buffer) 'quote-block 'identity))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_QUOTE\nText\n#+END_QUOTE" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'quote-block 'identity nil t)))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_QUOTE" + (org-element-map + (org-element-parse-buffer) 'quote-block 'identity nil t)))) + + +;;;; Quote Section + +(ert-deftest test-org-element/quote-section-parser () + "Test `quote-section' parser." + (should + (let ((org-quote-string "QUOTE")) + (org-test-with-temp-text "* QUOTE Headline\nBody" + (org-element-map (org-element-parse-buffer) 'quote-section 'identity)))) + (should-not + (let ((org-quote-string "TEST")) + (org-test-with-temp-text "* QUOTE Headline\nBody" + (org-element-map (org-element-parse-buffer) 'quote-section 'identity))))) + + +;;;; Radio Target + +(ert-deftest test-org-element/radio-target-parser () + "Test `radio-target' parser." + ;; Standard test. + (should + (org-test-with-temp-text "<<>>" + (org-element-map (org-element-parse-buffer) 'radio-target 'identity))) + ;; Radio targets with objects. + (should + (org-test-with-temp-text "<<>>" + (org-element-map (org-element-parse-buffer) 'radio-target 'identity)))) + + +;;;; Section + +(ert-deftest test-org-element/section-parser () + "Test `section' parser." + ;; Standard test. + (should + (org-test-with-temp-text "* Headline\nText" + (org-element-map (org-element-parse-buffer) 'section 'identity))) + ;; There's a section before the first headline. + (should + (org-test-with-temp-text "Text" + (org-element-map (org-element-parse-buffer) 'section 'identity))) + ;; A section cannot be empty. + (should-not + (org-test-with-temp-text "* Headline 1\n* Headline 2" + (org-element-map (org-element-parse-buffer) 'section 'identity)))) + + +;;;; Special Block + +(ert-deftest test-org-element/special-block-parser () + "Test `special-block' parser." + ;; Standard test. + (should + (equal + (org-test-with-temp-text "#+BEGIN_SPECIAL\nText\n#+END_SPECIAL" + (org-element-map + (org-element-parse-buffer) 'special-block 'identity nil t)) + '(special-block + (:type "SPECIAL" :begin 1 :end 35 :hiddenp nil :contents-begin 17 + :contents-end 22 :post-blank 0) + (paragraph + (:begin 17 :end 22 :contents-begin 17 :contents-end 21 :post-blank 0) + "Text")))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_SPECIAL\nText\n#+END_SPECIAL" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'special-block 'identity nil t)))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_SPECIAL" + (org-element-map + (org-element-parse-buffer) 'special-block 'identity nil t)))) + + +;;;; Src Block + +(ert-deftest test-org-element/src-block-parser () + "Test `src-block' parser." + ;; Regular tests. + (should + (org-test-with-temp-text "#+BEGIN_SRC\nText\n#+END_SRC" + (org-element-map (org-element-parse-buffer) 'src-block 'identity))) + ;; Test folded block. + (org-test-with-temp-text "#+BEGIN_SRC\nText\n#+END_SRC" + (org-cycle) + (should + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'src-block 'identity nil t)))) + ;; Ignore incomplete block. + (should-not + (org-test-with-temp-text "#+BEGIN_SRC" + (org-element-map (org-element-parse-buffer) 'src-block 'identity)))) + + +;;;; Statistics Cookie + +(ert-deftest test-org-element/statistics-cookie () + "Test `statistics-cookie' parser." + ;; With numbers. + (should + (org-test-with-temp-text "[1/2]" + (org-element-map (org-element-parse-buffer) 'statistics-cookie 'identity))) + ;; With percents. + (should + (org-test-with-temp-text "[33%]" + (org-element-map + (org-element-parse-buffer) 'statistics-cookie 'identity)))) + + +;;;; Strike Through + +(ert-deftest test-org-element/strike-through-parser () + "Test `strike-through' parser." + ;; Regular test. + (should + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "+strike-through+" + (org-element-map (org-element-parse-buffer) 'strike-through 'identity)))) + ;; Multi-line markup. + (should + (equal + (org-element-contents + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "+first line\nsecond line+" + (org-element-map + (org-element-parse-buffer) 'strike-through 'identity nil t)))) + '("first line\nsecond line")))) + + +;;; Subscript + +(ert-deftest test-org-element/subscript-parser () + "Test `subscript' parser." + ;; Without braces. + (should + (org-test-with-temp-text "a_b" + (org-element-map (org-element-parse-buffer) 'subscript 'identity))) + ;; With braces. + (should + (org-test-with-temp-text "a_{b}" + (org-element-map (org-element-parse-buffer) 'subscript 'identity)))) + + +;;; Superscript + +(ert-deftest test-org-element/superscript-parser () + "Test `superscript' parser." + ;; Without braces. + (should + (org-test-with-temp-text "a^b" + (org-element-map (org-element-parse-buffer) 'superscript 'identity))) + ;; With braces. + (should + (org-test-with-temp-text "a^{b}" + (org-element-map (org-element-parse-buffer) 'superscript 'identity)))) + + +;;;; Table + +(ert-deftest test-org-element/table-parser () + "Test `table' parser." + (should + (org-test-with-temp-text "| a |" + (org-element-map (org-element-parse-buffer) 'table 'identity)))) + + +;;;; Table Cell + +(ert-deftest test-org-element/table-cell-parser () + "Test `table-cell' parser." + (should + (org-test-with-temp-text "| a |" + (org-element-map (org-element-parse-buffer) 'table-cell 'identity)))) + + +;;;; Table Row + +(ert-deftest test-org-element/table-parser () + "Test `table-row' parser." + (should + (equal '(standard rule) + (org-test-with-temp-text "| a |\n|---|" + (org-element-map + (org-element-parse-buffer) 'table-row + (lambda (row) (org-element-property :type row))))))) + + +;;;; Target + +(ert-deftest test-org-element/target-parser () + "Test `target' parser." + (should + (org-test-with-temp-text "<>" + (org-element-map (org-element-parse-buffer) 'target 'identity)))) + + +;;;; Timestamp + +(ert-deftest test-org-element/timestamp () + "Test `timestamp' parser." + ;; Active timestamp. + (should + (org-test-with-temp-text "<2012-03-29 16:40>" + (org-element-map (org-element-parse-buffer) 'timestamp 'identity))) + ;; Inactive timestamp. + (should + (org-test-with-temp-text "[2012-03-29 16:40]" + (org-element-map (org-element-parse-buffer) 'timestamp 'identity))) + ;; Timestamps are not planning elements. + (should-not + (org-test-with-temp-text "SCHEDULED: <2012-03-29 16:40>" + (org-element-map (org-element-parse-buffer) 'timestamp 'identity)))) + + +;;;; Underline + +(ert-deftest test-org-element/underline-parser () + "Test `underline' parser." + ;; Regular test. + (should + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "_underline_" + (org-element-map (org-element-parse-buffer) 'underline 'identity)))) + ;; Multi-line markup. + (should + (equal + (org-element-contents + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "_first line\nsecond line_" + (org-element-map + (org-element-parse-buffer) 'underline 'identity nil t)))) + '("first line\nsecond line")))) + + +;;;; Verbatim + +(ert-deftest test-org-element/verbatim-parser () + "Test `verbatim' parser." + ;; Regular test. + (should + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "=verbatim=" + (org-element-map (org-element-parse-buffer) 'verbatim 'identity)))) + ;; Multi-line markup. + (should + (equal + (org-element-property + :value + (let ((org-emph-re "\\([ ('\"{]\\|^\\)\\(\\([+*/_=~]\\)\\([^ \n,\"']\\|[^ \n,\"'].*?\\(?:\n.*?\\)\\{0,1\\}[^ \n,\"']\\)\\3\\)\\([- .,:!?;'\")}\\]\\|$\\)")) + (org-test-with-temp-text "=first line\nsecond line=" + (org-element-map + (org-element-parse-buffer) 'verbatim 'identity nil t)))) + "first line\nsecond line"))) + + +;;;; Verse Block + +(ert-deftest test-org-element/verse-block-parser () + "Test `verse-block' parser." ;; Standard test. (org-test-with-temp-text "#+BEGIN_VERSE\nVerse block\n#+END_VERSE" (should - (equal - (org-element-map (org-element-parse-buffer) 'verse-block 'identity nil t) - '(verse-block - (:begin 1 :end 38 :contents-begin 15 :contents-end 27 :hiddenp nil - :post-blank 0) - "Verse block\n")))) + (org-element-map (org-element-parse-buffer) 'verse-block 'identity))) ;; Ignore case. (org-test-with-temp-text "#+begin_verse\nVerse block\n#+end_verse" (should - (equal - (org-element-map (org-element-parse-buffer) 'verse-block 'identity nil t) - '(verse-block - (:begin 1 :end 38 :contents-begin 15 :contents-end 27 :hiddenp nil - :post-blank 0) - "Verse block\n")))) + (org-element-map (org-element-parse-buffer) 'verse-block 'identity))) ;; Parse folding. (org-test-with-temp-text "#+BEGIN_VERSE\nVerse block\n#+END_VERSE" (org-hide-block-all) (should - (equal - (org-element-map (org-element-parse-buffer) 'verse-block 'identity nil t) - '(verse-block - (:begin 1 :end 38 :contents-begin 15 :contents-end 27 - :hiddenp org-hide-block :post-blank 0) - "Verse block\n")))) + (org-element-property + :hiddenp + (org-element-map + (org-element-parse-buffer) 'verse-block 'identity nil t)))) ;; Parse objects in verse blocks. (org-test-with-temp-text "#+BEGIN_VERSE\nVerse \\alpha\n#+END_VERSE" - (should (org-element-map (org-element-parse-buffer) 'entity 'identity)))) + (should (org-element-map (org-element-parse-buffer) 'entity 'identity))) + ;; Ignore incomplete verse block. + (should-not + (org-test-with-temp-text "#+BEGIN_VERSE" + (org-element-map + (org-element-parse-buffer) 'verse-block 'identity nil t)))) -;;;; Granularity - -(ert-deftest test-org-element/granularity () - "Test granularity impact on buffer parsing." - (org-test-with-temp-text " -* Head 1 -** Head 2 -#+BEGIN_CENTER -Centered paragraph. -#+END_CENTER -Paragraph \\alpha." - ;; 1.1. Granularity set to `headline' should parse every headline - ;; in buffer, and only them. - (let ((tree (org-element-parse-buffer 'headline))) - (should (= 2 (length (org-element-map tree 'headline 'identity)))) - (should-not (org-element-map tree 'paragraph 'identity))) - ;; 1.2. Granularity set to `greater-element' should not enter - ;; greater elements excepted headlines and sections. - (let ((tree (org-element-parse-buffer 'greater-element))) - (should (= 1 (length (org-element-map tree 'center-block 'identity)))) - (should (= 1 (length (org-element-map tree 'paragraph 'identity)))) - (should-not (org-element-map tree 'entity 'identity))) - ;; 1.3. Granularity set to `element' should enter every - ;; greater-element. - (let ((tree (org-element-parse-buffer 'element))) - (should (= 2 (length (org-element-map tree 'paragraph 'identity)))) - (should-not (org-element-map tree 'entity 'identity))) - ;; 1.4. Granularity set to `object' can see everything. - (let ((tree (org-element-parse-buffer 'object))) - (should (= 1 (length (org-element-map tree 'entity 'identity))))))) - -(ert-deftest test-org-element/secondary-string-parsing () - "Test if granularity correctly toggles secondary strings parsing." - ;; 1. With a granularity bigger than `object', no secondary string - ;; should be parsed. - ;; - ;; 1.1. Test with `headline' type. - (org-test-with-temp-text "* Headline" - (let ((headline - (org-element-map (org-element-parse-buffer 'headline) 'headline - 'identity - nil - 'first-match))) - (should (stringp (org-element-property :title headline))))) - ;; 1.2. Test with `item' type. - (org-test-with-temp-text "* Headline\n- tag :: item" - (let ((item (org-element-map (org-element-parse-buffer 'element) - 'item - 'identity - nil - 'first-match))) - (should (stringp (org-element-property :tag item))))) - ;; 1.3. Test with `inlinetask' type, if avalaible. - (when (featurep 'org-inlinetask) - (let ((org-inlinetask-min-level 15)) - (org-test-with-temp-text "*************** Inlinetask" - (let ((inlinetask (org-element-map (org-element-parse-buffer 'element) - 'inlinetask - 'identity - nil - 'first-match))) - (should (stringp (org-element-property :title inlinetask))))))) - ;; 2. With a default granularity, secondary strings should be - ;; parsed. - (org-test-with-temp-text "* Headline" - (let ((headline - (org-element-map (org-element-parse-buffer) 'headline - 'identity - nil - 'first-match))) - (should (listp (org-element-property :title headline))))) - ;; 3. `org-element-at-point' should never parse a secondary string. - (org-test-with-temp-text "* Headline" - (should (stringp (org-element-property :title (org-element-at-point)))))) - - - -;;;; Interpretation. +;;; Test Interpreters. (ert-deftest test-org-element/interpret-affiliated-keywords () "Test if affiliated keywords are correctly interpreted." @@ -572,13 +1573,31 @@ Paragraph \\alpha." "#+CALL: test[:results output]()[:results html]") "#+CALL: test[:results output]()[:results html]\n"))) +(ert-deftest test-org-element/clock-interpreter () + "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")) + ;; 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"))) + (ert-deftest test-org-element/comment-interpreter () "Test comment interpreter." ;; Regular comment. - (should (equal (org-test-parse-and-interpret "#Comment") "#Comment\n")) + (should (equal (org-test-parse-and-interpret "#Comment") "#+ Comment\n")) ;; Inline comment. (should (equal (org-test-parse-and-interpret " #+ Comment") - " #+ Comment\n"))) + "#+ Comment\n")) + ;; Preserve indentation. + (should (equal (org-test-parse-and-interpret " #+ No blank\n#+ One blank") + "#+ No blank\n#+ One blank\n"))) (ert-deftest test-org-element/comment-block-interpreter () "Test comment block interpreter." @@ -588,9 +1607,15 @@ Paragraph \\alpha." (ert-deftest test-org-element/example-block-interpreter () "Test example block interpreter." + ;; Without switches. (should (equal (org-test-parse-and-interpret "#+BEGIN_EXAMPLE\nTest\n#+END_EXAMPLE") - "#+BEGIN_EXAMPLE\nTest\n#+END_EXAMPLE\n"))) + "#+BEGIN_EXAMPLE\nTest\n#+END_EXAMPLE\n")) + ;; With switches. + (should + (equal (org-test-parse-and-interpret + "#+BEGIN_EXAMPLE -n -k\n(+ 1 1)\n#+END_EXAMPLE") + "#+BEGIN_EXAMPLE -n -k\n(+ 1 1)\n#+END_EXAMPLE\n"))) (ert-deftest test-org-element/export-block-interpreter () "Test export block interpreter." @@ -600,7 +1625,11 @@ Paragraph \\alpha." (ert-deftest test-org-element/fixed-width-interpreter () "Test fixed width interpreter." - (should (equal (org-test-parse-and-interpret ": Test") ": Test\n"))) + ;; Standard test. + (should (equal (org-test-parse-and-interpret ": Test") ": Test\n")) + ;; Preserve indentation. + (should (equal (org-test-parse-and-interpret ": 2 blanks\n: 1 blank") + ": 2 blanks\n: 1 blank\n"))) (ert-deftest test-org-element/horizontal-rule-interpreter () "Test horizontal rule interpreter." @@ -614,8 +1643,21 @@ Paragraph \\alpha." (ert-deftest test-org-element/latex-environment-interpreter () "Test latex environment interpreter." (should (equal (org-test-parse-and-interpret - "\begin{equation}\n1+1=2\n\end{equation}") - "\begin{equation}\n1+1=2\n\end{equation}\n"))) + "\\begin{equation}\n1+1=2\n\\end{equation}") + "\\begin{equation}\n1+1=2\n\\end{equation}\n"))) + +(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 +CLOSED: <2012-01-01> DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01>") + "* Headline +CLOSED: <2012-01-01> DEADLINE: <2012-01-01> SCHEDULED: <2012-01-01>\n")))) (ert-deftest test-org-element/property-drawer-interpreter () "Test property drawer interpreter." @@ -626,10 +1668,16 @@ Paragraph \\alpha." (ert-deftest test-org-element/src-block-interpreter () "Test src block interpreter." + ;; With arguments. (should (equal (org-test-parse-and-interpret "#+BEGIN_SRC emacs-lisp :results silent\n(+ 1 1)\n#+END_SRC") - "#+BEGIN_SRC emacs-lisp :results silent\n(+ 1 1)\n#+END_SRC\n"))) + "#+BEGIN_SRC emacs-lisp :results silent\n(+ 1 1)\n#+END_SRC\n")) + ;; With switches. + (should + (equal (org-test-parse-and-interpret + "#+BEGIN_SRC emacs-lisp -n -k\n(+ 1 1)\n#+END_SRC") + "#+BEGIN_SRC emacs-lisp -n -k\n(+ 1 1)\n#+END_SRC\n"))) (ert-deftest test-org-element/table-interpreter () "Test table, table-row and table-cell interpreters." @@ -642,7 +1690,12 @@ Paragraph \\alpha." "| a | b |\n|---+---|\n| c | d |\n")) ;; 3. Table with meta-data. (should (equal (org-test-parse-and-interpret "| / | < | > |\n| * | 1 | 2 |") - "| / | < | > |\n| * | 1 | 2 |\n"))) + "| / | < | > |\n| * | 1 | 2 |\n")) + ;; 4. With a formula. + (should + (equal (org-test-parse-and-interpret + "| 2 |\n| 4 |\n| 3 |\n#+TBLFM: @3=vmean(@1..@2)") + "| 2 |\n| 4 |\n| 3 |\n#+TBLFM: @3=vmean(@1..@2)\n"))) (ert-deftest test-org-element/verse-block-interpreter () "Test verse block interpretation." @@ -669,8 +1722,8 @@ Paragraph \\alpha." (ert-deftest test-org-element/export-snippet-interpreter () "Test export snippet interpreter." - (should (equal (org-test-parse-and-interpret "@back-end{test}") - "@back-end{test}\n"))) + (should (equal (org-test-parse-and-interpret "") + "\n"))) (ert-deftest test-org-element/footnote-reference-interpreter () "Test footnote reference interpreter." @@ -816,7 +1869,84 @@ Paragraph \\alpha." -;;;; Normalize contents +;;; Test Granularity + +(ert-deftest test-org-element/granularity () + "Test granularity impact on buffer parsing." + (org-test-with-temp-text " +* Head 1 +** Head 2 +#+BEGIN_CENTER +Centered paragraph. +#+END_CENTER +Paragraph \\alpha." + ;; 1.1. Granularity set to `headline' should parse every headline + ;; in buffer, and only them. + (let ((tree (org-element-parse-buffer 'headline))) + (should (= 2 (length (org-element-map tree 'headline 'identity)))) + (should-not (org-element-map tree 'paragraph 'identity))) + ;; 1.2. Granularity set to `greater-element' should not enter + ;; greater elements excepted headlines and sections. + (let ((tree (org-element-parse-buffer 'greater-element))) + (should (= 1 (length (org-element-map tree 'center-block 'identity)))) + (should (= 1 (length (org-element-map tree 'paragraph 'identity)))) + (should-not (org-element-map tree 'entity 'identity))) + ;; 1.3. Granularity set to `element' should enter every + ;; greater-element. + (let ((tree (org-element-parse-buffer 'element))) + (should (= 2 (length (org-element-map tree 'paragraph 'identity)))) + (should-not (org-element-map tree 'entity 'identity))) + ;; 1.4. Granularity set to `object' can see everything. + (let ((tree (org-element-parse-buffer 'object))) + (should (= 1 (length (org-element-map tree 'entity 'identity))))))) + +(ert-deftest test-org-element/secondary-string-parsing () + "Test if granularity correctly toggles secondary strings parsing." + ;; 1. With a granularity bigger than `object', no secondary string + ;; should be parsed. + ;; + ;; 1.1. Test with `headline' type. + (org-test-with-temp-text "* Headline" + (let ((headline + (org-element-map (org-element-parse-buffer 'headline) 'headline + 'identity + nil + 'first-match))) + (should (stringp (org-element-property :title headline))))) + ;; 1.2. Test with `item' type. + (org-test-with-temp-text "* Headline\n- tag :: item" + (let ((item (org-element-map (org-element-parse-buffer 'element) + 'item + 'identity + nil + 'first-match))) + (should (stringp (org-element-property :tag item))))) + ;; 1.3. Test with `inlinetask' type, if avalaible. + (when (featurep 'org-inlinetask) + (let ((org-inlinetask-min-level 15)) + (org-test-with-temp-text "*************** Inlinetask" + (let ((inlinetask (org-element-map (org-element-parse-buffer 'element) + 'inlinetask + 'identity + nil + 'first-match))) + (should (stringp (org-element-property :title inlinetask))))))) + ;; 2. With a default granularity, secondary strings should be + ;; parsed. + (org-test-with-temp-text "* Headline" + (let ((headline + (org-element-map (org-element-parse-buffer) 'headline + 'identity + nil + 'first-match))) + (should (listp (org-element-property :title headline))))) + ;; 3. `org-element-at-point' should never parse a secondary string. + (org-test-with-temp-text "* Headline" + (should (stringp (org-element-property :title (org-element-at-point)))))) + + + +;;; Test Normalize Contents (ert-deftest test-org-element/normalize-contents () "Test `org-element-normalize-contents' specifications." @@ -854,10 +1984,26 @@ Paragraph \\alpha." '(paragraph nil "No space\n Two spaces\n Three spaces") t) '(paragraph nil "No space\nTwo spaces\n Three spaces")))) - -;;;; Navigation tools. -(ert-deftest test-org-element/forward-element () + +;;; Test Navigation Tools. + +(ert-deftest test-org-element/at-point () + "Test `org-element-at-point' specifications." + ;; Special case: at the very beginning of a table, return `table' + ;; object instead of `table-row'. + (should + (eq 'table + (org-test-with-temp-text "| a | b |" + (org-element-type (org-element-at-point))))) + ;; Special case: at the very beginning of a list or sub-list, return + ;; `plain-list' object instead of `item'. + (should + (eq 'plain-list + (org-test-with-temp-text "- item" + (org-element-type (org-element-at-point)))))) + +(ert-deftest test-org-element/forward () "Test `org-element-forward' specifications." ;; 1. At EOB: should error. (org-test-with-temp-text "Some text\n" @@ -937,7 +2083,7 @@ Outside." (org-element-forward) (should (looking-at " - sub3")))) -(ert-deftest test-org-element/backward-element () +(ert-deftest test-org-element/backward () "Test `org-element-backward' specifications." ;; 1. At BOB (modulo some white spaces): should error. (org-test-with-temp-text " \nParagraph." @@ -1016,7 +2162,7 @@ Outside." (org-element-backward) (should (looking-at "- item1")))) -(ert-deftest test-org-element/up-element () +(ert-deftest test-org-element/up () "Test `org-element-up' specifications." ;; 1. At BOB or with no surrounding element: should error. (org-test-with-temp-text "Paragraph." @@ -1067,7 +2213,7 @@ Outside." (org-element-up) (should (looking-at "\\* Top")))) -(ert-deftest test-org-element/down-element () +(ert-deftest test-org-element/down () "Test `org-element-down' specifications." ;; 1. Error when the element hasn't got a recursive type. (org-test-with-temp-text "Paragraph." @@ -1133,6 +2279,50 @@ Outside." (should (equal (buffer-string) "Para2\n\n\nParagraph 1\n\nPara3")) (should (looking-at " 1")))) +(ert-deftest test-org-element/fill-paragraph () + "Test `org-element-fill-paragraph' specifications." + ;; At an Org table, align it. + (org-test-with-temp-text "|a|" + (org-element-fill-paragraph) + (should (equal (buffer-string) "| a |\n"))) + ;; At a paragraph, preserve line breaks. + (org-test-with-temp-text "some \\\\\nlong\ntext" + (let ((fill-column 20)) + (org-element-fill-paragraph) + (should (equal (buffer-string) "some \\\\\nlong text")))) + ;; At a verse block, fill paragraph at point, also preserving line + ;; breaks. Though, do nothing when point is at the block + ;; boundaries. + (org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE" + (forward-line) + (let ((fill-column 20)) + (org-element-fill-paragraph) + (should (equal (buffer-string) + "#+BEGIN_VERSE\nSome \\\\\nlong text\n#+END_VERSE")))) + (org-test-with-temp-text "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE" + (let ((fill-column 20)) + (org-element-fill-paragraph) + (should (equal (buffer-string) + "#+BEGIN_VERSE\nSome \\\\\nlong\ntext\n#+END_VERSE")))) + ;; Fill contents of `comment-block' and `example-block' elements. + (org-test-with-temp-text "#+BEGIN_COMMENT\nSome\ntext\n#+END_COMMENT" + (let ((fill-column 20)) + (forward-line) + (org-element-fill-paragraph) + (should (equal (buffer-string) + "#+BEGIN_COMMENT\nSome text\n#+END_COMMENT")))) + (org-test-with-temp-text "#+BEGIN_EXAMPLE\nSome\ntext\n#+END_EXAMPLE" + (let ((fill-column 20)) + (forward-line) + (org-element-fill-paragraph) + (should (equal (buffer-string) + "#+BEGIN_EXAMPLE\nSome text\n#+END_EXAMPLE")))) + ;; Do nothing at affiliated keywords. + (org-test-with-temp-text "#+NAME: para\nSome\ntext." + (let ((fill-column 20)) + (org-element-fill-paragraph) + (should (equal (buffer-string) "#+NAME: para\nSome\ntext."))))) + (provide 'test-org-element) ;;; test-org-element.el ends here diff --git a/testing/lisp/test-org-export.el b/testing/lisp/test-org-export.el index d21da395c..82002e2fb 100644 --- a/testing/lisp/test-org-export.el +++ b/testing/lisp/test-org-export.el @@ -74,12 +74,12 @@ already filled in `info'." (equal (org-export-parse-option-keyword "arch:headline creator:comment d:(\"TEST\") - ^:{} toc:1 tags:not-in-toc tasks:todo num:2") + ^:{} toc:1 tags:not-in-toc tasks:todo num:2 <:active") '( :section-numbers 2 :with-archived-trees headline :with-creator comment :with-drawers ("TEST") :with-sub-superscript {} :with-toc 1 - :with-tags not-in-toc :with-tasks todo)))) + :with-tags not-in-toc :with-tasks todo :with-timestamps active)))) (ert-deftest test-org-export/get-inbuffer-options () "Test reading all standard export keywords." @@ -207,12 +207,48 @@ already filled in `info'." (org-test-with-temp-text ":TEST:\ncontents\n:END:" (org-test-with-backend "test" (should (equal (org-export-as 'test nil nil nil '(:with-drawers nil)) - ""))))) - (let ((org-drawers '("TEST"))) - (org-test-with-temp-text ":TEST:\ncontents\n:END:" - (org-test-with-backend "test" + "")) (should (equal (org-export-as 'test nil nil nil '(:with-drawers t)) - ":TEST:\ncontents\n:END:\n")))))) + ":TEST:\ncontents\n:END:\n"))))) + (let ((org-drawers '("FOO" "BAR"))) + (org-test-with-temp-text ":FOO:\nkeep\n:END:\n:BAR:\nremove\n:END:" + (org-test-with-backend "test" + (should + (equal (org-export-as 'test nil nil nil '(:with-drawers ("FOO"))) + ":FOO:\nkeep\n:END:\n"))))) + ;; Timestamps. + (org-test-with-temp-text "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>" + (org-test-with-backend "test" + (should + (equal (org-export-as 'test nil nil nil '(:with-timestamps t)) + "[2012-04-29 sun. 10:45]<2012-04-29 sun. 10:45>\n")) + (should + (equal (org-export-as 'test nil nil nil '(:with-timestamps nil)) "")) + (should + (equal (org-export-as 'test nil nil nil '(:with-timestamps active)) + "<2012-04-29 sun. 10:45>\n")) + (should + (equal (org-export-as 'test nil nil nil '(:with-timestamps inactive)) + "[2012-04-29 sun. 10:45]\n")))) + ;; Clocks. + (let ((org-clock-string "CLOCK:")) + (org-test-with-temp-text "CLOCK: [2012-04-29 sun. 10:45]" + (org-test-with-backend "test" + (should + (equal (org-export-as 'test nil nil nil '(:with-clocks t)) + "CLOCK: [2012-04-29 sun. 10:45]\n")) + (should + (equal (org-export-as 'test nil nil nil '(:with-clocks nil)) ""))))) + ;; Plannings. + (let ((org-closed-string "CLOSED:")) + (org-test-with-temp-text "CLOSED: [2012-04-29 sun. 10:45]" + (org-test-with-backend "test" + (should + (equal (org-export-as 'test nil nil nil '(:with-plannings t)) + "CLOSED: [2012-04-29 sun. 10:45]\n")) + (should + (equal (org-export-as 'test nil nil nil '(:with-plannings nil)) + "")))))) (ert-deftest test-org-export/comment-tree () "Test if export process ignores commented trees." @@ -267,7 +303,7 @@ text (ert-deftest test-org-export/export-snippet () "Test export snippets transcoding." - (org-test-with-temp-text "@test{A}@t{B}" + (org-test-with-temp-text "" (org-test-with-backend "test" (flet ((org-test-export-snippet (snippet contents info) @@ -688,8 +724,8 @@ Another text. (ref:text) (org-element-map (org-element-parse-buffer) 'table 'identity nil 'first-match))))) -(ert-deftest test-org-export/special-row () - "Test if special rows in a table are properly recognized." +(ert-deftest test-org-export/table-row-is-special-p () + "Test `org-export-table-row-is-special-p' specifications." ;; 1. A row is special if it has a special marking character in the ;; special column. (org-test-with-parsed-data "| ! | 1 |" @@ -710,7 +746,7 @@ Another text. (ref:text) (org-export-table-row-is-special-p (org-element-map tree 'table-row 'identity nil 'first-match) info))) ;; 4. Everything else isn't considered as special. - (org-test-with-parsed-data "| a | | c |" + (org-test-with-parsed-data "| \alpha | | c |" (should-not (org-export-table-row-is-special-p (org-element-map tree 'table-row 'identity nil 'first-match) info))) @@ -858,7 +894,7 @@ Another text. (ref:text) (org-test-with-temp-text " | text | | some text | -| 12345 |" +| \alpha |" (let* ((tree (org-element-parse-buffer)) (info `(:parse-tree ,tree))) (should diff --git a/testing/lisp/test-org-list.el b/testing/lisp/test-org-list.el index b056a9a58..41721a563 100644 --- a/testing/lisp/test-org-list.el +++ b/testing/lisp/test-org-list.el @@ -358,6 +358,169 @@ - Item 3.1 ")))) +(ert-deftest test-org-list/move-item-down () + "Test `org-move-item-down' specifications." + ;; Standard test. + (org-test-with-temp-text "- item 1\n- item 2" + (org-move-item-down) + (should (equal (buffer-string) + "- item 2\n- item 1"))) + ;; Keep same column in item. + (org-test-with-temp-text "- item 1\n- item 2" + (forward-char 4) + (org-move-item-down) + (should (looking-at "em 1"))) + ;; Move sub-items. + (org-test-with-temp-text "- item 1\n - sub-item 1\n- item 2" + (org-move-item-down) + (should (equal (buffer-string) + "- item 2\n- item 1\n - sub-item 1"))) + ;; Preserve blank lines. + (org-test-with-temp-text "- item 1\n\n- item 2" + (let ((org-empty-line-terminates-plain-lists nil)) (org-move-item-down)) + (should (equal (buffer-string) "- item 2\n\n- item 1"))) + ;; Error when trying to move the last item... + (org-test-with-temp-text "- item 1\n- item 2" + (forward-line) + (should-error (org-move-item-down))) + ;; ... unless `org-list-use-circular-motion' is non-nil. In this + ;; case, move to the first item. + (org-test-with-temp-text "- item 1\n- item 2\n- item 3" + (forward-line 2) + (let ((org-list-use-circular-motion t)) (org-move-item-down)) + (should (equal (buffer-string) "- item 3\n- item 1\n- item 2\n"))) + ;; Preserve item visibility. + (org-test-with-temp-text "* Headline\n- item 1\n body 1\n- item 2\n body 2" + (let ((org-cycle-include-plain-lists t)) + (search-forward "- item 1") + (org-cycle) + (search-forward "- item 2") + (org-cycle)) + (search-backward "- item 1") + (org-move-item-down) + (forward-line) + (should (org-invisible-p2)) + (search-backward " body 2") + (should (org-invisible-p2))) + ;; Preserve children visibility. + (org-test-with-temp-text "* Headline +- item 1 + - sub-item 1 + sub-body 1 +- item 2 + - sub-item 2 + sub-body 2" + (let ((org-cycle-include-plain-lists t)) + (search-forward "- sub-item 1") + (org-cycle) + (search-forward "- sub-item 2") + (org-cycle)) + (search-backward "- item 1") + (org-move-item-down) + (search-forward "sub-body 1") + (should (org-invisible-p2)) + (search-backward "sub-body 2") + (should (org-invisible-p2))) + ;; Preserve contents visibility. + (org-test-with-temp-text " +- item 1 + #+BEGIN_CENTER + Text1 + #+END_CENTER +- item 2 + #+BEGIN_CENTER + Text2 + #+END_CENTER" + (org-hide-block-all) + (search-forward "- item 1") + (org-move-item-down) + (search-forward "Text1") + (should (org-invisible-p2)) + (search-backward "Text2") + (should (org-invisible-p2)))) + +(ert-deftest test-org-list/move-item-up () + "Test `org-move-item-up' specifications." + ;; Standard test. + (org-test-with-temp-text "- item 1\n- item 2" + (forward-line) + (org-move-item-up) + (should (equal (buffer-string) + "- item 2\n- item 1"))) + ;; Keep same column in item. + (org-test-with-temp-text "- item 1\n- item 2" + (forward-line) + (forward-char 4) + (org-move-item-up) + (should (looking-at "em 2"))) + ;; Move sub-items. + (org-test-with-temp-text "- item 1\n- item 2\n - sub-item 2" + (forward-line) + (org-move-item-up) + (should (equal (buffer-string) + "- item 2\n - sub-item 2\n- item 1"))) + ;; Preserve blank lines. + (org-test-with-temp-text "- item 1\n\n- item 2" + (search-forward "- item 2") + (let ((org-empty-line-terminates-plain-lists nil)) (org-move-item-up)) + (should (equal (buffer-string) "- item 2\n\n- item 1"))) + ;; Error when trying to move the first item... + (org-test-with-temp-text "- item 1\n- item 2" + (should-error (org-move-item-up))) + ;; ... unless `org-list-use-circular-motion' is non-nil. In this + ;; case, move to the first item. + (org-test-with-temp-text "- item 1\n- item 2\n- item 3" + (let ((org-list-use-circular-motion t)) (org-move-item-up)) + (should (equal (buffer-string) "- item 2\n- item 3\n- item 1"))) + ;; Preserve item visibility. + (org-test-with-temp-text "* Headline\n- item 1\n body 1\n- item 2\n body 2" + (let ((org-cycle-include-plain-lists t)) + (search-forward "- item 1") + (org-cycle) + (search-forward "- item 2") + (org-cycle)) + (org-move-item-up) + (forward-line) + (should (org-invisible-p2)) + (search-forward " body 1") + (should (org-invisible-p2))) + ;; Preserve children visibility. + (org-test-with-temp-text "* Headline +- item 1 + - sub-item 1 + sub-body 1 +- item 2 + - sub-item 2 + sub-body 2" + (let ((org-cycle-include-plain-lists t)) + (search-forward "- sub-item 1") + (org-cycle) + (search-forward "- sub-item 2") + (org-cycle)) + (search-backward "- item 2") + (org-move-item-up) + (search-forward "sub-body 2") + (should (org-invisible-p2)) + (search-forward "sub-body 1") + (should (org-invisible-p2))) + ;; Preserve contents visibility. + (org-test-with-temp-text " +- item 1 + #+BEGIN_CENTER + Text1 + #+END_CENTER +- item 2 + #+BEGIN_CENTER + Text2 + #+END_CENTER" + (org-hide-block-all) + (search-forward "- item 2") + (org-move-item-up) + (search-forward "Text2") + (should (org-invisible-p2)) + (search-forward "Text1") + (should (org-invisible-p2)))) + (provide 'test-org-list) ;;; test-org-list.el ends here