From 4f82a58e8c29cb54c3ead1e0e83311de685a830a Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Mon, 16 Aug 2010 11:08:37 -0400 Subject: [PATCH 001/348] babel: python: use eq instead of equal * ob-python.el (org-babel-python-initiate-session-by-key): use eq instead of equal to compare symbols --- lisp/ob-python.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index e7101f075..44411e45c 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -150,10 +150,10 @@ then create. Return the initialized session." (let* ((session (if session (intern session) :default)) (python-buffer (org-babel-python-session-buffer session))) (cond - ((and (equal 'python org-babel-python-mode) + ((and (eq 'python org-babel-python-mode) (fboundp 'run-python)) ; python.el (run-python)) - ((and (equal 'python-mode org-babel-python-mode) + ((and (eq 'python-mode org-babel-python-mode) (fboundp 'py-shell)) ; python-mode.el ;; `py-shell' creates a buffer whose name is the value of ;; `py-which-bufname' with '*'s at the beginning and end From 652e7f28401064d010b4aa5aa7ff9527a30821ad Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 17:13:53 +0200 Subject: [PATCH 002/348] Revert "Bug fix in pw script" This reverts commit 3363a7b9952a61b0bc8e9375e3030e54cd824f94. --- UTILITIES/pw | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/UTILITIES/pw b/UTILITIES/pw index cc1244a77..8bf861d17 100755 --- a/UTILITIES/pw +++ b/UTILITIES/pw @@ -285,7 +285,7 @@ def action_apply(rpc, patch_id): sys.exit(1) def action_update_patch(rpc, patch_id, state = None, commit = None, - delegate_str = "", comment_str, archived = False): + delegate_str = "", comment_str = "No comment", archived = False): patch = rpc.patch_get(patch_id) if patch == {}: sys.stderr.write("Error getting information on patch ID %d\n" % \ From 4a523e0cf0fba620b0296d376c6efb617c31e7a4 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 17:17:15 +0200 Subject: [PATCH 003/348] Big bug in pw script --- UTILITIES/pw | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/UTILITIES/pw b/UTILITIES/pw index 8bf861d17..edf101858 100755 --- a/UTILITIES/pw +++ b/UTILITIES/pw @@ -471,7 +471,8 @@ def merge_with(patch_id, rpc, delegate_str, comment_str): # If it succeeded this far, mark the patch as "Accepted" by the invoking # user. action_update_patch(rpc, patch_id, state = 'Accepted', commit = sha, - delegate_str = delegate_str, archived = True) + delegate_str = delegate_str, comment_str = comment_str, + archived = True) print sha From ef56c6f361c943f18b817044dc8c64627712b18a Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 17:19:29 +0200 Subject: [PATCH 004/348] Another bug in pw... --- UTILITIES/pw | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/UTILITIES/pw b/UTILITIES/pw index cc1244a77..0d171a9f6 100755 --- a/UTILITIES/pw +++ b/UTILITIES/pw @@ -285,7 +285,8 @@ def action_apply(rpc, patch_id): sys.exit(1) def action_update_patch(rpc, patch_id, state = None, commit = None, - delegate_str = "", comment_str, archived = False): + delegate_str = "", comment_str = "None", + archived = False): patch = rpc.patch_get(patch_id) if patch == {}: sys.stderr.write("Error getting information on patch ID %d\n" % \ From 3529be82eff7906c1182fafbea6012fb6bfec160 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 17:27:25 +0200 Subject: [PATCH 005/348] Fix interpretation of the :include property as a list of file names --- lisp/org-publish.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/org-publish.el b/lisp/org-publish.el index 6324eba2f..4bf203106 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -471,7 +471,12 @@ matching filenames." (i (plist-get (cdr prj) :include)) (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) (when (or - (and i (string-match i filename)) + (and + i + (member filename + (mapcar + (lambda (file) (expand-file-name file b)) + i))) (and (not (and e (string-match e filename))) (string-match xm filename))) From 3aa4ba493e8a859c0f06cf257146425adaad62e0 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 17:58:33 +0200 Subject: [PATCH 006/348] Mention that bug reports should be using the latest Org version if possible --- doc/org.texi | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index bc8369318..16241112a 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -727,10 +727,15 @@ active region by using the mouse to select a region, or pressing If you find problems with Org, or if you have questions, remarks, or ideas about it, please mail to the Org mailing list @email{emacs-orgmode@@gnu.org}. If you are not a member of the mailing list, your mail will be passed to the -list after a moderator has approved it. +list after a moderator has approved it@footnote{Please consider subscribing +to the mailing list, in order to minimize the work the mailing list +moderators have to do.}. -For bug reports, please provide as much information as possible, including -the version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org +For bug reports, please first try to reproduce the bug with the latest +version of Org available - if you are running an outdated version, it is +quite possible that the bug has been fixed already. If the bug persists, +prepare a report and provide as much information as possible, including the +version information of Emacs (@kbd{M-x emacs-version @key{RET}}) and Org (@kbd{M-x org-version @key{RET}}), as well as the Org related setup in @file{.emacs}. The easiest way to do this is to use the command @example @@ -749,7 +754,7 @@ about: @item What did you expect to happen? @item What happened instead? @end enumerate -@noindent Thank you for helping to improve this mode. +@noindent Thank you for helping to improve this program. @subsubheading How to create a useful backtrace From 56cf6ad42de9f00fe90cfb5230468872e679c163 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 19:20:01 +0200 Subject: [PATCH 007/348] Verify that refile cached position is correct * lisp/org.el (org-refile-check-position): New function. (org-goto): (org-refile-get-location): Call `org-refile-check-position'. Samuel Wales has reported that the cache is loosing it, occasionally. --- lisp/org.el | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 49b04f401..003ab841e 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6440,7 +6440,9 @@ the headline hierarchy above." (selected-point (if (eq interface 'outline) (car (org-get-location (current-buffer) org-goto-help)) - (nth 3 (org-refile-get-location "Goto: "))))) + (let ((pa (org-refile-get-location "Goto: "))) + (org-refile-check-position pa) + (nth 3 pa))))) (if selected-point (progn (org-mark-ring-push org-goto-start-pos) @@ -10246,6 +10248,7 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (setq answ (funcall cfunc prompt tbl nil (not new-nodes) nil 'org-refile-history)) (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) + (org-refile-check-position pa) (if pa (progn (when (or (not org-refile-history) @@ -10272,6 +10275,26 @@ This can be done with a 0 prefix: `C-0 C-c C-w'" (org-refile-new-child parent-target child))) (error "Invalid target location"))))) +(defun org-refile-check-position (refile-pointer) + "Check if the refile pointer matches the readline to which it points." + (let* ((file (nth 1 refile-pointer)) + (re (nth 2 refile-pointer)) + (pos (nth 3 refile-pointer)) + buffer) + (when (org-string-nw-p re) + (setq buffer (if (markerp pos) + (marker-buffer pos) + (or (find-buffer-visiting file) + (find-file-noselect file)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (beginning-of-line 1) + (unless (org-looking-at-p re) + (error "Invalid refile position, please rebuild the cache")))))))) + (defun org-refile-new-child (parent-target child) "Use refile target PARENT-TARGET to add new CHILD below it." (unless parent-target From 3082ea9a30bb9782f233e01c1b312fc8b1651c5e Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Mon, 16 Aug 2010 19:27:38 +0200 Subject: [PATCH 008/348] Use a better regexp to find a refile target headline * lisp/org.el (org-complex-heading-regexp-format): Document the variable. (org-get-refile-targets): Use `org-complex-heading-regexp-format' to make the regular expression for matching the headline. Now we use the format for the complex heading regexp, which means that Changing the TODO state, level, priority, or tags of a heading will still allow the heading to be matched by the regexp. --- lisp/org.el | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 003ab841e..9cb37999c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4038,7 +4038,11 @@ group 3: Priority cookie group 4: True headline group 5: Tags") (make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-complex-heading-regexp-format nil) +(defvar org-complex-heading-regexp-format nil + "Printf format to make regexp to match an exact headline. +This regexp will match the headline of any node which hase the exact +headline text that is put into the format, but may have any TODO state, +priority and tags.") (make-variable-buffer-local 'org-complex-heading-regexp-format) (defvar org-todo-line-tags-regexp nil "Matches a headline and puts TODO state into group 2 if present. @@ -9941,15 +9945,8 @@ on the system \"/user@host:\"." (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) txt (org-link-display-format (match-string 4)) - re (concat "^" (regexp-quote - (buffer-substring - (match-beginning 1) - (match-end 4))))) - (if (match-end 5) (setq re (concat - re "[ \t]+" - (regexp-quote - (match-string 5))))) - (setq re (concat re "[ \t]*$")) + re (format org-complex-heading-regexp-format + (regexp-quote (match-string 4)))) (when org-refile-use-outline-path (setq txt (mapconcat 'org-protect-slash From 244681c44f077125b06fd04d619ea85acd68077a Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Mon, 16 Aug 2010 20:46:38 +0200 Subject: [PATCH 009/348] org-agenda-clock-out: remove unused optional argument "arg". --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 194f392fc..5bc1c8fd2 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7138,7 +7138,7 @@ The cursor may be at a date in the calendar, or in the Org agenda." (setq newhead (org-get-heading))) (org-agenda-change-all-lines newhead hdmarker))))) -(defun org-agenda-clock-out (&optional arg) +(defun org-agenda-clock-out () "Stop the currently running clock." (interactive "P") (unless (marker-buffer org-clock-marker) From 1ab9b17ee8154d8b5d7794cc28b367bf6960c338 Mon Sep 17 00:00:00 2001 From: David Maus Date: Mon, 16 Aug 2010 21:06:12 +0200 Subject: [PATCH 010/348] Delete excluded lines directly after call to sorting filter function. * org-agenda.el (org-finalize-agenda-entries): Delete excluded lines directly after call to sorting filter function. --- lisp/org-agenda.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 5bc1c8fd2..ad818358b 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5224,8 +5224,8 @@ could bind the variable in the options section of a custom command.") (if nosort list (when org-agenda-before-sorting-filter-function - (setq list (mapcar org-agenda-before-sorting-filter-function list))) - (delq nil (mapconcat 'identity (sort list 'org-entries-lessp) "\n")))) + (setq list (delq nil (mapcar org-agenda-before-sorting-filter-function list)))) + (mapconcat 'identity (sort list 'org-entries-lessp) "\n"))) (defun org-agenda-highlight-todo (x) (let ((org-done-keywords org-done-keywords-for-agenda) From 17ace08e0f883c176b577eec09b19012af8c2d0a Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 17 Aug 2010 06:32:55 +0200 Subject: [PATCH 011/348] Do not use looking-at-p when it does not exist * lisp/org-compat.el (org-looking-at-p): Only use looking-at-p when defined. --- lisp/org-compat.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-compat.el b/lisp/org-compat.el index 4fde94c8e..4383bec67 100644 --- a/lisp/org-compat.el +++ b/lisp/org-compat.el @@ -353,7 +353,7 @@ TIME defaults to the current time." (if (fboundp 'looking-at-p) (apply 'looking-at-p args) (save-match-data - (apply 'looking-at-p args)))) + (apply 'looking-at args)))) ; XEmacs does not have `looking-back'. (if (fboundp 'looking-back) From bf3405a6ba971d535ad8401e95708851e2ed0b84 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 17 Aug 2010 08:30:15 +0200 Subject: [PATCH 012/348] Fix tags column for the case when org-indent-mode is active * lisp/org.el (org-set-tags): Consider org-indent-mode when computing the tags column. --- lisp/org.el | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 9cb37999c..67c5b3cd0 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12775,7 +12775,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (col (current-column)) (org-setting-tags t) table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl) + tags p0 c0 c1 rpl di tc level) (if arg (save-excursion (goto-char (point-min)) @@ -12825,6 +12825,9 @@ With prefix ARG, realign all tags in headings in the current buffer." ;; 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 @@ -12833,11 +12836,14 @@ With prefix ARG, realign all tags in headings in the current buffer." (if (equal tags "") (setq rpl "") (goto-char (match-beginning 0)) - (setq c0 (current-column) p0 (if (equal (char-before) ?*) - (1+ (point)) (point)) - c1 (max (1+ c0) (if (> org-tags-column 0) - org-tags-column - (- (- org-tags-column) (length tags)))) + (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))) From d2640d324be3013be727f5166cd490551edfb2ae Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andreas=20R=C3=B6hler?= Date: Tue, 17 Aug 2010 12:13:53 +0000 Subject: [PATCH 013/348] gitignore patch Hi, consider these endings ignored by default useful too. BTW re-sorted, doubled *.dvi-entry removed. Cheers, Andreas --- .gitignore | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index ba75c2a07..374f45e72 100644 --- a/.gitignore +++ b/.gitignore @@ -8,23 +8,25 @@ *.bak *.cp *.cps +*.diff *.dvi *.elc *.fn *.fns *.html +*.info *.ky *.kys *.log +*.patch *.pdf *.pg *.pgs +*.ps *.toc *.tp *.vr *.vrs -*.dvi -*.ps orgcard_letter.tex orgcard.txt org From 4ea5658a1a14efaa7cf3fff883cd43cac2019c77 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 17 Aug 2010 10:40:14 +0200 Subject: [PATCH 014/348] Add org-drill.el --- contrib/README | 2 + contrib/lisp/org-drill.el | 446 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 448 insertions(+) create mode 100644 contrib/lisp/org-drill.el diff --git a/contrib/README b/contrib/README index 4a1879092..6a158211e 100644 --- a/contrib/README +++ b/contrib/README @@ -18,6 +18,8 @@ org-choose.el --- Use TODO keywords to mark decision states org-collector.el --- Collect properties into tables org-contribdir.el --- Dummy file to mark the org contrib Lisp directory org-depend.el --- TODO dependencies for Org-mode +org-drill.el --- Self-testing with org-learn +org-depend.el --- TODO dependencies for Org-mode org-elisp-symbol.el --- Org links to emacs-lisp symbols org-eval.el --- The tag, adapted from Muse org-eval-light.el --- Evaluate in-buffer code on demand diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el new file mode 100644 index 000000000..89c3124d0 --- /dev/null +++ b/contrib/lisp/org-drill.el @@ -0,0 +1,446 @@ +;;; org-drill.el - Self-testing with org-learn +;;; +;;; Author: Paul Sexton +;;; Version: 1.0 +;;; Repository at http://bitbucket.org/eeeickythump/org-drill/ +;;; +;;; +;;; Synopsis +;;; ======== +;;; +;;; Uses the spaced repetition algorithm in `org-learn' to conduct interactive +;;; "drill sessions", where the material to be remembered is presented to the +;;; student in random order. The student rates his or her recall of each item, +;;; and this information is fed back to `org-learn' to schedule the item for +;;; later revision. +;;; +;;; Each drill session can be restricted to topics in the current buffer +;;; (default), one or several files, all agenda files, or a subtree. A single +;;; topic can also be drilled. +;;; +;;; Different "card types" can be defined, which present their information to +;;; the student in different ways. +;;; +;;; +;;; Installation +;;; ============ +;;; +;;; Put the following in your .emacs: +;;; +;;; (add-to-list 'load-path "/path/to/org-drill/") +;;; (require 'org-drill) +;;; +;;; +;;; Writing the questions +;;; ===================== +;;; +;;; See the file "spanish.org" for an example set of material. +;;; +;;; Tag all items you want to be asked about with a tag that matches +;;; `org-drill-question-tag'. This is :drill: by default. +;;; +;;; You don't need to schedule the topics initially. However org-drill *will* +;;; recognise items that have been scheduled previously with `org-learn'. +;;; +;;; Within each question, the answer can be included in the following ways: +;;; +;;; - Question in the main body text, answer in subtopics. This is the +;;; default. All subtopics will be shown collapsed, while the text under +;;; the main heading will stay visible. +;;; +;;; - Each subtopic contains a piece of information related to the topic. ONE +;;; of these will revealed at random, and the others hidden. To define a +;;; topic of this type, give the topic a property `DRILL_CARD_TYPE' with +;;; value `multisided'. +;;; +;;; - Cloze deletion -- any pieces of text in the body of the card that are +;;; surrounded with [SINGLE square brackets] will be hidden when the card is +;;; presented to the user, and revealed once they press a key. Cloze deletion +;;; is automatically applied to all topics. +;;; +;;; - No explicit answer -- the user judges whether they recalled the +;;; fact adequately. +;;; +;;; - Other methods of your own devising, provided you write a function to +;;; handle selective display of the topic. See the function +;;; `org-drill-present-spanish-verb', which handles topics of type "spanish_verb", +;;; for an example. +;;; +;;; +;;; Running the drill session +;;; ========================= +;;; +;;; Start a drill session with `M-x org-drill'. This will include all eligible +;;; topics in the current buffer. `org-drill' can also be targeted at a particular +;;; subtree or particular files or sets of files; see the documentation of +;;; the function `org-drill' for details. +;;; +;;; During the drill session, you will be presented with each item, then asked +;;; to rate your recall of it by pressing a key between 0 and 5. At any time you +;;; can press 'q' to finish the drill early (your progress will be saved), or +;;; 'e' to finish the drill and jump to the current topic for editing. +;;; +;;; +;;; TODO +;;; ==== +;;; +;;; - encourage org-learn to reschedule "4" and "5" items. +;;; - nicer "cloze face" which does not hide the space preceding the cloze, +;;; and behaves more nicely across line breaks +;;; - hide drawers. +;;; - org-drill-question-tag should use a tag match string, rather than a +;;; single tag +;;; - when finished, display a message showing how many items reviewed, +;;; how many still pending, numbers in each recall category + +(eval-when-compile (require 'cl)) +(eval-when-compile (require 'hi-lock)) +(require 'org) +(require 'org-learn) + + +(defgroup org-drill nil + "Options concerning interactive drill sessions in Org mode (org-drill)." + :tag "Org-Drill" + :group 'org-link) + + + +(defcustom org-drill-question-tag + "drill" + "Tag which topics must possess in order to be identified as review topics +by `org-drill'." + :group 'org-drill + :type 'string) + + + +(defcustom org-drill-maximum-items-per-session + 30 + "Each drill session will present at most this many topics for review. +Nil means unlimited." + :group 'org-drill + :type '(choice integer (const nil))) + + + +(defcustom org-drill-maximum-duration + 20 + "Maximum duration of a drill session, in minutes. +Nil means unlimited." + :group 'org-drill + :type '(choice integer (const nil))) + + + +(defface org-drill-hidden-cloze-face + '((t (:foreground "blue" :background "blue"))) + "The face used to hide the contents of cloze phrases." + :group 'org-drill) + + +(defvar org-drill-cloze-regexp + "[^][]\\(\\[[^][][^]]*\\]\\)") + + +(defcustom org-drill-card-type-alist + '((nil . org-drill-present-simple-card) + ("simple" . org-drill-present-simple-card) + ("multisided" . org-drill-present-multi-sided-card) + ("spanish_verb" . org-drill-present-spanish-verb)) + "Alist associating card types with presentation functions. Each entry in the +alist takes the form (CARDTYPE . FUNCTION), where CARDTYPE is a string +or nil, and FUNCTION is a function which takes no arguments and returns a +boolean value." + :group 'org-drill + :type '(alist :key-type (choice string (const nil)) :value-type function)) + + + +(defun shuffle-list (list) + "Randomly permute the elements of LIST (all permutations equally likely)." + ;; Adapted from 'shuffle-vector' in cookie1.el + (let ((i 0) + j + temp + (len (length list))) + (while (< i len) + (setq j (+ i (random (- len i)))) + (setq temp (nth i list)) + (setf (nth i list) (nth j list)) + (setf (nth j list) temp) + (setq i (1+ i)))) + list) + + + +(defun org-drill-entry-due-p () + (let ((item-time (org-get-scheduled-time (point)))) + (and (or (assoc "LEARN_DATA" (org-entry-properties nil)) + (member org-drill-question-tag (org-get-local-tags))) + (or (null item-time) + (not (minusp ; scheduled for today/in + ; future + (- (time-to-days (current-time)) + (time-to-days item-time)))))))) + + + +(defun org-drill-reschedule () + (let ((ch nil)) + (while (not (memq ch '(?q ?0 ?1 ?2 ?3 ?4 ?5))) + (setq ch (read-char + (if (eq ch ??) + "0-2 Means you have forgotten the item. +3-5 Means you have remembered the item. + +0 - Completely forgot. +1 - Even after seeing the answer, it still took a bit to sink in. +2 - After seeing the answer, you remembered it. +3 - It took you awhile, but you finally remembered. +4 - After a little bit of thought you remembered. +5 - You remembered the item really easily. + +How well did you do? (0-5, ?=help, q=quit)" + "How well did you do? (0-5, ?=help, q=quit)")))) + (cond + ((and (>= ch ?0) (<= ch ?5)) + (save-excursion + (org-smart-reschedule (- ch 48))) + ch) + (t + nil)))) + + +(defun org-drill-hide-all-subheadings-except (heading-list) + "Returns a list containing the position of each immediate subheading of +the current topic." + (let ((drill-entry-level (org-current-level)) + (drill-sections nil) + (drill-heading nil)) + (org-show-subtree) + (save-excursion + (org-map-entries + (lambda () + (when (= (org-current-level) (1+ drill-entry-level)) + (setq drill-heading (org-get-heading t)) + (unless (member drill-heading heading-list) + (hide-subtree)) + (push (point) drill-sections))) + "" 'tree)) + (reverse drill-sections))) + + +(defun org-drill-presentation-prompt (&rest fmt-and-args) + (let ((ch (read-char (if fmt-and-args + (apply 'format + (first fmt-and-args) + (rest fmt-and-args)) + "Press any key to see the answer, 'e' to edit, 'q' to quit.")))) + (case ch + (?q nil) + (?e 'edit) + (otherwise t)))) + + +;;; Presentation functions ==================================================== + +;; Each of these is called with point on topic heading. Each needs to show the +;; topic in the form of a 'question' or with some information 'hidden', as +;; appropriate for the card type. The user should then be prompted to press a +;; key. The function should then reveal either the 'answer' or the entire +;; topic, and should return t if the user chose to see the answer and rate their +;; recall, nil if they chose to quit. + +(defun org-drill-present-simple-card () + (org-drill-hide-all-subheadings-except nil) + (prog1 (org-drill-presentation-prompt) + (org-show-subtree))) + + +(defun org-drill-present-multi-sided-card () + (let ((drill-sections (org-drill-hide-all-subheadings-except nil))) + (when drill-sections + (save-excursion + (goto-char (nth (random (length drill-sections)) drill-sections)) + (org-show-subtree))) + (prog1 + (org-drill-presentation-prompt) + (org-show-subtree)))) + + + +(defun org-drill-present-spanish-verb () + (case (random 6) + (0 + (org-drill-hide-all-subheadings-except '("Infinitive")) + (prog1 + (org-drill-presentation-prompt + "Translate this Spanish verb, and conjugate it for the *present* tense.") + (org-drill-hide-all-subheadings-except '("English" "Present Tense" + "Notes")))) + (1 + (org-drill-hide-all-subheadings-except '("English")) + (prog1 + (org-drill-presentation-prompt + "For the *present* tense, conjugate the Spanish translation of this English verb.") + (org-drill-hide-all-subheadings-except '("Infinitive" "Present Tense" + "Notes")))) + (2 + (org-drill-hide-all-subheadings-except '("Infinitive")) + (prog1 + (org-drill-presentation-prompt + "Translate this Spanish verb, and conjugate it for the *past* tense.") + (org-drill-hide-all-subheadings-except '("English" "Past Tense" + "Notes")))) + (3 + (org-drill-hide-all-subheadings-except '("English")) + (prog1 + (org-drill-presentation-prompt + "For the *past* tense, conjugate the Spanish translation of this English verb.") + (org-drill-hide-all-subheadings-except '("Infinitive" "Past Tense" + "Notes")))) + (4 + (org-drill-hide-all-subheadings-except '("Infinitive")) + (prog1 + (org-drill-presentation-prompt + "Translate this Spanish verb, and conjugate it for the *future perfect* tense.") + (org-drill-hide-all-subheadings-except '("English" "Future Perfect Tense" + "Notes")))) + (5 + (org-drill-hide-all-subheadings-except '("English")) + (prog1 + (org-drill-presentation-prompt + "For the *future perfect* tense, conjugate the Spanish translation of this English verb.") + (org-drill-hide-all-subheadings-except '("Infinitive" "Future Perfect Tense" + "Notes")))))) + + + + +(defun org-drill-entry () + "Present the current topic for interactive review, as in `org-drill'. +Review will occur regardless of whether the topic is due for review or whether +it meets the definition of a 'review topic' used by `org-drill'. + +See `org-drill' for more details." + (interactive) + (unless (org-at-heading-p) + (org-back-to-heading)) + (let ((card-type (cdr (assoc "DRILL_CARD_TYPE" (org-entry-properties nil)))) + (cont nil)) + (save-restriction + (org-narrow-to-subtree) + (org-show-subtree) + (org-cycle-hide-drawers 'overview) + + (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist)))) + (cond + (presentation-fn + (highlight-regexp org-drill-cloze-regexp + 'org-drill-hidden-cloze-face) + (setq cont (funcall presentation-fn)) + (unhighlight-regexp org-drill-cloze-regexp)) + (t + (error "Unknown card type: '%s'" card-type)))) + + (cond + ((not cont) + (message "Quit") + nil) + ((eql cont 'edit) + 'edit) + (t + (save-excursion + (org-drill-reschedule))))))) + + + +(defun org-drill (&optional scope) + "Begin an interactive 'drill session'. The user is asked to +review a series of topics (headers). Each topic is initially +presented as a 'question', often with part of the topic content +hidden. The user attempts to recall the hidden information or +answer the question, then presses a key to reveal the answer. The +user then rates his or her recall or performance on that +topic. This rating information is used to reschedule the topic +for future review using the `org-learn' library. + +Org-drill proceeds by: + +- Finding all topics (headings) in SCOPE which have either been + used and rescheduled by org-learn before (i.e. the LEARN_DATA + property is set), or which have a tag that matches + `org-drill-question-tag'. + +- All matching topics which are either unscheduled, or are + scheduled for the current date or a date in the past, are + considered to be candidates for the drill session. + +- If `org-drill-maximum-items-per-session' is set, a random + subset of these topics is presented. Otherwise, all of the + eligible topics will be presented. + +SCOPE determines the scope in which to search for +questions. It is passed to `org-map-entries', and can be any of: + +nil The current buffer, respecting the restriction if any. + This is the default. +tree The subtree started with the entry at point +file The current buffer, without restriction +file-with-archives + The current buffer, and any archives associated with it +agenda All agenda files +agenda-with-archives + All agenda files with any archive files associated with them + (file1 file2 ...) + If this is a list, all files in the list will be scanned." + + (interactive) + (let ((entries nil) + (result nil) + (results nil) + (end-pos nil)) + (block org-drill + (save-excursion + (org-map-entries + (lambda () (if (org-drill-entry-due-p) + (push (point-marker) entries))) + "" scope) + (cond + ((null entries) + (message "I did not find any pending drill items.")) + (t + (let ((start-time (float-time (current-time)))) + (dolist (m (if (and org-drill-maximum-items-per-session + (> (length entries) + org-drill-maximum-items-per-session)) + (subseq (shuffle-list entries) 0 + org-drill-maximum-items-per-session) + (shuffle-list entries))) + (save-restriction + (switch-to-buffer (marker-buffer m)) + (goto-char (marker-position m)) + (setq result (org-drill-entry)) + (cond + ((null result) + (message "Quit") + (return-from org-drill nil)) + ((eql result 'edit) + (setq end-pos (point-marker)) + (return-from org-drill nil)) + ((and org-drill-maximum-duration + (> (- (float-time (current-time)) start-time) + (* org-drill-maximum-duration 60))) + (message "This drill session has reached its maximum duration.") + (return-from org-drill nil))))) + (message "Drill session finished!") + ))))) + (when end-pos + (switch-to-buffer (marker-buffer end-pos)) + (goto-char (marker-position end-pos)) + (message "Edit topic.")))) + + + +(provide 'org-drill) From 8e1287c389f2aedec220de72c9d79d4d8baab8b1 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 17 Aug 2010 12:43:56 +0200 Subject: [PATCH 015/348] ORGWEBPAGE: document that org-latest.* archives are updated each day. --- ORGWEBPAGE/index.org | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ORGWEBPAGE/index.org b/ORGWEBPAGE/index.org index aa8f276a0..559d7b553 100644 --- a/ORGWEBPAGE/index.org +++ b/ORGWEBPAGE/index.org @@ -152,7 +152,7 @@ the command line....): Some more information about this can be found in the [[http://orgmode.org/worg/org-faq.php][FAQ]], under [[http://orgmode.org/worg/org-faq.php#keeping-current-with-Org-mode-development][How do I keep current with Org mode development?]]. For people who cannot use -git, we provide [[file:org-latest.zip][zip]] or [[file:org-latest.tar.gz][tar.gz]] snapshot release files updated each hour +git, we provide [[file:org-latest.zip][zip]] or [[file:org-latest.tar.gz][tar.gz]] snapshot release files updated each day and corresponding to the latest git version. ** Alternative distributions From 7cc0612e62b8163e5ecf6a5209a6b01e78c72dee Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Tue, 17 Aug 2010 18:47:57 +0200 Subject: [PATCH 016/348] org-agenda-clock-out: remove unnecessary "P" in (interactive). --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index ad818358b..f07f0c5f6 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7140,7 +7140,7 @@ The cursor may be at a date in the calendar, or in the Org agenda." (defun org-agenda-clock-out () "Stop the currently running clock." - (interactive "P") + (interactive) (unless (marker-buffer org-clock-marker) (error "No running clock")) (let ((marker (make-marker)) newhead) From b05f8c91fed5d743adf5df787f2b28fb58274bf5 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Tue, 17 Aug 2010 17:01:37 -0400 Subject: [PATCH 017/348] babel: new function `org-babel-switch-to-session-with-code' * ob.el (org-babel-switch-to-session-with-code): new function to generate split frame displaying edit buffer and session. * ob-keys.el (org-babel-key-bindings): binding for `org-babel-switch-to-session-with-code' --- lisp/ob-keys.el | 2 +- lisp/ob.el | 17 +++++++++++++++++ 2 files changed, 18 insertions(+), 1 deletion(-) diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index e9ba3d903..d405e0228 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -74,7 +74,7 @@ functions which are assigned key bindings, and see ("\C-i" . org-babel-lob-ingest) ("i" . org-babel-lob-ingest) ("\C-z" . org-babel-switch-to-session) - ("z" . org-babel-switch-to-session) + ("z" . org-babel-switch-to-session-with-code) ("\C-a" . org-babel-sha1-hash) ("a" . org-babel-sha1-hash) ("h" . org-babel-describe-bindings)) diff --git a/lisp/ob.el b/lisp/ob.el index b5b9d8f7d..1375e029f 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -465,6 +465,23 @@ of the source block to the kill ring." (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) +;;;###autoload +(defun org-babel-switch-to-session-with-code (&optional arg info) + "Switch to code buffer and display session." + (interactive "P") + (flet ((swap-windows + () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (let ((info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code)) + (swap-windows))) + (defvar org-bracket-link-regexp) ;;;###autoload (defun org-babel-open-src-block-result (&optional re-run) From b61e0c4dfc1176d2745368e728f1cbf3e5cfede3 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Mon, 16 Aug 2010 20:55:24 -0400 Subject: [PATCH 018/348] Associate code edit buffer with babel comint session, if one exists. * org-src.el (org-edit-src-code): If at src block, store babel info as buffer local variable. (org-src-associate-babel-session): New function to associate code edit buffer with comint session. Does nothing unless a language-specific function named `org-babel-LANG-associate-session' exists. (org-src-babel-configure-edit-buffer): New function to be called in `org-src-mode-hook'. (org-src-mode-hook): add `org-src-babel-configure-edit-buffer' to hook. --- lisp/org-src.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/lisp/org-src.el b/lisp/org-src.el index baa2b11db..e029bf30d 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -203,6 +203,7 @@ the edited version. Optional argument CONTEXT is used by (col (current-column)) (case-fold-search t) (info (org-edit-src-find-region-and-lang)) + (babel-info (org-babel-get-src-block-info)) (org-mode-p (eq major-mode 'org-mode)) (beg (make-marker)) (end (make-marker)) @@ -272,6 +273,8 @@ the edited version. Optional argument CONTEXT is used by (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) (set (make-local-variable 'org-src-preserve-indentation) preserve-indentation) + (when babel-info + (set (make-local-variable 'org-src-babel-info) babel-info)) (when lfmt (set (make-local-variable 'org-coderef-label-format) lfmt)) (when org-mode-p @@ -654,6 +657,22 @@ the language, a switch telling if the content should be in a single line." (org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) + +(defun org-src-associate-babel-session (info) + "Associate edit buffer with comint session." + (interactive) + (let ((session (cdr (assoc :session (nth 2 info))))) + (and session (not (string= session "none")) + (org-babel-comint-buffer-livep session) + ((lambda (f) (and (fboundp f) (funcall f session))) + (intern (format "org-babel-%s-associate-session" (nth 0 info))))))) + +(defun org-src-babel-configure-edit-buffer () + (when org-src-babel-info + (org-src-associate-babel-session org-src-babel-info))) + +(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) + (provide 'org-src) ;; arch-tag: 6a1fc84f-dec7-47be-a416-64be56bea5d8 From a4c8bcd31b7dfae9e9922671ccee0ba7ddffd288 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Tue, 17 Aug 2010 16:44:28 -0400 Subject: [PATCH 019/348] babel: implement association of R code buffers with R session * ob-R.el (org-babel-R-associate-session): New function to associate R code edit buffers with ESS comint session. --- lisp/ob-R.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index e9633ae28..7d46437bb 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -168,6 +168,14 @@ This function is called by `org-babel-execute-src-block'." (buffer-name)))) (current-buffer)))))) +(defun org-babel-R-associate-session (session) + "Associate R code buffer with an R session. +Make SESSION be the inferior ESS process associated with the +current code buffer." + (setq ess-local-process-name + (process-name (get-buffer-process session))) + (ess-make-buffer-current)) + (defun org-babel-R-construct-graphics-device-call (out-file params) "Construct the call to the graphics device." (let ((devices From 441288ee72778931c3e1853b8221f7049289df91 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Tue, 17 Aug 2010 17:45:47 -0400 Subject: [PATCH 020/348] Make Org-babel commands available in code edit buffers * org-src.el (ob-keys): Require ob-keys, because `org-babel-map' is used. (org-src-do-at-code-block): New macro to evaluate lisp with point at the start of the Org code block containing the code in this edit buffer. (org-src-do-key-sequence-at-code-block): New function to execute command bound to key at the Org code block containing the code in this edit buffer. --- lisp/org-src.el | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/lisp/org-src.el b/lisp/org-src.el index e029bf30d..039681f9f 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -34,6 +34,7 @@ (require 'org-macs) (require 'org-compat) +(require 'ob-keys) (eval-when-compile (require 'cl)) @@ -165,6 +166,40 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) + +(defmacro org-src-do-at-code-block (&rest body) + "Execute a command from an edit buffer in the Org-mode buffer." + `(let ((beg-marker org-edit-src-beg-marker)) + (if beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char (marker-position beg-marker)) + ,@body)))) + +(defun org-src-do-key-sequence-at-code-block (&optional key) + "Execute key sequence at code block in the source Org buffer. +The command bound to KEY in the Org-babel key map is executed +remotely with point temporarily at the start of the code block in +the Org buffer. + +This command is not bound to a key by default, to avoid conflicts +with language major mode bindings. To bind it to C-c @ in all +language major modes, you could use + + (add-hook 'org-src-mode-hook + (lambda () (define-key org-src-mode-map \"\\C-c@\" + 'org-src-do-key-sequence-at-code-block))) + +In that case, for example, C-c @ t issued in code edit buffers +would tangle the current Org code block, C-c @ e would execute +the block and C-c @ h would display the other available +Org-babel commands." + (interactive "kOrg-babel key: ") + (if (equal key (kbd "C-g")) (keyboard-quit) + (org-edit-src-save) + (org-src-do-at-code-block + (call-interactively + (lookup-key org-babel-map key))))) + (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) (defvar org-edit-src-allow-write-back-p t) From f9cecd192dd231f163b7d99a1cf6f00d2567b09e Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Tue, 17 Aug 2010 16:46:51 -0400 Subject: [PATCH 021/348] Make language major mode commands available at Org code blocks. * ob.el (org-babel-do-in-edit-buffer): New macro to evaluate lisp in the language major mode edit buffer. (org-babel-do-key-sequence-in-edit-buffer): New function to call an arbitrary key sequence in the language major mode edit buffer * org-src.el (org-src-switch-to-buffer): Add new allowed value 'switch-invisibly for `org-src-window-setup'. * ob-keys.el (org-babel-key-bindings): Bind `org-babel-do-key-sequence-in-edit-buffer' to x and C-x in `org-babel-map' --- lisp/ob-keys.el | 4 +++- lisp/ob.el | 22 ++++++++++++++++++++++ lisp/org-src.el | 2 ++ 3 files changed, 27 insertions(+), 1 deletion(-) diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index d405e0228..5ed8967ac 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -77,7 +77,9 @@ functions which are assigned key bindings, and see ("z" . org-babel-switch-to-session-with-code) ("\C-a" . org-babel-sha1-hash) ("a" . org-babel-sha1-hash) - ("h" . org-babel-describe-bindings)) + ("h" . org-babel-describe-bindings) + ("\C-x" . org-babel-do-key-sequence-in-edit-buffer) + ("x" . org-babel-do-key-sequence-in-edit-buffer)) "Alist of key bindings and interactive Babel functions. This list associates interactive Babel functions with keys. Each element of this list will add an entry to the diff --git a/lisp/ob.el b/lisp/ob.el index 1375e029f..c1073449c 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -482,6 +482,28 @@ of the source block to the kill ring." (org-edit-src-code)) (swap-windows))) +(defmacro org-babel-do-in-edit-buffer (&rest body) + "Evaluate BODY in edit buffer if there is a code block at point. +Return t if a code block was found at point, nil otherwise." + `(let ((org-src-window-setup 'switch-invisibly)) + (when (org-edit-src-code) + ,@body + (org-edit-src-exit) t))) + +(defun org-babel-do-key-sequence-in-edit-buffer (key) + "Read key sequence and execute the command in edit buffer. +Enter a key sequence to be executed in the language major-mode +edit buffer. For example, TAB will alter the contents of the +Org-mode code block according to the effect of TAB in the +language major-mode buffer. For languages that support +interactive sessions, this can be used to send code from the Org +buffer to the session for evaluation using the native major-mode +evaluation mechanisms." + (interactive "kEnter key-sequence to execute in edit buffer: ") + (org-babel-do-in-edit-buffer + (call-interactively + (key-binding (or key (read-key-sequence nil)))))) + (defvar org-bracket-link-regexp) ;;;###autoload (defun org-babel-open-src-block-result (&optional re-run) diff --git a/lisp/org-src.el b/lisp/org-src.el index 039681f9f..22c9952ec 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -359,6 +359,8 @@ the edited version. Optional argument CONTEXT is used by (if (eq context 'edit) (delete-other-windows)) (org-switch-to-buffer-other-window buffer) (if (eq context 'exit) (delete-other-windows))) + ('switch-invisibly + (set-buffer buffer)) (t (message "Invalid value %s for org-src-window-setup" (symbol-name org-src-window-setup)) From 76790e1aa807bc7d13af17db696ffa11ce764602 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Tue, 17 Aug 2010 22:37:19 -0400 Subject: [PATCH 022/348] Get rid of some compiler warnings. * org-src.el (ob-comint): require 'ob-comint (org-src-babel-info): define variable Also, reposition `org-src-do-at-code-block' and `org-src-do-key-sequence-at-code-block' function definitions within the file. --- lisp/org-src.el | 69 ++++++++++++++++++++++++++----------------------- 1 file changed, 36 insertions(+), 33 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 22c9952ec..3635bf74c 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -35,6 +35,7 @@ (require 'org-macs) (require 'org-compat) (require 'ob-keys) +(require 'ob-comint) (eval-when-compile (require 'cl)) @@ -167,39 +168,6 @@ For example, there is no ocaml-mode in Emacs, but the mode to use is (defvar org-src-mode-map (make-sparse-keymap)) (define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) -(defmacro org-src-do-at-code-block (&rest body) - "Execute a command from an edit buffer in the Org-mode buffer." - `(let ((beg-marker org-edit-src-beg-marker)) - (if beg-marker - (with-current-buffer (marker-buffer beg-marker) - (goto-char (marker-position beg-marker)) - ,@body)))) - -(defun org-src-do-key-sequence-at-code-block (&optional key) - "Execute key sequence at code block in the source Org buffer. -The command bound to KEY in the Org-babel key map is executed -remotely with point temporarily at the start of the code block in -the Org buffer. - -This command is not bound to a key by default, to avoid conflicts -with language major mode bindings. To bind it to C-c @ in all -language major modes, you could use - - (add-hook 'org-src-mode-hook - (lambda () (define-key org-src-mode-map \"\\C-c@\" - 'org-src-do-key-sequence-at-code-block))) - -In that case, for example, C-c @ t issued in code edit buffers -would tangle the current Org code block, C-c @ e would execute -the block and C-c @ h would display the other available -Org-babel commands." - (interactive "kOrg-babel key: ") - (if (equal key (kbd "C-g")) (keyboard-quit) - (org-edit-src-save) - (org-src-do-at-code-block - (call-interactively - (lookup-key org-babel-map key))))) - (defvar org-edit-src-force-single-line nil) (defvar org-edit-src-from-org-mode nil) (defvar org-edit-src-allow-write-back-p t) @@ -216,6 +184,8 @@ Org-babel commands." immediately; otherwise it will ask whether you want to return to the existing edit buffer.") +(defvar org-src-babel-info nil) + (define-minor-mode org-src-mode "Minor mode for language major mode buffers generated by org. This minor mode is turned on in two situations: @@ -709,6 +679,39 @@ the language, a switch telling if the content should be in a single line." (org-src-associate-babel-session org-src-babel-info))) (org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) +(defmacro org-src-do-at-code-block (&rest body) + "Execute a command from an edit buffer in the Org-mode buffer." + `(let ((beg-marker org-edit-src-beg-marker)) + (if beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char (marker-position beg-marker)) + ,@body)))) + +(defun org-src-do-key-sequence-at-code-block (&optional key) + "Execute key sequence at code block in the source Org buffer. +The command bound to KEY in the Org-babel key map is executed +remotely with point temporarily at the start of the code block in +the Org buffer. + +This command is not bound to a key by default, to avoid conflicts +with language major mode bindings. To bind it to C-c @ in all +language major modes, you could use + + (add-hook 'org-src-mode-hook + (lambda () (define-key org-src-mode-map \"\\C-c@\" + 'org-src-do-key-sequence-at-code-block))) + +In that case, for example, C-c @ t issued in code edit buffers +would tangle the current Org code block, C-c @ e would execute +the block and C-c @ h would display the other available +Org-babel commands." + (interactive "kOrg-babel key: ") + (if (equal key (kbd "C-g")) (keyboard-quit) + (org-edit-src-save) + (org-src-do-at-code-block + (call-interactively + (lookup-key org-babel-map key))))) + (provide 'org-src) From 4ac8294020951bbd60a17fcca5035a0da4276b20 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Tue, 17 Aug 2010 23:40:53 -0400 Subject: [PATCH 023/348] Avoid error and unnecessary message in transient use of code edit buffer * ob.el (org-babel-do-in-edit-buffer): Suppress message and check that org-src buffer is current before attempting exit * org-src.el (org-edit-src-code): New argument quietlyp allows message to be suppressed --- lisp/ob.el | 6 ++++-- lisp/org-src.el | 4 ++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index c1073449c..f95946949 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -486,9 +486,11 @@ of the source block to the kill ring." "Evaluate BODY in edit buffer if there is a code block at point. Return t if a code block was found at point, nil otherwise." `(let ((org-src-window-setup 'switch-invisibly)) - (when (org-edit-src-code) + (when (org-edit-src-code nil nil nil 'quietly) ,@body - (org-edit-src-exit) t))) + (if (org-bound-and-true-p org-edit-src-from-org-mode) + (org-edit-src-exit)) + t))) (defun org-babel-do-key-sequence-in-edit-buffer (key) "Read key sequence and execute the command in edit buffer. diff --git a/lisp/org-src.el b/lisp/org-src.el index 3635bf74c..7ed7606df 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -194,7 +194,7 @@ This minor mode is turned on in two situations: There is a mode hook, and keybindings for `org-edit-src-exit' and `org-edit-src-save'") -(defun org-edit-src-code (&optional context code edit-buffer-name) +(defun org-edit-src-code (&optional context code edit-buffer-name quietp) "Edit the source code example at point. The example is copied to a separate buffer, and that buffer is switched to the correct language mode. When done, exit with \\[org-edit-src-exit]. @@ -298,7 +298,7 @@ the edited version. Optional argument CONTEXT is used by (set-buffer-modified-p nil) (and org-edit-src-persistent-message (org-set-local 'header-line-format msg))) - (message "%s" msg) + (unless quietp (message "%s" msg)) t))) (defun org-edit-src-continue (e) From ce58d6dd0ae0f58c61731f00d6e60891bd757bb3 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Wed, 18 Aug 2010 08:35:15 +0200 Subject: [PATCH 024/348] Align table before converting it to a table.el table * lisp/org-table.el (org-table-create-with-table.el): Align table before converting. --- lisp/org-table.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index 6172e1cbd..a6f7ac447 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -369,8 +369,9 @@ and table.el tables." (if (y-or-n-p "Convert table to Org-mode table? ") (org-table-convert))) ((org-at-table-p) - (if (y-or-n-p "Convert table to table.el table? ") - (org-table-convert))) + (when (y-or-n-p "Convert table to table.el table? ") + (org-table-align) + (org-table-convert))) (t (call-interactively 'table-insert)))) (defun org-table-create-or-convert-from-region (arg) From fbc0ce10debbe305088ae7e78ba8ad633d07a2b5 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Wed, 18 Aug 2010 08:41:29 +0200 Subject: [PATCH 025/348] Keep compiler happy --- lisp/org.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org.el b/lisp/org.el index 67c5b3cd0..744fca4b4 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12766,6 +12766,7 @@ If DATA is nil or the empty string, any tags will be removed." (org-set-tags t) (message "No headings")))) +(defvar org-indent-indentation-per-level) (defun org-set-tags (&optional arg just-align) "Set the tags for the current headline. With prefix ARG, realign all tags in headings in the current buffer." From ed62a85bf7714c9a2310b61412edecb36ad8fd56 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Wed, 18 Aug 2010 13:55:28 -0400 Subject: [PATCH 026/348] babel: Throw error on `org-babel-switch-to-session' when :session not in effect * ob.el (org-babel-switch-to-session): Throw error if block if :session not in effect for the block --- lisp/ob.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/ob.el b/lisp/ob.el index f95946949..cc4c732ce 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -450,6 +450,8 @@ of the source block to the kill ring." (or (and dir (file-name-as-directory dir)) default-directory)) (cmd (intern (format "org-babel-%s-initiate-session" lang))) (cmd2 (intern (concat "org-babel-prep-session:" lang)))) + (if (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) (unless (fboundp cmd) (error "No org-babel-initiate-session function for %s!" lang)) ;; copy body to the kill ring From 7cbc7a67d4f7a08d901b612ff0b46aca6f4f8858 Mon Sep 17 00:00:00 2001 From: David Maus Date: Wed, 18 Aug 2010 20:44:57 +0200 Subject: [PATCH 027/348] org-feed: Use `xml-substitute-special' for unescaping XML entities. * org-feed.el (xml-substitute-special): Declare function for byte compiler. (org-feed-unescape): Removed. (org-feed-parse-rss-entry, org-feed-parse-atom-entry): Use `xml-substitute-special' to unescape XML entities. TINYCHANGE Patch by Michael Brand --- lisp/org-feed.el | 22 ++++++---------------- 1 file changed, 6 insertions(+), 16 deletions(-) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index 073d3449b..f50678b41 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -99,7 +99,7 @@ (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) (declare-function xml-get-attribute-or-nil "xml" (node attribute)) -(defvar xml-entity-alist) +(declare-function xml-substitute-special "xml" (string)) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." @@ -269,17 +269,6 @@ have been saved." (defvar org-feed-buffer "*Org feed*" "The buffer used to retrieve a feed.") -(defun org-feed-unescape (s) - "Unescape protected entities in S." - (require 'xml) - (let ((re (concat "&\\(" - (mapconcat 'car xml-entity-alist "\\|") - "\\);"))) - (while (string-match re s) - (setq s (replace-match - (cdr (assoc (match-string 1 s) xml-entity-alist)) nil nil s))) - s)) - ;;;###autoload (defun org-feed-update-all () "Get inbox items from all feeds in `org-feed-alist'." @@ -613,6 +602,7 @@ containing the properties `:guid' and `:item-full-text'." (defun org-feed-parse-rss-entry (entry) "Parse the `:item-full-text' field for xml tags and create new properties." + (require 'xml) (with-temp-buffer (insert (plist-get entry :item-full-text)) (goto-char (point-min)) @@ -620,7 +610,7 @@ containing the properties `:guid' and `:item-full-text'." nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) - (org-feed-unescape (match-string 2))))) + (xml-substitute-special (match-string 2))))) (goto-char (point-min)) (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) (setq entry (plist-put entry :guid-permalink t)))) @@ -654,7 +644,7 @@ formatted as a string, not the original XML data." 'href))) ;; Add as :title. (setq entry (plist-put entry :title - (org-feed-unescape + (xml-substitute-special (car (xml-node-children (car (xml-get-children xml 'title))))))) (let* ((content (car (xml-get-children xml 'content))) @@ -664,12 +654,12 @@ formatted as a string, not the original XML data." ((string= type "text") ;; We like plain text. (setq entry (plist-put entry :description - (org-feed-unescape + (xml-substitute-special (car (xml-node-children content)))))) ((string= type "html") ;; TODO: convert HTML to Org markup. (setq entry (plist-put entry :description - (org-feed-unescape + (xml-substitute-special (car (xml-node-children content)))))) ((string= type "xhtml") ;; TODO: convert XHTML to Org markup. From d6868e1602d5690cae598c188be63b1916beb21d Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Fri, 13 Aug 2010 20:59:19 +0000 Subject: [PATCH 028/348] Decode entry according to its character encoding * org-feed.el (org-feed-format-entry): Decode entry according to its character encoding. Feed entries may contain raw unicode characters that must be converted to utf-8 before they can be properly inserted in the target buffer. --- lisp/org-feed.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index f50678b41..0bab6390d 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -542,7 +542,8 @@ If that property is already present, nothing changes." (setq tmp (org-feed-make-indented-block tmp (org-get-indentation)))))) (replace-match tmp t t)))) - (buffer-string))))) + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) (defun org-feed-make-indented-block (s n) "Add indentation of N spaces to a multiline string S." From ad7d9c43c821ef19839442fa543cc1ccef7a3689 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 18 Aug 2010 14:00:18 -0400 Subject: [PATCH 029/348] babel: Fix prefix version of `org-babel-switch-to-session' * ob.el (org-babel-switch-to-session): Supply missing "P" argument to (interactive) --- lisp/ob.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index cc4c732ce..596c859f2 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -439,7 +439,7 @@ session." If called with a prefix argument then evaluate the header arguments for the source block before entering the session. Copy the body of the source block to the kill ring." - (interactive) + (interactive "P") (let* ((info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) (body (nth 1 info)) From 23ab61d93c1c1fd99851c9a3438cdf0064f7e886 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 18 Aug 2010 14:07:13 -0400 Subject: [PATCH 030/348] babel: refactor `org-babel-switch-to-session' * ob.el (org-babel-initiate-session): new function derived from previous `org-babel-switch-to-session' (org-babel-switch-to-session): refactored to use new `org-babel-initiate-session' This breaks the original `org-babel-switch-to-session' into a new function `org-babel-initiate-session' and `org-babel-switch-to-session'. --- lisp/ob.el | 31 +++++++++++++++++++------------ 1 file changed, 19 insertions(+), 12 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 596c859f2..8557f094c 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -434,11 +434,11 @@ session." (end-of-line 1))) ;;;###autoload -(defun org-babel-switch-to-session (&optional arg info) - "Switch to the session of the current source-code block. +(defun org-babel-initiate-session (&optional arg info) + "Initiate session for current code block. If called with a prefix argument then evaluate the header arguments -for the source block before entering the session. Copy the body -of the source block to the kill ring." +for the code block before entering the session. Copy the body +of the code block to the kill ring." (interactive "P") (let* ((info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) @@ -454,16 +454,23 @@ of the source block to the kill ring." (error "This block is not using a session!")) (unless (fboundp cmd) (error "No org-babel-initiate-session function for %s!" lang)) - ;; copy body to the kill ring (with-temp-buffer (insert (org-babel-trim body)) (copy-region-as-kill (point-min) (point-max))) - ;; if called with a prefix argument, then process header arguments - (unless (fboundp cmd2) - (error "No org-babel-prep-session function for %s!" lang)) - (when arg (funcall cmd2 session params)) - ;; just to the session using pop-to-buffer - (pop-to-buffer (funcall cmd session params)) - (end-of-line 1))) + (when arg + (unless (fboundp cmd2) + (error "No org-babel-prep-session function for %s!" lang)) + (funcall cmd2 session params)) + (funcall cmd session params))) + +;;;###autoload +(defun org-babel-switch-to-session (&optional arg info) + "Switch to the session of the current code block. +Uses `org-babel-initiate-session' to start the session. If called +with a prefix argument then this is passed on to +`org-babel-initiate-session'." + (interactive "P") + (pop-to-buffer (org-babel-initiate-session arg info)) + (end-of-line 1)) (defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) From bf64d25744ae4cf9d755e016e063144ebb837ab9 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 18 Aug 2010 20:20:54 -0400 Subject: [PATCH 031/348] babel: R: Refactor evaluation code * ob-R.el (org-babel-R-evaluate): Break the two branches into two separate functions (org-babel-R-evaluate-external-process): New function to handle external process evaluation (org-babel-R-evaluate-session): New function to handle session evaluation --- lisp/ob-R.el | 127 ++++++++++++++++++++++++++++----------------------- 1 file changed, 70 insertions(+), 57 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 7d46437bb..2a114214b 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -219,63 +219,76 @@ write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names (defun org-babel-R-evaluate (session body result-type column-names-p row-names-p) - "Pass BODY to the R process in SESSION. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY, as elisp." - (if (not session) - ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-R-command body)) - (value - (let ((tmp-file (make-temp-file "org-babel-R-results-"))) - (org-babel-eval org-babel-R-command - (format org-babel-R-wrapper-method - body tmp-file - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE"))) - (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p)))) - ;; comint session evaluation - (case result-type - (value - (let ((tmp-file (make-temp-file "org-babel-R")) - broke) - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat - #'org-babel-chomp - (list - body - (format org-babel-R-wrapper-lastvar - tmp-file - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE")) - org-babel-R-eoe-indicator) "\n")) - (inferior-ess-send-input)) - (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) - (output - (mapconcat - #'org-babel-chomp - (butlast - (delq nil - (mapcar - (lambda (line) ;; cleanup extra prompts left in output - (if (string-match - "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) - (substring line (match-end 1)) - line)) - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat #'org-babel-chomp - (list body org-babel-R-eoe-indicator) - "\n")) - (inferior-ess-send-input)))) 2) "\n"))))) + "Evaluate R code in BODY." + (if session + (org-babel-R-evaluate-session + session body result-type column-names-p row-names-p) + (org-babel-R-evaluate-external-process + body result-type column-names-p row-names-p))) + +(defun org-babel-R-evaluate-external-process + (body result-type column-names-p row-names-p) + "Evaluate BODY in external R process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (let ((tmp-file (make-temp-file "org-babel-R-results-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-wrapper-method + body tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE"))) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) + (output (org-babel-eval org-babel-R-command body)))) + +(defun org-babel-R-evaluate-session + (session body result-type column-names-p row-names-p) + "Evaluate BODY in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (let ((tmp-file (make-temp-file "org-babel-R")) + broke) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat + #'org-babel-chomp + (list + body + (format org-babel-R-wrapper-lastvar + tmp-file + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE")) + org-babel-R-eoe-indicator) "\n")) + (inferior-ess-send-input)) + (org-babel-R-process-value-result + (org-babel-import-elisp-from-file + (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + (lambda (line) ;; cleanup extra prompts left in output + (if (string-match + "^\\([ ]*[>+][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + (substring line (match-end 1)) + line)) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))) 2) "\n")))) (defun org-babel-R-process-value-result (result column-names-p) "R-specific processing of return value. From c11106a3e5516eebd753f1dc507fe5d3f566d4ac Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Thu, 19 Aug 2010 09:30:40 -0400 Subject: [PATCH 032/348] babel: Fix bug in export of #+lob/#+call lines * ob-exp.el (org-babel-exp-lob-one-liners): Get parameter values from all standard sources when executing #+lob/#+call lines --- lisp/ob-exp.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index 796812c63..a7117e0e8 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -178,6 +178,8 @@ options are taken from `org-babel-default-header-args'." (list "emacs-lisp" "results" (org-babel-merge-params org-babel-default-header-args + (org-babel-params-from-buffer) + (org-babel-params-from-properties) (org-babel-parse-header-arguments (org-babel-clean-text-properties (concat ":var results=" From 7befdf8a00081290ffaee179dbea538a2b5eaea8 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Thu, 19 Aug 2010 09:31:19 -0400 Subject: [PATCH 033/348] babel: edit docstring * ob-lob.el (org-babel-lob-get-info): Edit docstring --- lisp/ob-lob.el | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/lisp/ob-lob.el b/lisp/ob-lob.el index 8c207f79c..33a698933 100644 --- a/lisp/ob-lob.el +++ b/lisp/ob-lob.el @@ -79,14 +79,7 @@ if so then run the appropriate source block from the Library." ;;;###autoload (defun org-babel-lob-get-info () - "Return a Library of Babel function call as a string. - -This function is analogous to org-babel-get-src-block-name. For -both functions, after they are called, (match-string 1) matches -the function name, and (match-string 2) matches the function -arguments inside the parentheses. I think perhaps these functions -should be renamed to bring out this similarity, perhaps involving -the word 'call'." + "Return a Library of Babel function call as a string." (let ((case-fold-search t)) (save-excursion (beginning-of-line 1) From cc5b21e2cb84a52111884a2174113e1fbdcf4804 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Thu, 12 Aug 2010 21:31:09 +0000 Subject: [PATCH 034/348] Rename temporary buffer to remove dependency of `flet' macro * org-agenda.el (org-write-agenda): Rename temporary buffer to remove dependency of `flet' macro. --- lisp/org-agenda.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index f07f0c5f6..15024e835 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2507,12 +2507,14 @@ higher priority settings." ((string-match "\\.html?\\'" file) (require 'htmlize)) ((string-match "\\.ps\\'" file) (require 'ps-print))) (org-let (if nosettings nil org-agenda-exporter-settings) - `(save-excursion + '(save-excursion (save-window-excursion (org-agenda-mark-filtered-text) (let ((bs (copy-sequence (buffer-string))) beg) (org-agenda-unmark-filtered-text) (with-temp-buffer + (rename-buffer "Agenda View" t) + (set-buffer-modified-p nil) (insert bs) (org-agenda-remove-marked-text 'org-filtered) (while (setq beg (text-property-any (point-min) (point-max) @@ -2539,14 +2541,12 @@ higher priority settings." (message "HTML written to %s" file)) ((string-match "\\.ps\\'" file) (require 'ps-print) - ,(flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces file)) + (ps-print-buffer-with-faces file) (message "Postscript written to %s" file)) ((string-match "\\.pdf\\'" file) (require 'ps-print) - ,(flet ((ps-get-buffer-name () "Agenda View")) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps"))) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps")) (call-process "ps2pdf" nil nil nil (expand-file-name (concat (file-name-sans-extension file) ".ps")) From 768d88acc3d1572ffcb3e879d7e65c763af573b9 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Thu, 19 Aug 2010 21:52:18 +0200 Subject: [PATCH 035/348] Move require statements to proper place in evaluated lisp expression * org-agenda.el (org-write-agenda): Move require statements to proper place in evaluated lisp expression. --- lisp/org-agenda.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 15024e835..7d37187cf 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2503,9 +2503,6 @@ higher priority settings." (interactive "FWrite agenda to file: \nP") (if (not (file-writable-p file)) (error "Cannot write agenda to file %s" file)) - (cond - ((string-match "\\.html?\\'" file) (require 'htmlize)) - ((string-match "\\.ps\\'" file) (require 'ps-print))) (org-let (if nosettings nil org-agenda-exporter-settings) '(save-excursion (save-window-excursion @@ -2527,6 +2524,7 @@ higher priority settings." ((org-bound-and-true-p org-mobile-creating-agendas) (org-mobile-write-agenda-for-mobile file)) ((string-match "\\.html?\\'" file) + (require 'htmlize) (set-buffer (htmlize-buffer (current-buffer))) (when (and org-agenda-export-html-style From 6d9fcf8ff43be2fc83edc077227eef0ce72172f7 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Thu, 19 Aug 2010 21:54:12 +0200 Subject: [PATCH 036/348] Delete postscript file after creating conversion to pdf * org-agenda.el (org-write-agenda): Delete postscript file after creating conversion to pdf. --- lisp/org-agenda.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 7d37187cf..90c0fe100 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2549,6 +2549,7 @@ higher priority settings." (expand-file-name (concat (file-name-sans-extension file) ".ps")) (expand-file-name file)) + (delete-file (concat (file-name-sans-extension file) ".ps")) (message "PDF written to %s" file)) ((string-match "\\.ics\\'" file) (require 'org-icalendar) From 034dbac3eecdd67c83407f55cd920d3720400055 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Thu, 19 Aug 2010 23:17:24 +0200 Subject: [PATCH 037/348] Search for LaTeX setup case-insensitively * lisp/org-latex.el (org-export-latex-set-initial-vars): Bind `case-fold-search' to t around the search for special LaTeX setup. * lisp/org-beamer.el (org-beamer-after-initial-vars): Bind `case-fold-search' to t around the search for special BEAMER setup. --- lisp/org-beamer.el | 8 +++++--- lisp/org-latex.el | 10 +++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/lisp/org-beamer.el b/lisp/org-beamer.el index 2631e7065..ea3a3f9ce 100644 --- a/lisp/org-beamer.el +++ b/lisp/org-beamer.el @@ -438,8 +438,10 @@ The effect is that these values will be accessible during export." (save-restriction (widen) (goto-char (point-min)) - (and (re-search-forward - "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t) + (and (let ((case-fold-search t)) + (re-search-forward + "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" + nil t)) (match-string 1)))) (plist-get org-export-latex-options-plist :beamer-frame-level) org-beamer-frame-level)) @@ -461,7 +463,7 @@ The effect is that these values will be accessible during export." (save-excursion (save-restriction (widen) - (let ((txt "")) + (let ((txt "") (case-fold-search t)) (goto-char (point-min)) (while (re-search-forward "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$" diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 4f27f425a..b58766689 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -1124,7 +1124,9 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t) + (and (let ((case-fold-search t)) + (re-search-forward + "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t)) (match-string 1)))) (plist-get org-export-latex-options-plist :latex-class) org-export-latex-default-class) @@ -1138,8 +1140,10 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1)))) + (and (let ((case-fold-search t)) + (re-search-forward + "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) + (match-string 1))))) (plist-get org-export-latex-options-plist :latex-class-options)) org-export-latex-class (or (car (assoc org-export-latex-class org-export-latex-classes)) From 6f61135c84e8ee0934db4aca66c01b4be5d250cd Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 08:32:01 +0200 Subject: [PATCH 038/348] New macro * lisp/org-agenda.el (org-agenda-with-point-at-orig-entry): New macro. --- lisp/org-agenda.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 90c0fe100..117b0bbf1 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -1488,6 +1488,18 @@ the lower-case version of all tags." (require 'cl)) (require 'org) +(defmacro org-agenda-with-point-at-orig-entry (string &rest body) + "Execute BODY with point at location given by `org-hd-marker' property. +If STRING is non-nil, the text property will be fetched from position 0 +in that string. If STRING is nil, it will be fetched from the beginning +of the current line." + `(let ((marker (get-text-property (if string 0 (point-at-bol)) + 'org-hd-marker string))) + (with-current-buffer (marker-buffer marker) + (save-excursion + (goto-char marker) + ,@body)))) + (defun org-add-agenda-custom-command (entry) "Replace or add a command in `org-agenda-custom-commands'. This is mostly for hacking and trying a new command - once the command From 294d3985441736565ad0e295f28282e5bf4f330e Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 08:39:55 +0200 Subject: [PATCH 039/348] Remove impact of case-fold-search on LaTeX class setup * lisp/org-exp.el (org-infile-export-plist): Bind case-fold-search to t. --- lisp/org-exp.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index b4f6ab900..220e57c9a 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -695,6 +695,7 @@ modified) list.") "EXPORT_SELECT_TAGS" "EXPORT_EXCLUDE_TAGS" "KEYWORDS" "DESCRIPTION" "MACRO" "BIND" "XSLT") (mapcar 'car org-export-inbuffer-options-extra)))) + (case-fold-search t) p key val text options mathjax a pr style latex-header latex-class macros letbind ext-setup-or-nil setup-contents (start 0)) From 19b0e03f32c6032a60150fc6cb07c6f766cb3f6c Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 09:26:08 +0200 Subject: [PATCH 040/348] Make backslash escape "-" in property matches * lisp/org.el (org-make-tags-matcher): Read "\\-" as "-" in the tags/property matcher. Ilya Shlyakhter writes: > When doing an agenda tags match for tags or properties with dashes in > their name, the dashes become negation operators: "my-prop>0" means > "entries that have the tag 'my' and do not have a positive property > 'prop'", rather than "entries that have a positive property > 'my-prop'". Is there a way to escape the dashes to get the latter > meaning? --- lisp/org.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 744fca4b4..3102d629a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12432,7 +12432,7 @@ also TODO lines." ;; Parse the string and create a lisp form (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\([[:alnum:]_]+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) + (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p @@ -12460,7 +12460,9 @@ also TODO lines." (setq rest (substring term (match-end 0)) minus (and (match-end 1) (equal (match-string 1 term) "-")) - tag (match-string 2 term) + tag (save-match-data (replace-regexp-in-string + "\\\\-" "-" + (match-string 2 term))) re-p (equal (string-to-char tag) ?{) level-p (match-end 4) prop-p (match-end 5) From bf0d8c5a0e54318c1edafc7296cec31e861fe051 Mon Sep 17 00:00:00 2001 From: Magnus Henoch <magnus.henoch@gmail.com> Date: Thu, 19 Aug 2010 13:32:42 +0000 Subject: [PATCH 041/348] org-capture + autoload Jambunathan K <kjambunathan@gmail.com> writes: > It would be convenient if I could do a > > M-x customize-group org-capture and/or > M-x customize-variable org-capture-templates > > without having triggered a prior org-capture. > > For now, I trigger a capture, abort it and then proceed ahead with > customizing these. Here is a patch that adds an "autoload cookie" for org-capture-templates. After recompiling, org-install.el should contain an autoload declaration for org-capture-templates. Let's see if the patch tracker likes me :) Magnus --- lisp/org-capture.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index c0e41f3d2..e5449642c 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -76,6 +76,7 @@ :tag "Org Capture" :group 'org) +;;;###autoload (defcustom org-capture-templates nil "Templates for the creation of new entries. From 838cb818debf22ec0f1f9544cd5aa33582a6c154 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 13:01:10 +0200 Subject: [PATCH 042/348] Show command names in manual MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit First batch, largely from Andreas Rhler --- doc/org.texi | 148 +++++++++++++++++++++++---------------------------- 1 file changed, 68 insertions(+), 80 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 16241112a..fea733fab 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -22,6 +22,24 @@ @finalout @c Macro definitions +@macro orgcmd{key,command} +@iftex +@kindex \key\ +@findex \command\ +@item @kbd{\key\} @hskip 0pt plus 1filll @code{\command\} +@end iftex +@ifnottex +@kindex \key\ +@findex \command\ +@item @kbd{\key\} @tie{}@tie{}@tie{}@tie{}(@code{\command\}) +@end ifnottex +@end macro + +@macro orgkey{key} +@kindex \key\ +@item @kbd{\key\} +@end macro + @iftex @c @hyphenation{time-stamp time-stamps time-stamp-ing time-stamp-ed} @end iftex @@ -121,6 +139,7 @@ with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, * History and Acknowledgments:: How Org came into being * Main Index:: An index of Org's concepts and features * Key Index:: Key bindings and where they are described +* Command and Function Index:: Command names and some internal functions * Variable Index:: Variables mentioned in the manual @detailmenu @@ -463,7 +482,7 @@ Specific header arguments Miscellaneous * Completion:: M-TAB knows what you need -* Easy Templates:: +* Easy Templates:: Quick insertion of structural elements * Speed keys:: Electric commands at the beginning of a headline * Code evaluation security:: Org mode files evaluate inline code * Customization:: Adapting Org to your taste @@ -898,9 +917,8 @@ Org uses just two commands, bound to @key{TAB} and @cindex folded, subtree visibility state @cindex children, subtree visibility state @cindex subtree, subtree visibility state -@table @kbd -@kindex @key{TAB} -@item @key{TAB} +@table @asis +@orgcmd{@key{TAB},org-cycle} @emph{Subtree cycling}: Rotate current subtree among the states @example @@ -922,8 +940,7 @@ argument (@kbd{C-u @key{TAB}}), global cycling is invoked. @cindex overview, global visibility state @cindex contents, global visibility state @cindex show all, global visibility state -@kindex S-@key{TAB} -@item S-@key{TAB} +@orgcmd{S-@key{TAB},org-global-cycle} @itemx C-u @key{TAB} @emph{Global cycling}: Rotate the entire buffer among the states @@ -937,22 +954,18 @@ CONTENTS view up to headlines of level N will be shown. Note that inside tables, @kbd{S-@key{TAB}} jumps to the previous field. @cindex show all, command -@kindex C-u C-u C-u @key{TAB} -@item C-u C-u C-u @key{TAB} +@orgcmd{C-u C-u C-u @key{TAB},show-all} Show all, including drawers. -@kindex C-c C-r -@item C-c C-r +@orgcmd{C-c C-r,org-reveal} Reveal context around point, showing the current entry, the following heading and the hierarchy above. Useful for working near a location that has been exposed by a sparse tree command (@pxref{Sparse trees}) or an agenda command (@pxref{Agenda commands}). With a prefix argument show, on each level, all sibling headings. With double prefix arg, also show the entire subtree of the parent. -@kindex C-c C-k -@item C-c C-k +@orgcmd{C-c C-k,show-branches} Expose all the headings of the subtree, CONTENT view for just one subtree. -@kindex C-c C-x b -@item C-c C-x b +@orgcmd{C-c C-x b,org-tree-to-indirect-buffer} Show the current subtree in an indirect buffer@footnote{The indirect buffer @ifinfo @@ -994,9 +1007,8 @@ Furthermore, any entries with a @samp{VISIBILITY} property (@pxref{Properties and Columns}) will get their visibility adapted accordingly. Allowed values for this property are @code{folded}, @code{children}, @code{content}, and @code{all}. -@table @kbd -@kindex C-u C-u @key{TAB} -@item C-u C-u @key{TAB} +@table @asis +@orgcmd{C-u C-u @key{TAB},org-set-startup-visibility} Switch back to the startup visibility of the buffer, i.e. whatever is requested by startup options and @samp{VISIBILITY} properties in individual entries. @@ -1009,24 +1021,18 @@ entries. @cindex headline navigation The following commands jump to other headlines in the buffer. -@table @kbd -@kindex C-c C-n -@item C-c C-n +@table @asis +@orgcmd{C-c C-n,outline-next-visible-heading} Next heading. -@kindex C-c C-p -@item C-c C-p +@orgcmd{C-c C-p,outline-previous-visible-heading} Previous heading. -@kindex C-c C-f -@item C-c C-f +@orgcmd{C-c C-f,org-forward-same-level} Next heading same level. -@kindex C-c C-b -@item C-c C-b +@orgcmd{C-c C-b,org-backward-same-level} Previous heading same level. -@kindex C-c C-u -@item C-c C-u +@orgcmd{C-c C-u,outline-up-heading} Backward to higher level heading. -@kindex C-c C-j -@item C-c C-j +@orgcmd{C-c C-j,org-goto} Jump to a different place without changing the current outline visibility. Shows the document structure in a temporary buffer, where you can use the following keys to find your destination: @@ -1061,9 +1067,8 @@ See also the variable @code{org-goto-interface}. @cindex sorting, of subtrees @cindex subtrees, cut and paste -@table @kbd -@kindex M-@key{RET} -@item M-@key{RET} +@table @asis +@orgcmd{M-@key{RET},org-insert-heading} @vindex org-M-RET-may-split-line Insert new heading with same level as current. If the cursor is in a plain list item, a new item is created (@pxref{Plain lists}). To force @@ -1093,47 +1098,36 @@ variable @code{org-treat-insert-todo-heading-as-state-change}. Insert new TODO entry with same level as current heading. Like @kbd{C-@key{RET}}, the new headline will be inserted after the current subtree. -@kindex @key{TAB} -@item @key{TAB} @r{in new, empty entry} +@orgcmd{@key{TAB},org-cycle} In a new entry with no text yet, the first @key{TAB} demotes the entry to become a child of the previous one. The next @key{TAB} makes it a parent, and so on, all the way to top level. Yet another @key{TAB}, and you are back to the initial level. -@kindex M-@key{left} -@item M-@key{left} +@orgcmd{M-@key{left},org-do-promote} Promote current heading by one level. -@kindex M-@key{right} -@item M-@key{right} +@orgcmd{M-@key{right},org-do-demote} Demote current heading by one level. -@kindex M-S-@key{left} -@item M-S-@key{left} +@orgcmd{M-S-@key{left},org-promote-subtree} Promote the current subtree by one level. -@kindex M-S-@key{right} -@item M-S-@key{right} +@orgcmd{M-S-@key{right},org-demote-subtree} Demote the current subtree by one level. -@kindex M-S-@key{up} -@item M-S-@key{up} +@orgcmd{M-S-@key{up},org-move-subtree-up} Move subtree up (swap with previous subtree of same level). -@kindex M-S-@key{down} -@item M-S-@key{down} +@orgcmd{M-S-@key{down},org-move-subtree-down} Move subtree down (swap with next subtree of same level). -@kindex C-c C-x C-w -@item C-c C-x C-w +@orgcmd{C-c C-x C-w,org-cut-subtree} Kill subtree, i.e. remove it from buffer but save in kill ring. With a numeric prefix argument N, kill N sequential subtrees. -@kindex C-c C-x M-w -@item C-c C-x M-w +@orgcmd{C-c C-x M-w,org-copy-subtree} Copy subtree to kill ring. With a numeric prefix argument N, copy the N sequential subtrees. -@kindex C-c C-x C-y -@item C-c C-x C-y +@orgcmd{C-c C-x C-y,org-paste-subtree} Yank subtree from kill ring. This does modify the level of the subtree to make sure the tree fits in nicely at the yank position. The yank level can also be specified with a numeric prefix argument, or by yanking after a headline marker like @samp{****}. -@kindex C-y -@item C-y +@orgcmd{C-y,org-yank} @vindex org-yank-adjusted-subtrees @vindex org-yank-folded-subtrees Depending on the variables @code{org-yank-adjusted-subtrees} and @@ -1146,19 +1140,16 @@ previously visible. Any prefix argument to this command will force a normal force a normal yank is @kbd{C-u C-y}. If you use @code{yank-pop} after a yank, it will yank previous kill items plainly, without adjustment and folding. -@kindex C-c C-x c -@item C-c C-x c +@orgcmd{C-c C-x c,org-clone-subtree-with-time-shift} Clone a subtree by making a number of sibling copies of it. You will be prompted for the number of copies to make, and you can also specify if any timestamps in the entry should be shifted. This can be useful, for example, to create a number of tasks related to a series of lectures to prepare. For more details, see the docstring of the command @code{org-clone-subtree-with-time-shift}. -@kindex C-c C-w -@item C-c C-w +@orgcmd{C-c C-w,org-refile} Refile entry or region to a different location. @xref{Refiling notes}. -@kindex C-c ^ -@item C-c ^ +@orgcmd{C-c ^,org-sort-entries-or-items} Sort same-level entries. When there is an active region, all entries in the region will be sorted. Otherwise the children of the current headline are sorted. The command prompts for the sorting method, which can be @@ -1169,14 +1160,11 @@ of a property. Reverse sorting is possible as well. You can also supply your own function to extract the sorting key. With a @kbd{C-u} prefix, sorting will be case-sensitive. With two @kbd{C-u C-u} prefixes, duplicate entries will also be removed. -@kindex C-x n s -@item C-x n s +@orgcmd{C-x n s,org-narrow-to-subtree} Narrow buffer to current subtree. -@kindex C-x n w -@item C-x n w +@orgcmd{C-x n w,widen} Widen buffer to remove narrowing. -@kindex C-c * -@item C-c * +@orgcmd{C-c *,org-toggle-heading} Turn a normal line or plain list item into a headline (so that it becomes a subheading at its location). Also turn a headline into a normal line by removing the stars. If there is an active region, turn all lines in the @@ -1220,9 +1208,8 @@ and you will see immediately how it works. Org-mode contains several commands creating such trees, all these commands can be accessed through a dispatcher: -@table @kbd -@kindex C-c / -@item C-c / +@table @asis +@orgcmd{C-c /,org-sparse-tree} This prompts for an extra key to select a sparse-tree creating command. @kindex C-c / r @item C-c / r @@ -1347,9 +1334,8 @@ the current list-level) improves readability, customize the variable The following commands act on items when the cursor is in the first line of an item (the line with the bullet or number). -@table @kbd -@kindex @key{TAB} -@item @key{TAB} +@table @asis +@orgcmd{@key{TAB},org-cycle} @vindex org-cycle-include-plain-lists Items can be folded just like headline levels. Normally this works only if the cursor is on a plain list item. For more details, see the variable @@ -1360,8 +1346,7 @@ headlines, however; the hierarchies remain completely separated. If @code{org-cycle-include-plain-lists} has not been set, @key{TAB} fixes the indentation of the current line in a heuristic way. -@kindex M-@key{RET} -@item M-@key{RET} +@orgcmd{M-@key{RET},org-insert-heading} @vindex org-M-RET-may-split-line Insert new item at current level. With a prefix argument, force a new heading (@pxref{Structure editing}). If this command is used in the middle @@ -1375,13 +1360,11 @@ bullet, a bullet is added to the current line. @kindex M-S-@key{RET} @item M-S-@key{RET} Insert a new item with a checkbox (@pxref{Checkboxes}). -@kindex @key{TAB} -@item @key{TAB} @r{in new, empty item} +@orgcmd{@key{TAB},org-cycle} In a new item with no text yet, the first @key{TAB} demotes the item to become a child of the previous one. The next @key{TAB} makes it a parent, and so on, all the way to the left margin. Yet another @key{TAB}, and you are back to the initial level. -@kindex S-@key{up} @kindex S-@key{down} @item S-@key{up} @itemx S-@key{down} @@ -14599,12 +14582,17 @@ and contributed various ideas and code snippets. @printindex cp -@node Key Index, Variable Index, Main Index, Top +@node Key Index, Command and Function Index, Main Index, Top @unnumbered Key index @printindex ky -@node Variable Index, , Key Index, Top +@node Command and Function Index, Variable Index, Key Index, Top +@unnumbered Command and function index + +@printindex fn + +@node Variable Index, , Command and Function Index, Top @unnumbered Variable index This is not a complete index of variables and faces, only the ones that are From 190e88cfc9478e994bfa8b4c82c2a4cc96b6c959 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 14:19:29 +0200 Subject: [PATCH 043/348] Remove the special noutline.el file for XEmacs The latest XEmacs package release does now contain a modern version of outline.el, put there by Michael Sperber. * Makefile: Remove targets related to noutline.el. * README: Remove the entry for the xemacs directory. * README_DIST: Remove the entry for the xemacs directory. * doc/org.texi (Installation): Remove the special installation instructions for XEmacs. * lisp/org.el (outline): Remove special code to load noutline.el for XEmacs. * xemacs/README: File removed. * xemacs/noutline.el: File removed. * xemacs/ps-print-invisible.el: File removed. --- Makefile | 9 - README | 6 - README_DIST | 6 - doc/org.texi | 12 - lisp/org.el | 4 - xemacs/README | 15 - xemacs/noutline.el | 1051 ---------------------------------- xemacs/ps-print-invisible.el | 225 -------- 8 files changed, 1328 deletions(-) delete mode 100644 xemacs/README delete mode 100644 xemacs/noutline.el delete mode 100644 xemacs/ps-print-invisible.el diff --git a/Makefile b/Makefile index e93f12756..3229f4657 100644 --- a/Makefile +++ b/Makefile @@ -166,7 +166,6 @@ SHELL = /bin/sh # Additional distribution files DISTFILES_extra= Makefile request-assign-future.txt contrib -DISTFILES_xemacs= xemacs/noutline.el xemacs/ps-print-invisible.el xemacs/README default: $(ELCFILES) $(ELCBFILES) @@ -205,10 +204,6 @@ install-info: $(INFOFILES) install-info-debian: $(INFOFILES) $(INSTALL_INFO) --infodir=$(infodir) $(INFOFILES) -install-noutline: xemacs/noutline.elc - if [ ! -d $(lispdir) ]; then $(MKDIR) $(lispdir); else true; fi ; - $(CP) xemacs/noutline.el xemacs/noutline.elc $(lispdir) - autoloads: lisp/org-install.el lisp/org-install.el: $(LISPFILES0) Makefile @@ -220,8 +215,6 @@ lisp/org-install.el: $(LISPFILES0) Makefile --eval '(save-buffer)' mv org-install.el lisp -xemacs/noutline.elc: xemacs/noutline.el - doc/org: doc/org.texi (cd doc; $(MAKEINFO) --no-split org.texi -o org) @@ -318,7 +311,6 @@ distfile: ${MAKE} lisp/org-install.el rm -rf org-$(TAG) org-$(TAG).zip $(MKDIR) org-$(TAG) - $(MKDIR) org-$(TAG)/xemacs $(MKDIR) org-$(TAG)/doc $(MKDIR) org-$(TAG)/lisp cp -r $(LISPFILES) org-$(TAG)/lisp @@ -326,7 +318,6 @@ distfile: cp -r $(DISTFILES_extra) org-$(TAG)/ cp -r README_DIST org-$(TAG)/README cp -r ORGWEBPAGE/Changes.org org-$(TAG)/ - cp -r $(DISTFILES_xemacs) org-$(TAG)/xemacs/ zip -r org-$(TAG).zip org-$(TAG) gtar zcvf org-$(TAG).tar.gz org-$(TAG) diff --git a/README b/README index 6e2a0ac68..a9d0003cf 100644 --- a/README +++ b/README @@ -21,12 +21,6 @@ doc/ The documentation files. org.texi is the source of the documentation, org.html and org.pdf are formatted versions of it. -xemacs/ - The xemacs directory contains special code for XEmacs users, in - particular a port of the GNU Emacs outline.el to XEmacs. Org-mode - does not work under XEmacs without this file installed. It did - until version 4.37, but no longer. - contrib/ A directory with third-party additions for Org. Some really cool stuff is in there. diff --git a/README_DIST b/README_DIST index 0e827278b..a687b1a18 100644 --- a/README_DIST +++ b/README_DIST @@ -17,12 +17,6 @@ doc/ The documentation files. org.texi is the source of the documentation, org.html and org.pdf are formatted versions of it. -xemacs/ - The xemacs directory contains special code for XEmacs users, in - particular a port of the GNU Emacs outline.el to XEmacs. Org-mode - does not work under XEmacs without this file installed. It did - until version 4.37, but no longer. - contrib/ A directory with third-party additions for Org. Some really cool stuff is in there. diff --git a/doc/org.texi b/doc/org.texi index fea733fab..2e61ddfc2 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -634,18 +634,6 @@ step for this directory: (setq load-path (cons "~/path/to/orgdir/contrib/lisp" load-path)) @end example -@sp 2 -@cartouche -XEmacs users now need to install the file @file{noutline.el} from -the @file{xemacs} sub-directory of the Org distribution. Use the -command: - -@example - make install-noutline -@end example -@end cartouche -@sp 2 - @noindent Now byte-compile the Lisp files with the shell command: @example diff --git a/lisp/org.el b/lisp/org.el index 3102d629a..e34ec1a67 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -86,10 +86,6 @@ (unless (boundp 'diary-fancy-buffer) (defvaralias 'diary-fancy-buffer 'fancy-diary-buffer))) -;; For XEmacs, noutline is not yet provided by outline.el, so arrange for -;; the file noutline.el being loaded. -(if (featurep 'xemacs) (condition-case nil (require 'noutline))) -;; We require noutline, which might be provided in outline.el (require 'outline) (require 'noutline) ;; Other stuff we need. (require 'time-date) diff --git a/xemacs/README b/xemacs/README deleted file mode 100644 index 00c332c77..000000000 --- a/xemacs/README +++ /dev/null @@ -1,15 +0,0 @@ -This directory contains files that are necessary or at least useful -companions for Org-mode under XEmacs: - -noutline.el - - Greg Chernov's port of the overlay-based implementation of - outline-mode. This is required, and until XEmacs uses this (or - another port), you need to install it with Org-mode. The "Installation" - section in the Manual covers also the installation of this package. - -ps-print-invisible.el - - Greg Chernovs modification to ps-print, to honor invisible text - properties during printing. This file is not required for running - Org-mode, but it is useful when trying to print partial trees. \ No newline at end of file diff --git a/xemacs/noutline.el b/xemacs/noutline.el deleted file mode 100644 index f9ea1daeb..000000000 --- a/xemacs/noutline.el +++ /dev/null @@ -1,1051 +0,0 @@ -;;; outline.el --- outline mode commands for Emacs - -;; ---------------------------------------------------------------------- -;; This is a port of GNU Emacs outline.el to XEmacs. The port was -;; done by Greg Chernov and is temporarily made available on the Org-mode -;; homepage http://www.astro.uva.nl/~dominik/Tools/org/, and as part -;; of the Org-mode distribution. -;; ---------------------------------------------------------------------- - -;; Copyright (C) 1986, 1993, 1994, 1995, 1997, 2000, 2001, 2002, -;; 2003, 2004, 2005 Free Software Foundation, Inc. - -;; Maintainer: FSF -;; Keywords: outlines - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. - -;;; Commentary: - -;; This package is a major mode for editing outline-format documents. -;; An outline can be `abstracted' to show headers at any given level, -;; with all stuff below hidden. See the Emacs manual for details. - -;;; Todo: - -;; - subtree-terminators -;; - better handle comments before function bodies (i.e. heading) -;; - don't bother hiding whitespace - -;;; Code: - -(require 'xemacs) -(require 'easymenu) - -;; XEmacs and compatibility - -(defalias 'match-string-no-properties 'match-string) - -(if (not (fboundp 'add-to-invisibility-spec)) - (defun add-to-invisibility-spec (arg) - "Add elements to `buffer-invisibility-spec'. -See documentation for `buffer-invisibility-spec' for the kind of elements -that can be added." - (if (eq buffer-invisibility-spec t) - (setq buffer-invisibility-spec (list t))) - (setq buffer-invisibility-spec - (cons arg buffer-invisibility-spec)))) - -(if (not (fboundp 'remove-from-invisibility-spec)) - (defun remove-from-invisibility-spec (arg) - "Remove elements from `buffer-invisibility-spec'." - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) - -(defvar font-lock-warning-face) - - -(defgroup outlines nil - "Support for hierarchical outlining." - :prefix "outline-" - :group 'editing) - -(defcustom outline-regexp "[*\^L]+" - "Regular expression to match the beginning of a heading. -Any line whose beginning matches this regexp is considered to start a heading. -Note that Outline mode only checks this regexp at the start of a line, -so the regexp need not (and usually does not) start with `^'. -The recommended way to set this is with a Local Variables: list -in the file it applies to. See also `outline-heading-end-regexp'." - :type '(choice regexp (const nil)) - :group 'outlines) - -(defcustom outline-heading-end-regexp "\n" - "Regular expression to match the end of a heading line. -You can assume that point is at the beginning of a heading when this -regexp is searched for. The heading ends at the end of the match. -The recommended way to set this is with a `Local Variables:' list -in the file it applies to." - :type 'regexp - :group 'outlines) - -(defvar outline-mode-prefix-map - (let ((map (make-sparse-keymap))) - (define-key map "@" 'outline-mark-subtree) - (define-key map "\C-n" 'outline-next-visible-heading) - (define-key map "\C-p" 'outline-previous-visible-heading) - (define-key map "\C-i" 'show-children) - (define-key map "\C-s" 'show-subtree) - (define-key map "\C-d" 'hide-subtree) - (define-key map "\C-u" 'outline-up-heading) - (define-key map "\C-f" 'outline-forward-same-level) - (define-key map "\C-b" 'outline-backward-same-level) - (define-key map "\C-t" 'hide-body) - (define-key map "\C-a" 'show-all) - (define-key map "\C-c" 'hide-entry) - (define-key map "\C-e" 'show-entry) - (define-key map "\C-l" 'hide-leaves) - (define-key map "\C-k" 'show-branches) - (define-key map "\C-q" 'hide-sublevels) - (define-key map "\C-o" 'hide-other) - (define-key map "\C-^" 'outline-move-subtree-up) - (define-key map "\C-v" 'outline-move-subtree-down) - (define-key map [(control ?<)] 'outline-promote) - (define-key map [(control ?>)] 'outline-demote) - (define-key map "\C-m" 'outline-insert-heading) - ;; Where to bind outline-cycle ? - map)) - - - -(defvar outline-mode-menu-heading - '("Headings" - ["Up" outline-up-heading t] - ["Next" outline-next-visible-heading t] - ["Previous" outline-previous-visible-heading t] - ["Next Same Level" outline-forward-same-level t] - ["Previous Same Level" outline-backward-same-level t] - ["New heading" outline-insert-heading t] - ["Copy to kill ring" outline-headers-as-kill :active (region-active-p)] - ["Move subtree up" outline-move-subtree-up t] - ["Move subtree down" outline-move-subtree-down t] - ["Promote subtree" outline-promote t] - ["Demote subtree" outline-demote t])) - -(defvar outline-mode-menu-show - '("Show" - ["Show All" show-all t] - ["Show Entry" show-entry t] - ["Show Branches" show-branches t] - ["Show Children" show-children t] - ["Show Subtree" show-subtree t])) - -(defvar outline-mode-menu-hide - '("Hide" - ["Hide Leaves" hide-leaves t] - ["Hide Body" hide-body t] - ["Hide Entry" hide-entry t] - ["Hide Subtree" hide-subtree t] - ["Hide Other" hide-other t] - ["Hide Sublevels" hide-sublevels t])) - - - -(defvar outline-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "\C-c" outline-mode-prefix-map) - map)) - -(defvar outline-font-lock-keywords - '(;; - ;; Highlight headings according to the level. - (eval . (list (concat "^\\(?:" outline-regexp "\\).+") - 0 '(outline-font-lock-face) nil t))) - "Additional expressions to highlight in Outline mode.") - -(defface outline-1 - '((t (:foreground "Blue1"))) - "Level 1." - :group 'outlines) - -(defface outline-2 - '((t (:foreground "DarkGoldenrod"))) - "Level 2." - :group 'outlines) - -(defface outline-3 - '((t (:foreground "Purple"))) - "Level 3." - :group 'outlines) - -(defface outline-4 - '((t (:foreground "Firebrick"))) - "Level 4." - :group 'outlines) - -(defface outline-5 - '((t (:foreground "ForestGreen"))) - "Level 5." - :group 'outlines) - -(defface outline-6 - '((t (:foreground "CadetBlue"))) - "Level 6." - :group 'outlines) - -(defface outline-7 - '((t (:foreground "Orchid"))) - "Level 7." - :group 'outlines) - -(defface outline-8 - '((t (:foreground "RosyBrown"))) - "Level 8." - :group 'outlines) - - - -(defvar outline-font-lock-faces - [outline-1 outline-2 outline-3 outline-4 - outline-5 outline-6 outline-7 outline-8]) - -(defvar outline-font-lock-levels nil) -(make-variable-buffer-local 'outline-font-lock-levels) - -(defun outline-font-lock-face () - ;; (save-excursion - ;; (outline-back-to-heading t) - ;; (let* ((count 0) - ;; (start-level (funcall outline-level)) - ;; (level start-level) - ;; face-level) - ;; (while (not (setq face-level - ;; (if (or (bobp) (eq level 1)) 0 - ;; (cdr (assq level outline-font-lock-levels))))) - ;; (outline-up-heading 1 t) - ;; (setq count (1+ count)) - ;; (setq level (funcall outline-level))) - ;; ;; Remember for later. - ;; (unless (zerop count) - ;; (setq face-level (+ face-level count)) - ;; (push (cons start-level face-level) outline-font-lock-levels)) - ;; (condition-case nil - ;; (aref outline-font-lock-faces face-level) - ;; (error font-lock-warning-face)))) - (save-excursion - (goto-char (match-beginning 0)) - (looking-at outline-regexp) - (condition-case nil - (aref outline-font-lock-faces (1- (funcall outline-level))) - (error font-lock-warning-face)))) - -(defvar outline-view-change-hook nil - "Normal hook to be run after outline visibility changes.") - -(defvar outline-mode-hook nil - "This hook is run when outline mode starts.") - -(defvar outline-blank-line nil - "Non-nil means to leave unhidden blank line before heading.") - -;;;###autoload -(define-derived-mode outline-mode text-mode "Outline" - "Set major mode for editing outlines with selective display. -Headings are lines which start with asterisks: one for major headings, -two for subheadings, etc. Lines not starting with asterisks are body lines. - -Body text or subheadings under a heading can be made temporarily -invisible, or visible again. Invisible lines are attached to the end -of the heading, so they move with it, if the line is killed and yanked -back. A heading with text hidden under it is marked with an ellipsis (...). - -Commands:\\<outline-mode-map> -\\[outline-next-visible-heading] outline-next-visible-heading move by visible headings -\\[outline-previous-visible-heading] outline-previous-visible-heading -\\[outline-forward-same-level] outline-forward-same-level similar but skip subheadings -\\[outline-backward-same-level] outline-backward-same-level -\\[outline-up-heading] outline-up-heading move from subheading to heading - -\\[hide-body] make all text invisible (not headings). -\\[show-all] make everything in buffer visible. -\\[hide-sublevels] make only the first N levels of headers visible. - -The remaining commands are used when point is on a heading line. -They apply to some of the body or subheadings of that heading. -\\[hide-subtree] hide-subtree make body and subheadings invisible. -\\[show-subtree] show-subtree make body and subheadings visible. -\\[show-children] show-children make direct subheadings visible. - No effect on body, or subheadings 2 or more levels down. - With arg N, affects subheadings N levels down. -\\[hide-entry] make immediately following body invisible. -\\[show-entry] make it visible. -\\[hide-leaves] make body under heading and under its subheadings invisible. - The subheadings remain visible. -\\[show-branches] make all subheadings at all levels visible. - -The variable `outline-regexp' can be changed to control what is a heading. -A line is a heading if `outline-regexp' matches something at the -beginning of the line. The longer the match, the deeper the level. - -Turning on outline mode calls the value of `text-mode-hook' and then of -`outline-mode-hook', if they are non-nil." - (make-local-variable 'line-move-ignore-invisible) - (setq line-move-ignore-invisible t) - ;; Cause use of ellipses for invisible text. - (add-to-invisibility-spec '(outline . t)) - - (easy-menu-add outline-mode-menu-heading) - (easy-menu-add outline-mode-menu-show) - (easy-menu-add outline-mode-menu-hide) - (set (make-local-variable 'paragraph-start) - (concat paragraph-start "\\|\\(?:" outline-regexp "\\)")) - ;; Inhibit auto-filling of header lines. - (set (make-local-variable 'auto-fill-inhibit-regexp) outline-regexp) - (set (make-local-variable 'paragraph-separate) - (concat paragraph-separate "\\|\\(?:" outline-regexp "\\)")) - (set (make-local-variable 'font-lock-defaults) - '(outline-font-lock-keywords t nil nil backward-paragraph)) - (setq imenu-generic-expression - (list (list nil (concat "^\\(?:" outline-regexp "\\).*$") 0))) - (add-hook 'change-major-mode-hook 'show-all nil t)) - -(defcustom outline-minor-mode-prefix "\C-c@" - "Prefix key to use for Outline commands in Outline minor mode. -The value of this variable is checked as part of loading Outline mode. -After that, changing the prefix key requires manipulating keymaps." - :type 'string - :group 'outlines) - -;;;###autoload -(define-minor-mode outline-minor-mode - "Toggle Outline minor mode. -With arg, turn Outline minor mode on if arg is positive, off otherwise. -See the command `outline-mode' for more information on this mode." - nil " Outl" (list (cons outline-minor-mode-prefix outline-mode-prefix-map)) - :group 'outlines - (if outline-minor-mode - (progn - ;; Turn off this mode if we change major modes. - (easy-menu-add outline-mode-menu-heading) - (easy-menu-add outline-mode-menu-show) - (easy-menu-add outline-mode-menu-hide) - (add-hook 'change-major-mode-hook - (lambda () (outline-minor-mode -1)) - nil t) - (set (make-local-variable 'line-move-ignore-invisible) t) - ;; Cause use of ellipses for invisible text. - (add-to-invisibility-spec '(outline . t))) - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide) - (setq line-move-ignore-invisible nil) - ;; Cause use of ellipses for invisible text. - (remove-from-invisibility-spec '(outline . t)) - ;; When turning off outline mode, get rid of any outline hiding. - (show-all))) - -(defvar outline-level 'outline-level - "Function of no args to compute a header's nesting level in an outline. -It can assume point is at the beginning of a header line and that the match -data reflects the `outline-regexp'.") - -(defvar outline-heading-alist () - "Alist associating a heading for every possible level. -Each entry is of the form (HEADING . LEVEL). -This alist is used two ways: to find the heading corresponding to -a given level and to find the level of a given heading. -If a mode or document needs several sets of outline headings (for example -numbered and unnumbered sections), list them set by set and sorted by level -within each set. For example in texinfo mode: - - (setq outline-heading-alist - '((\"@chapter\" . 2) (\"@section\" . 3) (\"@subsection\" . 4) - (\"@subsubsection\" . 5) - (\"@unnumbered\" . 2) (\"@unnumberedsec\" . 3) - (\"@unnumberedsubsec\" . 4) (\"@unnumberedsubsubsec\" . 5) - (\"@appendix\" . 2) (\"@appendixsec\" . 3)... - (\"@appendixsubsec\" . 4) (\"@appendixsubsubsec\" . 5) ..)) - -Instead of sorting the entries in each set, you can also separate the -sets with nil.") -(make-variable-buffer-local 'outline-heading-alist) - -;; This used to count columns rather than characters, but that made ^L -;; appear to be at level 2 instead of 1. Columns would be better for -;; tab handling, but the default regexp doesn't use tabs, and anyone -;; who changes the regexp can also redefine the outline-level variable -;; as appropriate. -(defun outline-level () - "Return the depth to which a statement is nested in the outline. -Point must be at the beginning of a header line. -This is actually either the level specified in `outline-heading-alist' -or else the number of characters matched by `outline-regexp'." - (or (cdr (assoc (match-string 0) outline-heading-alist)) - (- (match-end 0) (match-beginning 0)))) - -(defun outline-next-preface () - "Skip forward to just before the next heading line. -If there's no following heading line, stop before the newline -at the end of the buffer." - (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") - nil 'move) - (goto-char (match-beginning 0))) - (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) - (forward-char -1))) - -(defun outline-next-heading () - "Move to the next (possibly invisible) heading line." - (interactive) - ;; Make sure we don't match the heading we're at. - (if (and (bolp) (not (eobp))) (forward-char 1)) - (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)") - nil 'move) - (goto-char (match-beginning 0)))) - -(defun outline-previous-heading () - "Move to the previous (possibly invisible) heading line." - (interactive) - (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) - -(defsubst outline-invisible-p (&optional pos) - "Non-nil if the character after point is invisible." - (eq 'outline (get-char-property (or pos (point)) 'invisible))) - -(defun outline-visible () - (not (outline-invisible-p))) -(make-obsolete 'outline-visible 'outline-invisible-p) - -(defun outline-back-to-heading (&optional invisible-ok) - "Move to previous heading line, or beg of this line if it's a heading. -Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (beginning-of-line) - (or (outline-on-heading-p invisible-ok) - (let (found) - (save-excursion - (while (not found) - (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil t) - (error "before first heading")) - (setq found (and (or invisible-ok (not (outline-invisible-p))) - (point))))) - (goto-char found) - found))) - -(defun outline-on-heading-p (&optional invisible-ok) - "Return t if point is on a (visible) heading line. -If INVISIBLE-OK is non-nil, an invisible heading line is ok too." - (save-excursion - (beginning-of-line) - (and (bolp) (or invisible-ok (not (outline-invisible-p))) - (looking-at outline-regexp)))) - -(defun outline-insert-heading () - "Insert a new heading at same depth at point." - (interactive) - (let ((head (save-excursion - (condition-case nil - (outline-back-to-heading) - (error (outline-next-heading))) - (if (eobp) - (or (caar outline-heading-alist) "") - (match-string 0))))) - (unless (or (string-match "[ \t]\\'" head) - (not (string-match (concat "\\`\\(?:" outline-regexp "\\)") - (concat head " ")))) - (setq head (concat head " "))) - (unless (bolp) (end-of-line) (newline)) - (insert head) - (unless (eolp) - (save-excursion (newline-and-indent))) - (run-hooks 'outline-insert-heading-hook))) - -(defun outline-invent-heading (head up) - (save-match-data - ;; Let's try to invent one by repeating or deleting the last char. - (let ((new-head (if up (substring head 0 -1) - (concat head (substring head -1))))) - (if (string-match (concat "\\`\\(?:" outline-regexp "\\)") - new-head) - ;; Why bother checking that it is indeed higher/lower level ? - new-head - ;; Didn't work, so ask what to do. - (read-string (format "%s heading for `%s': " - (if up "Parent" "Demoted") head) - head nil nil))))) - -(defun outline-promote (&optional children) - "Promote headings higher up the tree. -If prefix argument CHILDREN is given, promote also all the children. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (interactive - (list (if (and zmacs-regions (region-active-p)) 'region - (outline-back-to-heading) - (if current-prefix-arg nil 'subtree)))) - (cond - ((eq children 'region) - (outline-map-region 'outline-promote (region-beginning) (region-end))) - (children - (outline-map-region 'outline-promote - (point) - (save-excursion (outline-get-next-sibling) (point)))) - (t - (outline-back-to-heading t) - (let* ((head (match-string-no-properties 0)) - (level (save-match-data (funcall outline-level))) - (up-head (or (outline-head-from-level (1- level) head) - ;; Use the parent heading, if it is really - ;; one level less. - (save-excursion - (save-match-data - (outline-up-heading 1 t) - (and (= (1- level) (funcall outline-level)) - (match-string-no-properties 0)))) - ;; Bummer!! There is no lower level heading. - (outline-invent-heading head 'up)))) - - (unless (rassoc level outline-heading-alist) - (push (cons head level) outline-heading-alist)) - - (replace-match up-head nil t))))) - -(defun outline-demote (&optional children) - "Demote headings lower down the tree. -If prefix argument CHILDREN is given, demote also all the children. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (interactive - (list (if (and zmacs-regions (region-active-p)) 'region - (outline-back-to-heading) - (if current-prefix-arg nil 'subtree)))) - (cond - ((eq children 'region) - (outline-map-region 'outline-demote (region-beginning) (region-end))) - (children - (outline-map-region 'outline-demote - (point) - (save-excursion (outline-get-next-sibling) (point)))) - (t - (let* ((head (match-string-no-properties 0)) - (level (save-match-data (funcall outline-level))) - (down-head - (or (outline-head-from-level (1+ level) head) - (save-excursion - (save-match-data - (while (and (progn (outline-next-heading) (not (eobp))) - (<= (funcall outline-level) level))) - (when (eobp) - ;; Try again from the beginning of the buffer. - (goto-char (point-min)) - (while (and (progn (outline-next-heading) (not (eobp))) - (<= (funcall outline-level) level)))) - (unless (eobp) - (looking-at outline-regexp) - (match-string-no-properties 0)))) - ;; Bummer!! There is no higher-level heading in the buffer. - (outline-invent-heading head nil)))) - - (unless (rassoc level outline-heading-alist) - (push (cons head level) outline-heading-alist)) - (replace-match down-head nil t))))) - -(defun outline-head-from-level (level head &optional alist) - "Get new heading with level LEVEL from ALIST. -If there are no such entries, return nil. -ALIST defaults to `outline-heading-alist'. -Similar to (car (rassoc LEVEL ALIST)). -If there are several different entries with same new level, choose -the one with the smallest distance to the assocation of HEAD in the alist. -This makes it possible for promotion to work in modes with several -independent sets of headings (numbered, unnumbered, appendix...)" - (unless alist (setq alist outline-heading-alist)) - (let ((l (rassoc level alist)) - ll h hl l2 l2l) - (cond - ((null l) nil) - ;; If there's no HEAD after L, any other entry for LEVEL after L - ;; can't be much better than L. - ((null (setq h (assoc head (setq ll (memq l alist))))) (car l)) - ;; If there's no other entry for LEVEL, just keep L. - ((null (setq l2 (rassoc level (cdr ll)))) (car l)) - ;; Now we have L, L2, and H: see if L2 seems better than L. - ;; If H is after L2, L2 is better. - ((memq h (setq l2l (memq l2 (cdr ll)))) - (outline-head-from-level level head l2l)) - ;; Now we have H between L and L2. - ;; If there's a separator between L and H, prefer L2. - ((memq h (memq nil ll)) - (outline-head-from-level level head l2l)) - ;; If there's a separator between L2 and H, prefer L. - ((memq l2 (memq nil (setq hl (memq h ll)))) (car l)) - ;; No separator between L and L2, check the distance. - ((< (* 2 (length hl)) (+ (length ll) (length l2l))) - (outline-head-from-level level head l2l)) - ;; If all else fails, just keep L. - (t (car l))))) - -(defun outline-map-region (fun beg end) - "Call FUN for every heading between BEG and END. -When FUN is called, point is at the beginning of the heading and -the match data is set appropriately." - (save-excursion - (setq end (copy-marker end)) - (goto-char beg) - (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t) - (goto-char (match-beginning 0)) - (funcall fun) - (while (and (progn - (outline-next-heading) - (< (point) end)) - (not (eobp))) - (funcall fun))))) - -;; Vertical tree motion - -(defun outline-move-subtree-up (&optional arg) - "Move the currrent subtree up past ARG headlines of the same level." - (interactive "p") - (outline-move-subtree-down (- arg))) - -(defun outline-move-subtree-down (&optional arg) - "Move the currrent subtree down past ARG headlines of the same level." - (interactive "p") - (let ((movfunc (if (> arg 0) 'outline-get-next-sibling - 'outline-get-last-sibling)) - (ins-point (make-marker)) - (cnt (abs arg)) - (tmp-string "") - beg end folded) - ;; Select the tree - (outline-back-to-heading) - (setq beg (point)) - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (outline-end-of-subtree)) - (if (= (char-after) ?\n) (forward-char 1)) - (setq end (point)) - ;; Find insertion point, with error handling - (goto-char beg) - (while (> cnt 0) - (or (funcall movfunc) - (progn (goto-char beg) - (error "Cannot move past superior level"))) - (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (outline-end-of-subtree) - (if (= (char-after) ?\n) (forward-char 1)))) - (move-marker ins-point (point)) - (setq tmp-string (buffer-substring beg end)) - (delete-region beg end) - (insert tmp-string) - (goto-char ins-point) - (if folded (hide-subtree)) - (move-marker ins-point nil))) - -(defun outline-end-of-heading () - (if (re-search-forward outline-heading-end-regexp nil 'move) - (forward-char -1))) - -(defun outline-next-visible-heading (arg) - "Move to the next visible heading line. -With argument, repeats or can move backward if negative. -A heading line is one that starts with a `*' (or that -`outline-regexp' matches)." - (interactive "p") - (if (< arg 0) - (beginning-of-line) - (end-of-line)) - (while (and (not (bobp)) (< arg 0)) - (while (and (not (bobp)) - (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil 'move) - (outline-invisible-p))) - (setq arg (1+ arg))) - (while (and (not (eobp)) (> arg 0)) - (while (and (not (eobp)) - (re-search-forward (concat "^\\(?:" outline-regexp "\\)") - nil 'move) - (outline-invisible-p (match-beginning 0)))) - (setq arg (1- arg))) - (beginning-of-line)) - -(defun outline-previous-visible-heading (arg) - "Move to the previous heading line. -With argument, repeats or can move forward if negative. -A heading line is one that starts with a `*' (or that -`outline-regexp' matches)." - (interactive "p") - (outline-next-visible-heading (- arg))) - -(defun outline-mark-subtree () - "Mark the current subtree in an outlined document. -This puts point at the start of the current subtree, and mark at the end." - (interactive) - (let ((beg)) - (if (outline-on-heading-p) - ;; we are already looking at a heading - (beginning-of-line) - ;; else go back to previous heading - (outline-previous-visible-heading 1)) - (setq beg (point)) - (outline-end-of-subtree) - (push-mark (point) nil t) - (goto-char beg))) - - -(defvar outline-isearch-open-invisible-function nil - "Function called if `isearch' finishes in an invisible overlay. -The function is called with the overlay as its only argument. -If nil, `show-entry' is called to reveal the invisible text.") - -(defun outline-discard-extents (&optional beg end) - "Clear BEG and END of overlays whose property NAME has value VAL. -Overlays might be moved and/or split. -BEG and END default respectively to the beginning and end of buffer." - (unless beg (setq beg (point-min))) - (unless end (setq end (point-max))) - (if (< end beg) - (setq beg (prog1 end (setq end beg)))) - (save-excursion - (map-extents - #'(lambda (ex ignored) - (if (< (extent-start-position ex) beg) - (if (> (extent-end-position ex) end) - (progn - (set-extent-endpoints (copy-extent ex) - (extent-start-position ex) beg) - (set-extent-endpoints ex end (extent-end-position ex))) - (set-extent-endpoints ex (extent-start-position ex) beg)) - (if (> (extent-end-position ex) end) - (set-extent-endpoints ex end (extent-end-position ex)) - (delete-extent ex)))) - (current-buffer) beg end nil 'end-closed 'outline))) - -(defun outline-flag-region (from to flag) - "Hide or show lines from FROM to TO, according to FLAG. -If FLAG is nil then text is shown, while if FLAG is t the text is hidden." - (when (< to from) - (setq from (prog1 to (setq to from)))) - ;; first clear it all out - (outline-discard-extents from to) - (when flag - (let ((ex (make-extent from to))) - (set-extent-property ex 'invisible 'outline) - (set-extent-property ex 'outline flag) - ;; FIXME: I don't think XEmacs uses this, actually. - (set-extent-property ex 'isearch-open-invisible - (or outline-isearch-open-invisible-function - 'outline-isearch-open-invisible)))) - ;; Seems only used by lazy-lock. I.e. obsolete. - (run-hooks 'outline-view-change-hook)) - -;; Function to be set as an outline-isearch-open-invisible' property -;; to the overlay that makes the outline invisible (see -;; `outline-flag-region'). -(defun outline-isearch-open-invisible (overlay) - ;; We rely on the fact that isearch places point on the matched text. - (show-entry)) - -(defun hide-entry () - "Hide the body directly following this heading." - (interactive) - (save-excursion - (outline-back-to-heading) - (outline-end-of-heading) - (outline-flag-region (point) (progn (outline-next-preface) (point)) t))) - -(defun show-entry () - "Show the body directly following this heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (outline-back-to-heading t) - (outline-flag-region (max 1 (1- (point))) - (progn (outline-next-preface) (point)) nil))) - -(defun hide-body () - "Hide all body lines in buffer, leaving all headings visible." - (interactive) - (hide-region-body (point-min) (point-max))) - -(defun hide-region-body (start end) - "Hide all body lines in the region, but not headings." - ;; Nullify the hook to avoid repeated calls to `outline-flag-region' - ;; wasting lots of time running `lazy-lock-fontify-after-outline' - ;; and run the hook finally. - (let (outline-view-change-hook) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (if (outline-on-heading-p) - (outline-end-of-heading) - (outline-next-preface)) - (while (not (eobp)) - (outline-flag-region (point) - (progn (outline-next-preface) (point)) t) - (unless (eobp) - (forward-char (if (looking-at "\n\n") 2 1)) - (outline-end-of-heading)))))) - (run-hooks 'outline-view-change-hook)) - -(defun show-all () - "Show all of the text in the buffer." - (interactive) - (outline-flag-region (point-min) (point-max) nil)) - -(defun hide-subtree () - "Hide everything after this heading at deeper levels." - (interactive) - (outline-flag-subtree t)) - -(defun hide-leaves () - "Hide all body after this heading at deeper levels." - (interactive) - (save-excursion - (outline-back-to-heading) - (outline-end-of-heading) - (hide-region-body (point) (progn (outline-end-of-subtree) (point))))) - -(defun show-subtree () - "Show everything after this heading at deeper levels." - (interactive) - (outline-flag-subtree nil)) - -(defun outline-show-heading () - "Show the current heading and move to its end." - (outline-flag-region (- (point) - (if (bobp) 0 - (if (and outline-blank-line - (eq (char-before (1- (point))) ?\n)) - 2 1))) - (progn (outline-end-of-heading) (point)) - nil)) - -(defun hide-sublevels (levels) - "Hide everything but the top LEVELS levels of headers, in whole buffer." - (interactive "p") - (if (< levels 1) - (error "Must keep at least one level of headers")) - (let (outline-view-change-hook) - (save-excursion - (goto-char (point-min)) - ;; Skip the prelude, if any. - (unless (outline-on-heading-p t) (outline-next-heading)) - ;; First hide everything. - (outline-flag-region (point) (point-max) t) - ;; Then unhide the top level headers. - (outline-map-region - (lambda () - (if (<= (funcall outline-level) levels) - (outline-show-heading))) - (point) (point-max)))) - (run-hooks 'outline-view-change-hook)) - -(defun hide-other () - "Hide everything except current body and parent and top-level headings." - (interactive) - (hide-sublevels 1) - (let (outline-view-change-hook) - (save-excursion - (outline-back-to-heading t) - (show-entry) - (while (condition-case nil (progn (outline-up-heading 1 t) (not (bobp))) - (error nil)) - (outline-flag-region (max 1 (1- (point))) - (save-excursion (forward-line 1) (point)) - nil)))) - (run-hooks 'outline-view-change-hook)) - -(defun outline-toggle-children () - "Show or hide the current subtree depending on its current state." - (interactive) - (save-excursion - (outline-back-to-heading) - (if (not (outline-invisible-p (point-at-eol))) - (hide-subtree) - (show-children) - (show-entry)))) - -(defun outline-flag-subtree (flag) - (save-excursion - (outline-back-to-heading) - (outline-end-of-heading) - (outline-flag-region (point) - (progn (outline-end-of-subtree) (point)) - flag))) - -(defun outline-end-of-subtree () - (outline-back-to-heading) - (let ((first t) - (level (funcall outline-level))) - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading)) - (if (and (bolp) (not (eolp))) - ;; We stopped at a nonempty line (the next heading). - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (and outline-blank-line (bolp)) - ;; leave blank line before heading - (forward-char -1)))))) - -(defun show-branches () - "Show all subheadings of this heading, but not their bodies." - (interactive) - (show-children 1000)) - -(defun show-children (&optional level) - "Show all direct subheadings of this heading. -Prefix arg LEVEL is how many levels below the current level should be shown. -Default is enough to cause the following heading to appear." - (interactive "P") - (setq level - (if level (prefix-numeric-value level) - (save-excursion - (outline-back-to-heading) - (let ((start-level (funcall outline-level))) - (outline-next-heading) - (if (eobp) - 1 - (max 1 (- (funcall outline-level) start-level))))))) - (let (outline-view-change-hook) - (save-excursion - (outline-back-to-heading) - (setq level (+ level (funcall outline-level))) - (outline-map-region - (lambda () - (if (<= (funcall outline-level) level) - (outline-show-heading))) - (point) - (progn (outline-end-of-subtree) - (if (eobp) (point-max) (1+ (point))))))) - (run-hooks 'outline-view-change-hook)) - - - -(defun outline-up-heading (arg &optional invisible-ok) - "Move to the visible heading line of which the present line is a subheading. -With argument, move up ARG levels. -If INVISIBLE-OK is non-nil, also consider invisible lines." - (interactive "p") - (and (eq this-command 'outline-up-heading) - (or (eq last-command 'outline-up-heading) (push-mark))) - (outline-back-to-heading invisible-ok) - (let ((start-level (funcall outline-level))) - (if (eq start-level 1) - (error "Already at top level of the outline")) - (while (and (> start-level 1) (> arg 0) (not (bobp))) - (let ((level start-level)) - (while (not (or (< level start-level) (bobp))) - (if invisible-ok - (outline-previous-heading) - (outline-previous-visible-heading 1)) - (setq level (funcall outline-level))) - (setq start-level level)) - (setq arg (- arg 1)))) - (looking-at outline-regexp)) - -(defun outline-forward-same-level (arg) - "Move forward to the ARG'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading." - (interactive "p") - (outline-back-to-heading) - (while (> arg 0) - (let ((point-to-move-to (save-excursion - (outline-get-next-sibling)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (progn - (setq arg 0) - (error "No following same-level heading")))))) - -(defun outline-get-next-sibling () - "Move to next heading of the same level, and return point or nil if none." - (let ((level (funcall outline-level))) - (outline-next-visible-heading 1) - (while (and (not (eobp)) (> (funcall outline-level) level)) - (outline-next-visible-heading 1)) - (if (or (eobp) (< (funcall outline-level) level)) - nil - (point)))) - -(defun outline-backward-same-level (arg) - "Move backward to the ARG'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading." - (interactive "p") - (outline-back-to-heading) - (while (> arg 0) - (let ((point-to-move-to (save-excursion - (outline-get-last-sibling)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (progn - (setq arg 0) - (error "No previous same-level heading")))))) - -(defun outline-get-last-sibling () - "Move to previous heading of the same level, and return point or nil if none." - (let ((level (funcall outline-level))) - (outline-previous-visible-heading 1) - (while (and (> (funcall outline-level) level) - (not (bobp))) - (outline-previous-visible-heading 1)) - (if (< (funcall outline-level) level) - nil - (point)))) - -(defun outline-headers-as-kill (beg end) - "Save the visible outline headers in region at the start of the kill ring. - -Text shown between the headers isn't copied. Two newlines are -inserted between saved headers. Yanking the result may be a -convenient way to make a table of contents of the buffer." - (interactive "r") - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (let ((buffer (current-buffer)) - start end) - (with-temp-buffer - (with-current-buffer buffer - ;; Boundary condition: starting on heading: - (when (outline-on-heading-p) - (outline-back-to-heading) - (setq start (point) - end (progn (outline-end-of-heading) - (point))) - (insert-buffer-substring buffer start end) - (insert "\n\n"))) - (let ((temp-buffer (current-buffer))) - (with-current-buffer buffer - (while (outline-next-heading) - (unless (outline-invisible-p) - (setq start (point) - end (progn (outline-end-of-heading) (point))) - (with-current-buffer temp-buffer - (insert-buffer-substring buffer start end) - (insert "\n\n")))))) - (kill-new (buffer-string))))))) - -(provide 'outline) -(provide 'noutline) - -;; arch-tag: 1724410e-7d4d-4f46-b801-49e18171e874 -;;; outline.el ends here diff --git a/xemacs/ps-print-invisible.el b/xemacs/ps-print-invisible.el deleted file mode 100644 index 8f005fe86..000000000 --- a/xemacs/ps-print-invisible.el +++ /dev/null @@ -1,225 +0,0 @@ -;;; ps-print-invisible.el - addon to ps-print package that deals -;; with invisible text printing in xemacs - -;; Author: Greg Chernov -;; -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; Put ps-print-invisible.el on your load path. -;; (require 'ps-print-invisible) -;; ps-print-buffer-with-faces will not print invisible parts of the buffer. -;; Work with invisible extents/text properties only -;; (xemacs hideshow and noutline packages). - -(defun ps-generate-postscript-with-faces (from to) - ;; Some initialization... - (setq ps-current-effect 0) - - ;; Build the reference lists of faces if necessary. - (when (or ps-always-build-face-reference - ps-build-face-reference) - (message "Collecting face information...") - (ps-build-reference-face-lists)) - - ;; Black/white printer. - (setq ps-black-white-faces-alist nil) - (and (eq ps-print-color-p 'black-white) - (ps-extend-face-list ps-black-white-faces nil - 'ps-black-white-faces-alist)) - - ;; Generate some PostScript. - (save-restriction - (narrow-to-region from to) - (ps-print-ensure-fontified from to) - (let ((face 'default) - (position to)) - (cond - ((memq ps-print-emacs-type '(xemacs lucid)) - ;; Build the list of extents... - ;;(debug) - (let ((a (cons 'dummy nil)) - record type extent extent-list - (list-invisible (ps-print-find-invisible-xmas from to))) - (ps-x-map-extents 'ps-mapper nil from to a) - (setq a (sort (cdr a) 'car-less-than-car) - extent-list nil) - - ;; Loop through the extents... - (while a - (setq record (car a) - position (car record) - - record (cdr record) - type (car record) - - record (cdr record) - extent (car record)) - - ;; Plot up to this record. - ;; XEmacs 19.12: for some reason, we're getting into a - ;; situation in which some of the records have - ;; positions less than 'from'. Since we've narrowed - ;; the buffer, this'll generate errors. This is a hack, - ;; but don't call ps-plot-with-face unless from > point-min. - (and (>= from (point-min)) - (ps-plot-with-face from (min position (point-max)) face)) - - (cond - ((eq type 'push) - (and (or (ps-x-extent-face extent) - (extent-property extent 'invisible)) - (setq extent-list (sort (cons extent extent-list) - 'ps-extent-sorter)))) - - ((eq type 'pull) - (setq extent-list (sort (delq extent extent-list) - 'ps-extent-sorter)))) - - - (setq face (if extent-list - (let ((prop (extent-property (car extent-list) 'invisible))) - (if (or (and (eq buffer-invisibility-spec t) - (not (null prop))) - (and (consp buffer-invisibility-spec) - (or (memq prop buffer-invisibility-spec) - (assq prop buffer-invisibility-spec)))) - 'emacs--invisible--face - (ps-x-extent-face (car extent-list)))) - 'default) - from position - a (cdr a))))) - - ((eq ps-print-emacs-type 'emacs) - (let ((property-change from) - (overlay-change from) - (save-buffer-invisibility-spec buffer-invisibility-spec) - (buffer-invisibility-spec nil) - before-string after-string) - (while (< from to) - (and (< property-change to) ; Don't search for property change - ; unless previous search succeeded. - (setq property-change (next-property-change from nil to))) - (and (< overlay-change to) ; Don't search for overlay change - ; unless previous search succeeded. - (setq overlay-change (min (ps-e-next-overlay-change from) - to))) - (setq position (min property-change overlay-change) - before-string nil - after-string nil) - ;; The code below is not quite correct, - ;; because a non-nil overlay invisible property - ;; which is inactive according to the current value - ;; of buffer-invisibility-spec nonetheless overrides - ;; a face text property. - (setq face - (cond ((let ((prop (get-text-property from 'invisible))) - ;; Decide whether this invisible property - ;; really makes the text invisible. - (if (eq save-buffer-invisibility-spec t) - (not (null prop)) - (or (memq prop save-buffer-invisibility-spec) - (assq prop save-buffer-invisibility-spec)))) - 'emacs--invisible--face) - ((get-text-property from 'face)) - (t 'default))) - (let ((overlays (ps-e-overlays-at from)) - (face-priority -1)) ; text-property - (while (and overlays - (not (eq face 'emacs--invisible--face))) - (let* ((overlay (car overlays)) - (overlay-invisible - (ps-e-overlay-get overlay 'invisible)) - (overlay-priority - (or (ps-e-overlay-get overlay 'priority) 0))) - (and (> overlay-priority face-priority) - (setq before-string - (or (ps-e-overlay-get overlay 'before-string) - before-string) - after-string - (or (and (<= (ps-e-overlay-end overlay) position) - (ps-e-overlay-get overlay 'after-string)) - after-string) - face-priority overlay-priority - face - (cond - ((if (eq save-buffer-invisibility-spec t) - (not (null overlay-invisible)) - (or (memq overlay-invisible - save-buffer-invisibility-spec) - (assq overlay-invisible - save-buffer-invisibility-spec))) - 'emacs--invisible--face) - ((ps-e-overlay-get overlay 'face)) - (t face) - )))) - (setq overlays (cdr overlays)))) - ;; Plot up to this record. - (and before-string - (ps-plot-string before-string)) - (ps-plot-with-face from position face) - (and after-string - (ps-plot-string after-string)) - (setq from position))))) - (ps-plot-with-face from to face)))) - - -(defun ps-print-find-invisible-xmas (from to) - (let ((list nil)) - (map-extents '(lambda (ex ignored) - (let ((prop (extent-property ex 'invisible))) - (if (or (and (eq buffer-invisibility-spec t) - (not (null prop))) - (or (memq prop buffer-invisibility-spec) - (assq prop buffer-invisibility-spec))) - (setq list (cons (list - (extent-start-position ex) - (extent-end-position ex)) - list)))) - nil) - (current-buffer) - from to nil 'start-and-end-in-region 'invisible) - (reverse list))) - - -(defun ps-mapper (extent list) - ;;(debug) - (let ((beg (ps-x-extent-start-position extent)) - (end (ps-x-extent-end-position extent)) - (inv-lst list-invisible) - (found nil)) - (while (and inv-lst - (not found)) - (let ((inv-beg (caar inv-lst)) - (inv-end (cadar inv-lst))) - (if (and (>= beg inv-beg) - (<= end inv-end) - (not (extent-property extent 'invisible))) - (setq found t)) - (setq inv-lst (cdr inv-lst)))) - (if (not found) - (nconc list - (list (list beg 'push extent) - (list end 'pull extent))))) - nil) - - -(provide 'ps-print-invisible) - - -;;; ps-print-invisible.el ends here \ No newline at end of file From 4a028cc7c0bf1a23d45ef05b954f89c4eb1e644a Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 18:12:59 +0200 Subject: [PATCH 044/348] Add org-static-mathjax to the contrib directory MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Thanks to Jan Bker for this contribution. --- contrib/lisp/org-static-mathjax.el | 171 +++++++++++++++ contrib/scripts/staticmathjax/.gitignore | 1 + contrib/scripts/staticmathjax/README.org | 79 +++++++ contrib/scripts/staticmathjax/README.txt | 91 ++++++++ contrib/scripts/staticmathjax/application.ini | 11 + .../staticmathjax/chrome/chrome.manifest | 1 + .../staticmathjax/chrome/content/main.js | 198 ++++++++++++++++++ .../staticmathjax/chrome/content/main.xul | 11 + .../defaults/preferences/prefs.js | 1 + 9 files changed, 564 insertions(+) create mode 100644 contrib/lisp/org-static-mathjax.el create mode 100644 contrib/scripts/staticmathjax/.gitignore create mode 100644 contrib/scripts/staticmathjax/README.org create mode 100644 contrib/scripts/staticmathjax/README.txt create mode 100644 contrib/scripts/staticmathjax/application.ini create mode 100644 contrib/scripts/staticmathjax/chrome/chrome.manifest create mode 100644 contrib/scripts/staticmathjax/chrome/content/main.js create mode 100644 contrib/scripts/staticmathjax/chrome/content/main.xul create mode 100644 contrib/scripts/staticmathjax/defaults/preferences/prefs.js diff --git a/contrib/lisp/org-static-mathjax.el b/contrib/lisp/org-static-mathjax.el new file mode 100644 index 000000000..6a9f0ecb2 --- /dev/null +++ b/contrib/lisp/org-static-mathjax.el @@ -0,0 +1,171 @@ +;;; org-static-mathjax.el --- Muse-like tags in Org-mode +;; +;; Author: Jan Böker <jan dot boecker at jboecker dot de> + +;; This elisp code integrates Static MathJax into the +;; HTML export process of Org-mode. +;; +;; The supporting files for this package are in contrib/scripts/staticmathjax +;; Please read the README.org file in that directory for more information. + +;; To use it, evaluate it on startup, add the following to your .emacs: + +;; (require 'org-static-mathjax) +;; +;; You will then have to customize the following two variables: +;; - org-static-mathjax-app-ini-path +;; - org-static-mathjax-local-mathjax-path +;; +;; If xulrunner is not in your $PATH, you will also need to customize +;; org-static-mathjax-xulrunner-path. +;; +;; If everything is setup correctly, you can trigger Static MathJax on +;; export to HTML by adding the following line to your Org file: +;; #+StaticMathJax: embed-fonts:nil output-file-name:"embedded-math.html" +;; +;; You can omit either argument. +;; embed-fonts defaults to nil. If you do not specify output-file-name, +;; the exported file is overwritten with the static version. +;; +;; If embed-fonts is non-nil, the fonts are embedded directly into the +;; output file using data: URIs. +;; +;; output-file-name specifies the file name of the static version. You +;; can use any arbitrary lisp form here, for example: +;; output-file-name:(concat (file-name-sans-extension buffer-file-name) "-static.html") +;; +;; The StaticMathJax XULRunner application expects a UTF-8 encoded +;; input file. If the static version displays random characters instead +;; of your math, add the following line at the top of your Org file: +;; -*- coding: utf-8; -*- +;; +;; License: GPL v2 or later + +(defcustom org-static-mathjax-app-ini-path + (or (expand-file-name + "../scripts/staticmatchjax/application.ini" + (file-name-directory (or load-file-name buffer-file-name))) + "") + "Path to \"application.ini\" of the Static MathJax XULRunner application. +If you have extracted StaticMathJax to e.g. ~/.local/staticmathjax, set +this to ~/.local/staticmathjax/application.ini" + :type 'string) + +(defcustom org-static-mathjax-xulrunner-path + "xulrunner" + "Path to your xulrunner binary" + :type 'string) + +(defcustom org-static-mathjax-local-mathjax-path + "" + "Extract the MathJax zip file somewhere on your local +hard drive and specify the path here. + +The directory has to be writeable, as org-static-mathjax +creates a temporary file there during export." + :type 'string) + +(defvar org-static-mathjax-debug + nil + "If non-nil, org-static-mathjax will print some debug messages") + +(defun org-static-mathjax-hook-installer () + "Installs org-static-mathjax-process in after-save-hook. + +Sets the following buffer-local variables for org-static-mathjax-process to pick up: +org-static-mathjax-mathjax-path: The path to MathJax.js as used by Org HTML export +org-static-mathjax-options: The string given with #+STATICMATHJAX: in the file" + (let ((static-mathjax-option-string (plist-get opt-plist :static-mathjax))) + (if static-mathjax-option-string + (progn (set (make-local-variable 'org-static-mathjax-options) static-mathjax-option-string) + (set (make-local-variable 'org-static-mathjax-mathjax-path) + (nth 1 (assq 'path org-export-html-mathjax-options))) + (let ((mathjax-options (plist-get opt-plist :mathjax))) + (if mathjax-options + (if (string-match "\\<path:" mathjax-options) + (set 'org-static-mathjax-mathjax-path + (car (read-from-string + (substring mathjax-options (match-end 0)))))))) + (add-hook 'after-save-hook + 'org-static-mathjax-process + nil t))))) + + +(defun org-static-mathjax-process () + (save-excursion + ; some sanity checking + (if (or (string= org-static-mathjax-app-ini-path "") + (not (file-exists-p org-static-mathjax-app-ini-path))) + (error "Static MathJax: You must customize org-static-mathjax-app-ini-path!")) + (if (or (string= org-static-mathjax-local-mathjax-path "") + (not (file-exists-p org-static-mathjax-local-mathjax-path))) + (error "Static MathJax: You must customize org-static-mathjax-local-mathjax-path!")) + + ; define variables + (let* ((options org-static-mathjax-options) + (output-file-name buffer-file-name) + (input-file-name (let ((temporary-file-directory (file-name-directory org-static-mathjax-local-mathjax-path))) + (make-temp-file "org-static-mathjax-" nil ".html"))) + (html-code (buffer-string)) + (mathjax-oldpath (concat "src=\"" org-static-mathjax-mathjax-path)) + (mathjax-newpath (concat "src=\"" org-static-mathjax-local-mathjax-path)) + embed-fonts) + ; read file-local options + (mapc + (lambda (symbol) + (if (string-match (concat "\\<" (symbol-name symbol) ":") options) + (set symbol (eval (car (read-from-string + (substring options (match-end 0)))))))) + '(embed-fonts output-file-name)) + + ; debug + (when org-static-mathjax-debug + (message "output file name, embed-fonts") + (print output-file-name) + (print embed-fonts)) + + ; open (temporary) input file, copy contents there, replace MathJax path with local installation + (with-temp-buffer + (insert html-code) + (goto-char 1) + (replace-regexp mathjax-oldpath mathjax-newpath) + (write-file input-file-name)) + + ; prepare argument list for call-process + (let ((call-process-args (list org-static-mathjax-xulrunner-path + nil nil nil + org-static-mathjax-app-ini-path + input-file-name + output-file-name))) + ; if fonts are embedded, just append the --embed-fonts flag + (if embed-fonts + (add-to-list 'call-process-args "--embed-fonts" t)) + ; if fonts are not embedded, the XULRunner app must replace all references + ; to the font files with the real location (Firefox inserts file:// URLs there, + ; because we are using a local MathJax installation here) + (if (not embed-fonts) + (progn + (add-to-list 'call-process-args "--final-mathjax-url" t) + (add-to-list 'call-process-args + (file-name-directory org-static-mathjax-mathjax-path) + t))) + + ; debug + (when org-static-mathjax-debug + (print call-process-args)) + ; call it + (apply 'call-process call-process-args) + ; delete our temporary input file + (kill-buffer) + (delete-file input-file-name) + (let ((backup-file (concat input-file-name "~"))) + (if (file-exists-p backup-file) + (delete-file backup-file))))))) + +(add-to-list 'org-export-inbuffer-options-extra +'("STATICMATHJAX" :static-mathjax)) + +(add-hook 'org-export-html-final-hook 'org-static-mathjax-hook-installer) + + +(provide 'org-static-mathjax) diff --git a/contrib/scripts/staticmathjax/.gitignore b/contrib/scripts/staticmathjax/.gitignore new file mode 100644 index 000000000..b25c15b81 --- /dev/null +++ b/contrib/scripts/staticmathjax/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/contrib/scripts/staticmathjax/README.org b/contrib/scripts/staticmathjax/README.org new file mode 100644 index 000000000..d28fc9012 --- /dev/null +++ b/contrib/scripts/staticmathjax/README.org @@ -0,0 +1,79 @@ +Static MathJax v0.1 README +#+AUTHOR: Jan Böcker <jan.boecker@jboecker.de> + +Static MathJax is a XULRunner application which loads a HTML input +file that uses MathJax into a browser, waits until MathJax is done +processing, and then writes the formatted result to an output HTML +file. + +I have only tested exports from Emacs Org-mode as input files. (As of +2010-08-14, MathJax is used by default with HTML exports in the +current Org development version.) + +Optionally, references to the math fonts used will be converted to +"data:" URIs, thus embedding the font data into the HTML file itself. +(see [[http://en.wikipedia.org/wiki/Data_URI_scheme]]) + +The code is licensed under the GNU General Public License version +2, or, at your option, any later version. + + +* Usage + To run Static MathJax, an existing XULRunner installation is + required. From the directory to which you unpacked Static MathJax, + run: + + xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>> + <input file> <output file> + + If you prefer to call "staticmathjax" instead of "xulrunner + application.ini", link xulrunner-stub into the directory: + ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax + + - input file :: + name of the input file (the result of a HTML export + from Org-mode). It is assumed that this file uses the + UTF-8 character encoding. + + - output file :: + name of the output file. + + - --embed-fonts :: + if specified, the math fonts will be embedded into + the output file using data: URIs + + - --final-mathjax-url <URL> :: + if --embed-fonts is not specified, this + must be the URL to a MathJax installation folder (e.g. "MathJax" + if MathJax is installed in a subdirectory, or + "http://orgmode.org/mathjax" to use the version hosted on the Org + website. + + All references to math fonts in the output file will point to + this directory. + +* Caveats + + The input file must not use a MathJax installation on the + web. Otherwise, due to a security feature of Firefox, MathJax will + fallback to image fonts. If you have unpacked MathJax to a + subdirectory "MathJax", specify the following in your Org file: + + #+MathJax: path:"MathJax" + + The math is rendered in Firefox, so MathJax applies its + Firefox-specific settings. When viewing the output files in other + browsers, it will look slightly different than the result that + running MathJax in that browser would produce. + + Internet Explorer does not use the correct font, because it only + supports the EOT font format. For all other browsers (including + Firefox), MathJax uses the OTF font format. + + Embedding fonts into the HTML file wastes some space due to the + base64 encoding used in data: URIs. + + I have found no way to access stdout or set an exit code in an + XULRunner app, so any code which calls Static MathJax has no idea if + processing was successful and when an error occurs, graphical + message boxes are displayed. diff --git a/contrib/scripts/staticmathjax/README.txt b/contrib/scripts/staticmathjax/README.txt new file mode 100644 index 000000000..cbcaea117 --- /dev/null +++ b/contrib/scripts/staticmathjax/README.txt @@ -0,0 +1,91 @@ + Static MathJax v0.1 README + ========================== + +Author: Jan Böcker <jan.boecker@jboecker.de> +Date: 2010-08-15 13:53:39 CEST + + +Static MathJax is a XULRunner application which loads a HTML input +file that uses MathJax into a browser, waits until MathJax is done +processing, and then writes the formatted result to an output HTML +file. + +I have only tested exports from Emacs Org-mode as input files. (As of +2010-08-14, MathJax is used by default with HTML exports in the +current Org development version.) + +Optionally, references to the math fonts used will be converted to +"data:" URIs, thus embedding the font data into the HTML file itself. +(see [http://en.wikipedia.org/wiki/Data_URI_scheme]) + +The code is licensed under the GNU General Public License version +2, or, at your option, any later version. + + +Table of Contents +================= +1 Usage +2 Caveats + + +1 Usage +~~~~~~~~ + To run Static MathJax, an existing XULRunner installation is + required. From the directory to which you unpacked Static MathJax, + run: + + xulrunner application.ini <--embed-fonts | --final-mathjax-url <URL>> + <input file> <output file> + + If you prefer to call "staticmathjax" instead of "xulrunner + application.ini", link xulrunner-stub into the directory: + ln /usr/lib/xulrunner-1.9.2.8/xulrunner-stub ./staticmathjax + + input file: + name of the input file (the result of a HTML export + from Org-mode). It is assumed that this file uses the + UTF-8 character encoding. + + output file: + name of the output file. + + --embed-fonts: + if specified, the math fonts will be embedded into + the output file using data: URIs + + --final-mathjax-url <URL>: + if --embed-fonts is not specified, this + must be the URL to a MathJax installation folder (e.g. "MathJax" + if MathJax is installed in a subdirectory, or + "[http://orgmode.org/mathjax]" to use the version hosted on the Org + website. + + All references to math fonts in the output file will point to + this directory. + +2 Caveats +~~~~~~~~~~ + + The input file must not use a MathJax installation on the + web. Otherwise, due to a security feature of Firefox, MathJax will + fallback to image fonts. If you have unpacked MathJax to a + subdirectory "MathJax", specify the following in your Org file: + + #+MathJax: path:"MathJax" + + The math is rendered in Firefox, so MathJax applies its + Firefox-specific settings. When viewing the output files in other + browsers, it will look slightly different than the result that + running MathJax in that browser would produce. + + Internet Explorer does not use the correct font, because it only + supports the EOT font format. For all other browsers (including + Firefox), MathJax uses the OTF font format. + + Embedding fonts into the HTML file wastes some space due to the + base64 encoding used in data: URIs. + + I have found no way to access stdout or set an exit code in an + XULRunner app, so any code which calls Static MathJax has no idea if + processing was successful and when an error occurs, graphical + message boxes are displayed. diff --git a/contrib/scripts/staticmathjax/application.ini b/contrib/scripts/staticmathjax/application.ini new file mode 100644 index 000000000..d7957b0ec --- /dev/null +++ b/contrib/scripts/staticmathjax/application.ini @@ -0,0 +1,11 @@ +[App] +Vendor=Jan Boecker +Name=StaticMathJax +Version=0.2 +BuildID=2 +Copyright=Copyright (c) 2010 Jan Boecker +ID=xulapp@jboecker.de + +[Gecko] +MinVersion=1.8 + diff --git a/contrib/scripts/staticmathjax/chrome/chrome.manifest b/contrib/scripts/staticmathjax/chrome/chrome.manifest new file mode 100644 index 000000000..a05d8c8ff --- /dev/null +++ b/contrib/scripts/staticmathjax/chrome/chrome.manifest @@ -0,0 +1 @@ +content staticmathjax file:content/ diff --git a/contrib/scripts/staticmathjax/chrome/content/main.js b/contrib/scripts/staticmathjax/chrome/content/main.js new file mode 100644 index 000000000..2e71f3b24 --- /dev/null +++ b/contrib/scripts/staticmathjax/chrome/content/main.js @@ -0,0 +1,198 @@ +var docFrame; +var logtextbox; +var destFile; +var embedFonts = false; +var finalMathJaxURL = null; + +function log(text) +{ + logtextbox.setAttribute("value", logtextbox.getAttribute("value") + "\n" + text); +} + +function init() +{ + try { + docFrame = document.getElementById("docFrame"); + logtextbox = document.getElementById("logtextbox"); + + // parse command line arguments + var cmdLine = window.arguments[0]; + cmdLine = cmdLine.QueryInterface(Components.interfaces.nsICommandLine); + + embedFonts = cmdLine.handleFlag("embed-fonts", false); + finalMathJaxURL = cmdLine.handleFlagWithParam("final-mathjax-url", false); + + if (!embedFonts && !finalMathJaxURL) { + alert("You must eiher specify --embed-fonts or --final-mathjax-url"); + window.close(); + return; + } + + sourceFilePath = cmdLine.getArgument(0); + destFilePath = cmdLine.getArgument(1); + if ( !sourceFilePath || !destFilePath ) { + alert("Not enough parameters, expecting two arguments:\nInput file, output file"); + window.close(); + return; + } + + sourceFile = cmdLine.resolveFile(sourceFilePath); + if (! (sourceFile.exists() && sourceFile.isFile()) ) { + alert("Invalid source file path."); + window.close(); + return; + } + sourceURI = cmdLine.resolveURI(sourceFilePath); + + // create a nsIFile object for the output file + try{ + destFile = cmdLine.resolveURI(destFilePath).QueryInterface(Components.interfaces.nsIFileURL).file; + }catch(e){ + alert("Invalid destination file.\n\nException:\n" + e); + window.close(); + return; + } + + // add iframeLoaded() as an onload event handler, then navigate to the source file + docFrame.addEventListener("DOMContentLoaded", iframeLoaded, true); + docFrame.setAttribute("src", sourceURI.spec); + + } catch (e) { + alert("Error in init():\n\n" + e); + window.close(); + return; + } +} + +function iframeLoaded() +{ + /* + // print every MathJax signal to the log + docFrame.contentWindow.MathJax.Hub.Startup.signal.Interest( + function (message) {log("Startup: "+message)} + ); + docFrame.contentWindow.MathJax.Hub.signal.Interest( + function (message) {log("Hub: "+message)} + ); + */ + + // tell MathJax to call serialize() when finished + docFrame.contentWindow.MathJax.Hub.Register.StartupHook("End", function() {serialize();}); +} + +function fileURLtoDataURI(url) +{ + var ios = Components.classes["@mozilla.org/network/io-service;1"] + .getService(Components.interfaces.nsIIOService); + var url_object = ios.newURI(url, "", null); + var file = url_object.QueryInterface(Components.interfaces.nsIFileURL).file; + + var data = ""; + var fstream = Components.classes["@mozilla.org/network/file-input-stream;1"]. + createInstance(Components.interfaces.nsIFileInputStream); + fstream.init(file, -1, -1, false); + var bstream = Components.classes["@mozilla.org/binaryinputstream;1"]. + createInstance(Components.interfaces.nsIBinaryInputStream); + bstream.setInputStream(fstream); + + var bytes = bstream.readBytes(bstream.available()); + b64bytes = btoa(bytes); + + return "data:;base64," + b64bytes; + +} + +function serialize() +{ + var MathJaxURL = docFrame.contentWindow.MathJax.Hub.config.root; + + var searchURIList = new Array(); + var replacementURIList = new Array(); + + log("serialize: preprocessing"); + + // remove the MathJax status message window + msgdiv = docFrame.contentDocument.getElementById("MathJax_Message"); + msgdiv.parentNode.removeChild(msgdiv); + + /* Loop through all CSS rules to find all @font-face rules. + At this point, they refer to local absolute paths using file:// URLs. + Replace them either with appropriate URLs relative to finalMathJaxURL + or with data URIs. */ + + for (var i = 0; i<docFrame.contentDocument.styleSheets.length; i++) { + var stylesheet = docFrame.contentDocument.styleSheets[i]; + + for (var j=0; j< stylesheet.cssRules.length; j++) { + var rule = stylesheet.cssRules[j]; + if (rule.cssText.match("font-face")) { + + url = rule.style.getPropertyValue("src"); + url = url.match(/url\(\"(.+)\"\)/)[1]; + + // Since the properties seem read-only here, we populate + // searchURIList and replacementURIList to do text substitution + // after serialization + searchURIList.push(url); + if (embedFonts) { + replacementURIList.push(fileURLtoDataURI(url)); + } else { + replacementURIList.push(url.replace(MathJaxURL, finalMathJaxURL)); + } + } + } + } + + + // find and remove the MathJax <script> tag + try{ + var scriptTags = docFrame.contentDocument.getElementsByTagName("script"); + for (var i=0; i<scriptTags.length; i++) { + if (scriptTags[i].getAttribute("src") && scriptTags[i].getAttribute("src").match(/MathJax.js/i)) + scriptTags[i].parentNode.removeChild(scriptTags[i]); + } + }catch(e){alert(e);} + + log("serialize: serializing"); + + var serializer = new XMLSerializer(); + var xhtml = serializer.serializeToString(docFrame.contentDocument); + + log("serialize: postprocessing"); + // make the MathJax URL relative again + // xhtml = xhtml.replace(findMathJaxURL, "MathJax"); + + try{ + r1 = RegExp("<!--/\\*--><!\\[CDATA\\[/\\*><!--\\*/", "g"); + xhtml = xhtml.replace(r1, ""); + r2 = RegExp("/\\*\\]\\]>\\*/-->", "g"); + xhtml = xhtml.replace(r2, ""); + r3 = RegExp("/\\*\\]\\]>\\*///-->", "g"); + xhtml = xhtml.replace(r3, ""); + }catch(e){alert(e);} + for (var i=0; i<searchURIList.length; i++) + xhtml = xhtml.replace(searchURIList[i], replacementURIList[i]); + + save(xhtml); + window.close(); +} + +function save(xhtml) +{ + try { + var foStream = Components.classes["@mozilla.org/network/file-output-stream;1"]. + createInstance(Components.interfaces.nsIFileOutputStream); + + foStream.init(destFile, 0x02 | 0x08 | 0x20, 0666, 0); + // write, create, truncate + + // write in UTF-8 encoding + var converter = Components.classes["@mozilla.org/intl/converter-output-stream;1"]. + createInstance(Components.interfaces.nsIConverterOutputStream); + converter.init(foStream, "UTF-8", 0, 0); + converter.writeString(xhtml); + converter.close(); // this closes foStream + } catch (e) { + alert("Error in save():\n\n" + e); + } +} diff --git a/contrib/scripts/staticmathjax/chrome/content/main.xul b/contrib/scripts/staticmathjax/chrome/content/main.xul new file mode 100644 index 000000000..35a00f248 --- /dev/null +++ b/contrib/scripts/staticmathjax/chrome/content/main.xul @@ -0,0 +1,11 @@ +<?xml version="1.0"?> +<?xml-stylesheet href="chrome://global/skin/" type="text/css"?> + +<window onload="init();" id="main" title="Static MathJax" width="300" height="300" +xmlns="http://www.mozilla.org/keymaster/gatekeeper/there.is.only.xul"> + +<script language="JavaScript" src="chrome://staticmathjax/content/main.js"/> + + <browser flex="1" id="docFrame" src="" style="background-color:white;"/> + <textbox flex="1" id="logtextbox" multiline="true" style="display:none;"/> +</window> diff --git a/contrib/scripts/staticmathjax/defaults/preferences/prefs.js b/contrib/scripts/staticmathjax/defaults/preferences/prefs.js new file mode 100644 index 000000000..0532ce085 --- /dev/null +++ b/contrib/scripts/staticmathjax/defaults/preferences/prefs.js @@ -0,0 +1 @@ +pref("toolkit.defaultChromeURI", "chrome://staticmathjax/content/main.xul"); From 557ce7c01cafec92561d23e5b572b03c53d3c3d7 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 20 Aug 2010 18:24:09 +0200 Subject: [PATCH 045/348] Revert "Search for LaTeX setup case-insensitively" This reverts commit 034dbac3eecdd67c83407f55cd920d3720400055. --- lisp/org-beamer.el | 8 +++----- lisp/org-latex.el | 10 +++------- 2 files changed, 6 insertions(+), 12 deletions(-) diff --git a/lisp/org-beamer.el b/lisp/org-beamer.el index ea3a3f9ce..2631e7065 100644 --- a/lisp/org-beamer.el +++ b/lisp/org-beamer.el @@ -438,10 +438,8 @@ The effect is that these values will be accessible during export." (save-restriction (widen) (goto-char (point-min)) - (and (let ((case-fold-search t)) - (re-search-forward - "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" - nil t)) + (and (re-search-forward + "^#\\+BEAMER_FRAME_LEVEL:[ \t]*\\(.*?\\)[ \t]*$" nil t) (match-string 1)))) (plist-get org-export-latex-options-plist :beamer-frame-level) org-beamer-frame-level)) @@ -463,7 +461,7 @@ The effect is that these values will be accessible during export." (save-excursion (save-restriction (widen) - (let ((txt "") (case-fold-search t)) + (let ((txt "")) (goto-char (point-min)) (while (re-search-forward "^#\\+BEAMER_HEADER_EXTRA:[ \t]*\\(.*?\\)[ \t]*$" diff --git a/lisp/org-latex.el b/lisp/org-latex.el index b58766689..4f27f425a 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -1124,9 +1124,7 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (let ((case-fold-search t)) - (re-search-forward - "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t)) + (and (re-search-forward "^#\\+LaTeX_CLASS:[ \t]*\\(-[a-zA-Z]+\\)" nil t) (match-string 1)))) (plist-get org-export-latex-options-plist :latex-class) org-export-latex-default-class) @@ -1140,10 +1138,8 @@ LEVEL indicates the default depth for export." (save-restriction (widen) (goto-char (point-min)) - (and (let ((case-fold-search t)) - (re-search-forward - "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) - (match-string 1))))) + (and (re-search-forward "^#\\+LaTeX_CLASS_OPTIONS:[ \t]*\\(.*?\\)[ \t]*$" nil t) + (match-string 1)))) (plist-get org-export-latex-options-plist :latex-class-options)) org-export-latex-class (or (car (assoc org-export-latex-class org-export-latex-classes)) From adf2e016e0fe392b735393f4c70df7601a6755d0 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Thu, 6 May 2010 14:16:37 -0500 Subject: [PATCH 046/348] Revision to handling of blank lines. Start of declaration protocol. Followed Wes Hardaker's idea of permitting alternative rewrites for blank lines, instead of making the blank line handler be a boolean and hard-wiring a newline character. Also added a declaration form, with type and documentation options, for the keywords used in defining a generic export method. --- contrib/lisp/org-export-generic.el | 27 ++++++++++++++++++++++++++- 1 file changed, 26 insertions(+), 1 deletion(-) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el index 1b099ddae..23ecf9a7f 100644 --- a/contrib/lisp/org-export-generic.el +++ b/contrib/lisp/org-export-generic.el @@ -444,6 +444,31 @@ in this way, it will be wrapped." export definitions." (aput 'org-generic-alist type definition)) +;;; helper functions for org-set-generic-type +(defvar org-export-generic-keywords nil) +(defmacro* def-org-export-generic-keyword (keyword + &key documentation + type) + "Define KEYWORD as a legitimate element for inclusion in +the body of an org-set-generic-type definition." + `(progn + (pushnew ,keyword org-export-generic-keywords) + ;; TODO: push the documentation and type information + ;; somewhere where it will do us some good. + )) + +(def-org-export-generic-keyword :body-newline-paragraph + :documentation "Bound either to NIL or to a pattern to be +inserted in the output for every blank line in the input. + The intention is to handle formats where text is flowed, and +newlines are interpreted as significant \(e.g., as indicating +preformatted text\). A common non-nil value for this keyword +is \"\\n\". Should typically be combined with a value for +:body-line-format that does NOT end with a newline." + :type string)) + + + (defun org-export-generic-remember-section (type suffix &optional prefix) (setq org-export-generic-section-type type) (setq org-export-generic-section-suffix suffix) @@ -946,7 +971,7 @@ underlined headlines. The default is 3." ((string-match "^\\s-*$" line) ;; blank line (if bodynewline-paragraph - (insert "\n"))) + (insert bodynewline-paragraph))) (t ;; ;; body From dedea0721c0f65fbcca416b5c2936023afc062f3 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Sun, 9 May 2010 10:20:15 -0500 Subject: [PATCH 047/348] Make newline-handling more flexible (per WH), declare keywords. Followed Wes Hardaker's suggestion to make the translation of newlines more flexible --- instead of making a boolean for special translation of blank lines, I added the ability to specify the translation. Also added a macro for declaring generic translation keywords with type information and documentation. Hope this will make the generic translator easier to use. --- contrib/lisp/org-export-generic.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el index 23ecf9a7f..0933f19bf 100644 --- a/contrib/lisp/org-export-generic.el +++ b/contrib/lisp/org-export-generic.el @@ -465,7 +465,7 @@ newlines are interpreted as significant \(e.g., as indicating preformatted text\). A common non-nil value for this keyword is \"\\n\". Should typically be combined with a value for :body-line-format that does NOT end with a newline." - :type string)) + :type string) From daa6f98cab1b7578c90c5ca5a9b6c0b695a330df Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Thu, 20 May 2010 21:49:32 -0500 Subject: [PATCH 048/348] Partial solution to the fontification problem. Having some trouble with the MATCH-STRING calls, but mostly ok. --- contrib/lisp/org-export-generic.el | 105 +++++++++++++++++++++++++++-- 1 file changed, 101 insertions(+), 4 deletions(-) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el index 0933f19bf..3a7af40ad 100644 --- a/contrib/lisp/org-export-generic.el +++ b/contrib/lisp/org-export-generic.el @@ -1,4 +1,4 @@ -;;; org-export-generic.el --- Export frameworg with custom backends +;; org-export-generic.el --- Export frameworg with custom backends ;; Copyright (C) 2009 Free Software Foundation, Inc. @@ -466,6 +466,15 @@ preformatted text\). A common non-nil value for this keyword is \"\\n\". Should typically be combined with a value for :body-line-format that does NOT end with a newline." :type string) + +;;; fontification keywords +(def-org-export-generic-keyword :bold-format) +(def-org-export-generic-keyword :italic-format) +(def-org-export-generic-keyword :underline-format) +(def-org-export-generic-keyword :strikethrough-format) +(def-org-export-generic-keyword :code-format) +(def-org-export-generic-keyword :verbatim-format) + @@ -623,6 +632,7 @@ underlined headlines. The default is 3." :verbatim-multiline t :select-tags (plist-get export-plist :select-tags-export) :exclude-tags (plist-get export-plist :exclude-tags-export) + :emph-multiline t :archived-trees (plist-get export-plist :archived-trees-export) :add-text (plist-get opt-plist :text)) @@ -671,6 +681,16 @@ underlined headlines. The default is 3." (bodylineform (or (plist-get export-plist :body-line-format) "%s")) (blockquotestart (or (plist-get export-plist :blockquote-start) "\n\n\t")) (blockquoteend (or (plist-get export-plist :blockquote-end) "\n\n")) + + ;; dynamic variables used heinously in fontification + ;; not referenced locally... + (format-boldify (plist-get export-plist :bold-format)) + (format-italicize (plist-get export-plist :italic-format)) + (format-underline (plist-get export-plist :underline-format)) + (format-strikethrough (plist-get export-plist :strikethrough-format)) + (format-code (plist-get export-plist :code-format)) + (format-verbatim (plist-get export-plist :verbatim-format)) + thetoc toctags have-headings first-heading-pos @@ -854,7 +874,7 @@ underlined headlines. The default is 3." (if org-export-generic-links-to-notes (push (cons desc0 link) link-buffer) (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0) line)) + wrap (+ (length line) (- (length (match-string 0 line))) (length desc))))) (setq line (replace-match rpl t t line)))) (when custom-times @@ -936,7 +956,7 @@ underlined headlines. The default is 3." listcheckhalfend))) ) - (insert (format listformat line))) + (insert (format listformat (org-export-generic-fontify line)))) ((string-match "^\\([ \t]+\\)\\([0-9]+\\.[ \t]*\\)" line) ;; ;; numbered list item @@ -962,7 +982,7 @@ underlined headlines. The default is 3." listcheckhalfend))) ) - (insert (format numlistformat line))) + (insert (format numlistformat (org-export-generic-fontify line)))) ((equal line "ORG-BLOCKQUOTE-START") (setq line blockquotestart)) @@ -978,6 +998,9 @@ underlined headlines. The default is 3." ;; (org-export-generic-check-section "body" bodytextpre bodytextsuf) + (setq line + (org-export-generic-fontify line)) + ;; XXX: properties? list? (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) (setq line (replace-match "\\1\\3:" t nil line))) @@ -1284,6 +1307,80 @@ REVERSE means to reverse the list if the plist match is a list (and vl (setcar vl nil)) vl)) + +;;; FIXME: this should probably turn into a defconstant later [2010/05/20:rpg] +(defvar org-export-generic-emphasis-alist + '(("*" format-boldify nil) + ("/" format-italicize nil) + ("_" format-underline nil) + ("+" format-strikethrough nil) + ("=" format-code t) + ("~" format-verbatim t)) + "Alist of org format -> formatting variables for fontification. +Each element of the list is a list of three elements. +The first element is the character used as a marker for fontification. +The second element is a variable name, set in org-export-generic. That +variable will be dereferenced to obtain a formatting string to wrap +fontified text with. +The third element decides whether to protect converted text from other +conversions.") + +;;; Cargo-culted from the latex translation. I couldn't figure out how +;;; to keep the structure since the generic export operates on lines, rather +;;; than on a buffer as in the latex export, meaning that none of the +;;; search forward code could be kept. This led me to rewrite the +;;; whole thing recursively. A huge lose for efficiency (potentially), +;;; but I couldn't figure out how to make the looping work. +;;; Worse, it's /doubly/ recursive, because this function calls +;;; org-export-generic-emph-format, which can call it recursively... +;;; [2010/05/20:rpg] +(defun org-export-generic-fontify (string) + "Convert fontification according to generic rules." + (if (string-match org-emph-re string) + ;; The match goes one char after the *string*, except at the end of a line + + ;; as far as I can tell from cargo-culting the code from + ;; the latex translation, we have the following: + ;; (match-string 1) is the material BEFORE the match + ;; -- should be unchanged + ;; (match-string 3) is the actual markup character + ;; (match-string 4) is the material that is to be + ;; marked up + ;; (match-string 5) is the remainder + (let ((emph (assoc (match-string 3 string) + org-export-generic-emphasis-alist)) + (beg (match-beginning 0))) + (unless emph + (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\"" + (match-string 3 string))) + ;; now we need to determine whether we have strikethrough or + ;; a list, which is a bit nasty + (if (and (equal (match-string 3 str) "+") + (save-match-data + (string-match "\\`-+\\'" (match-string 4 str)))) + ;; a list --- skip this match and recurse + (concat (substring str 0 (match-beginning 3)) + (org-export-generic-fontify (substring str (match-beginning 3)))) + (concat (substring str 0 beg) + (match-string 1 string) + (org-export-generic-emph-format (second emph) + (match-string 4 string) + (third emph)) + (org-export-generic-fontify (match-string 5 string))))) + string)) + +(defun org-export-generic-emph-format (format-varname string protect) + "Return a string that results from applying the markup indicated by +FORMAT-VARNAME to STRING." + (let ((format (symbol-value format-varname))) + (let ((string-to-emphasize + (if protect + string + (org-export-generic-fontify string)))) + (if format + (format format string-to-emphasize) + string-to-emphasize)))) + (provide 'org-generic) (provide 'org-export-generic) From e439e4da27ed52418190203ecd564fa57c0fcc59 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Fri, 21 May 2010 09:14:09 -0500 Subject: [PATCH 049/348] Substantially improved org-export-generic-fontify based on help from Carsten. --- contrib/lisp/org-export-generic.el | 28 +++++++++++----------------- 1 file changed, 11 insertions(+), 17 deletions(-) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el index 3a7af40ad..114769b47 100644 --- a/contrib/lisp/org-export-generic.el +++ b/contrib/lisp/org-export-generic.el @@ -1338,35 +1338,29 @@ conversions.") "Convert fontification according to generic rules." (if (string-match org-emph-re string) ;; The match goes one char after the *string*, except at the end of a line - - ;; as far as I can tell from cargo-culting the code from - ;; the latex translation, we have the following: - ;; (match-string 1) is the material BEFORE the match - ;; -- should be unchanged - ;; (match-string 3) is the actual markup character - ;; (match-string 4) is the material that is to be - ;; marked up - ;; (match-string 5) is the remainder (let ((emph (assoc (match-string 3 string) org-export-generic-emphasis-alist)) - (beg (match-beginning 0))) + (beg (match-beginning 0)) + (end (match-end 0))) (unless emph (message "`org-export-generic-emphasis-alist' has no entry for formatting triggered by \"%s\"" (match-string 3 string))) ;; now we need to determine whether we have strikethrough or ;; a list, which is a bit nasty - (if (and (equal (match-string 3 str) "+") + (if (and (equal (match-string 3 string) "+") (save-match-data - (string-match "\\`-+\\'" (match-string 4 str)))) - ;; a list --- skip this match and recurse - (concat (substring str 0 (match-beginning 3)) - (org-export-generic-fontify (substring str (match-beginning 3)))) - (concat (substring str 0 beg) + (string-match "\\`-+\\'" (match-string 4 string)))) + ;; a list --- skip this match and recurse on the point after the + ;; first emph char... + (concat (substring string 0 (1+ (match-beginning 3))) + (org-export-generic-fontify (substring string (match-beginning 3)))) + (concat (substring string 0 beg) ;; part before the match (match-string 1 string) (org-export-generic-emph-format (second emph) (match-string 4 string) (third emph)) - (org-export-generic-fontify (match-string 5 string))))) + (or (match-string 5 string) "") + (org-export-generic-fontify (substring string end))))) string)) (defun org-export-generic-emph-format (format-varname string protect) From 06034b9813e57530a8ce1dc3efc3ddb814bccc1a Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Mon, 24 May 2010 09:01:22 -0500 Subject: [PATCH 050/348] Expanded docstring for org-emph-re --- lisp/org.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/org.el b/lisp/org.el index e34ec1a67..366c8dd21 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -3321,6 +3321,8 @@ When nil, the \\name form remains in the buffer." (defvar org-emph-re nil "Regular expression for matching emphasis. After a match, the match groups contain these elements: +0 The match of the full regular expression, including the characters + before and after the proper match 1 The character before the proper match, or empty at beginning of line 2 The proper match, including the leading and trailing markers 3 The leading marker like * or /, indicating the type of highlighting From ee736317cb2ec33e9eda63821182e5a08eea3566 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Tue, 25 May 2010 09:08:04 -0500 Subject: [PATCH 051/348] Add a test code file. --- contrib/lisp/test-org-export-preproc.el | 39 +++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 contrib/lisp/test-org-export-preproc.el diff --git a/contrib/lisp/test-org-export-preproc.el b/contrib/lisp/test-org-export-preproc.el new file mode 100644 index 000000000..3af846154 --- /dev/null +++ b/contrib/lisp/test-org-export-preproc.el @@ -0,0 +1,39 @@ +(require 'org-export-generic) + +(defun test-preproc () + (interactive) + (let ((string + (let ((region + (buffer-substring + (if (org-region-active-p) (region-beginning) (point-min)) + (if (org-region-active-p) (region-end) (point-max)))) + (opt-plist (org-combine-plists (org-default-export-plist) + (org-infile-export-plist))) + (export-plist '("tikiwiki" :file-suffix ".txt" :key-binding 85 :header-prefix "" :header-suffix "" :title-format "-= %s =-\n" :date-export nil :toc-export nil :body-header-section-numbers nil :body-section-prefix "\n" :body-section-header-prefix + ("! " "!! " "!!! " "!!!! " "!!!!! " "!!!!!! " "!!!!!!! ") + :body-section-header-suffix + (" \n" " \n" " \n" " \n" " \n" " \n") + :body-line-export-preformated t :body-line-format "%s " :body-line-wrap nil :body-line-fixed-format " %s\n" :body-list-format "* %s\n" :body-number-list-format "# %s\n" :blockquote-start "\n^\n" :blockquote-end "^\n\n" :body-newline-paragraph "\n" :bold-format "__%s__" :italic-format "''%s''" :underline-format "===%s===" :strikethrough-format "--%s--" :code-format "-+%s+-" :verbatim-format "~pp~%s~/pp~"))) + (org-export-preprocess-string + region + :for-ascii t + :skip-before-1st-heading + (plist-get opt-plist :skip-before-1st-heading) + :drawers (plist-get export-plist :drawers-export) + :tags (plist-get export-plist :tags-export) + :priority (plist-get export-plist :priority-export) + :footnotes (plist-get export-plist :footnotes-export) + :timestamps (plist-get export-plist :timestamps-export) + :todo-keywords (plist-get export-plist :todo-keywords-export) + :verbatim-multiline t + :select-tags (plist-get export-plist :select-tags-export) + :exclude-tags (plist-get export-plist :exclude-tags-export) + :emph-multiline t + :archived-trees + (plist-get export-plist :archived-trees-export) + :add-text (plist-get opt-plist :text))))) + (save-excursion + (switch-to-buffer "*preproc-temp*") + (point-max) + (insert string)))) + From e50657d7cb33b3778a74b6864c1a4ebe8fc55d4d Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" <rpgoldman@real-time.com> Date: Sun, 30 May 2010 15:30:11 -0500 Subject: [PATCH 052/348] Added a call to insert any bodynewline-paragraph value before the start of a line item. --- contrib/lisp/org-export-generic.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/contrib/lisp/org-export-generic.el b/contrib/lisp/org-export-generic.el index 114769b47..f8e8c4afe 100644 --- a/contrib/lisp/org-export-generic.el +++ b/contrib/lisp/org-export-generic.el @@ -932,9 +932,13 @@ underlined headlines. The default is 3." (string-match "^\\([ \t]+\\)\\(\\*[ \t]*\\)" line)) ;; ;; plain list item - ;; ;; TODO: nested lists ;; + ;; first add a line break between any previous paragraph or line item and this + ;; one + (when bodynewline-paragraph + (insert bodynewline-paragraph)) + ;; I believe this gets rid of leading whitespace. (setq line (replace-match "" nil nil line)) From 96bacc020bef95861543b34985c2cc1190fb918c Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Sat, 21 Aug 2010 07:09:20 +0200 Subject: [PATCH 053/348] Fix adding context lines in agenda * lisp/org-agenda.el (org-agenda-add-entry-text): Make sure we move forward even if there is no text to be added. Adding entry text with org-agenda-add-entry-text-maxlines greater than 0 could result in an infinite loop. --- lisp/org-agenda.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 117b0bbf1..4bf38c6c2 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2627,7 +2627,9 @@ Drawers will be excluded, also the line with scheduling/deadline info." (setq txt (org-agenda-get-some-entry-text m org-agenda-add-entry-text-maxlines " > ")) (end-of-line 1) - (if (string-match "\\S-" txt) (insert "\n" txt))))))) + (if (string-match "\\S-" txt) + (insert "\n" txt) + (or (eobp (forward-char 1))))))))) (defun org-agenda-get-some-entry-text (marker n-lines &optional indent &rest keep) From a7660225af1737cc887fc57a2d2fa87ba8975206 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Sat, 21 Aug 2010 08:37:11 +0200 Subject: [PATCH 054/348] Fix code typo --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 4bf38c6c2..44edca5d1 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2629,7 +2629,7 @@ Drawers will be excluded, also the line with scheduling/deadline info." (end-of-line 1) (if (string-match "\\S-" txt) (insert "\n" txt) - (or (eobp (forward-char 1))))))))) + (or (eobp) (forward-char 1)))))))) (defun org-agenda-get-some-entry-text (marker n-lines &optional indent &rest keep) From 9afcc02588e842e5792e65508bb7719355ace352 Mon Sep 17 00:00:00 2001 From: Aidan Kehoe <kehoea@parhasard.net> Date: Sun, 22 Aug 2010 04:17:04 +0000 Subject: [PATCH 055/348] Use integer syntax for the MODE argument to #'set-file-modes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Hello! We need this change to get org-mode compiling with recent XEmacs 21.5. On previous 21.5 and current 21.4, the problem manifests itself at runtime, not compile time, like so: (set-file-modes "/tmp/aidan/foo.el" ?\755) => Wrong type argument: integerp, ?í One old reason to go for the ?\755 syntax instead of the #o755 syntax under GNU Emacs was to be that older versions of GNU Emacs didn’t support #o755, but, to my knowledge, every released GNU Emacs since March 2000 has supported the latter syntax. Best, Aidan Kehoe, the XEmacs project. ChangeLog addition: 2010-08-21 Aidan Kehoe <kehoea@parhasard.net> * ob-tangle.el (org-babel-tangle): Change the MODE argument to #'set-file-modes to use integer, not character syntax, avoiding compile problems with recent XEmacs. --- lisp/ob-tangle.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index a7ba0722a..adc054aad 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -187,7 +187,7 @@ exported source code blocks by language." (insert content) (write-region nil nil file-name)))) ;; if files contain she-bangs, then make the executable - (when she-bang (set-file-modes file-name ?\755)) + (when she-bang (set-file-modes file-name #o755)) ;; update counter (setq block-counter (+ 1 block-counter)) (add-to-list 'path-collector file-name))))) From 784e5f14888dea7ae98029c38e0f45354f310adf Mon Sep 17 00:00:00 2001 From: Jambunathan K <kjambunathan@gmail.com> Date: Mon, 23 Aug 2010 04:11:20 +0000 Subject: [PATCH 056/348] org-store-link: Fix storing of links to headlines in indirect buffers * org.el (org-store-link): Storing of links to headlines in indirect buffers was broken. Fix it. TINYCHANGE Summary: > When org-store-link is invoked on a headline in indirect buffer (as in a > capture buffer), hyperlink gets created to the file and NOT the > headline. This is a bug. > > The attached patch fixes this. > > Setup: > > # ~/.emacs > > (defun my-conversation-id () > (interactive) > > (remove-hook 'org-capture-before-finalize-hook 'my-conversation-id) > > (let ((org-link-to-org-use-id t)) > (call-interactively 'org-store-link) > ) > ) > > # org-capture-templates > > ("x" "Conversations" entry > (file+headline "~/conversation.org" "Conversations") > "%(progn (add-hook 'org-capture-before-finalize-hook 'my-conversation-id) \"\")** Note taken on %U\n %? " :prepend t :empty-lines 1) > > Steps for reproduction: > > Trigger org-capture for the above capture entry. > > Examine conversation.org before/after the patch is applied. Note the > absence/presence of IDs for the captured entry. > > Check for the stored links using C-c C-l. Note the file/headline links. > > # file conversation.org before and after the patch > > * Conversations > > ** Note taken on [2010-08-23 Mon 04:33] > :PROPERTIES: > :ID: 7e1974a6-8fa1-43cf-bef3-2adf37d99130 > :END: > > ** Note taken on [2010-08-23 Mon 04:32] > > # (org-insert-link) showing stored links before and after the patch > > file:~/conversation.org (file:~/conversation.org) > id:7e1974a6-8fa1-43cf-bef3-2adf37d99130 (Note taken on [2010-08-23 Mon 04:33]) > --- lisp/org.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 366c8dd21..be3b8c350 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8300,13 +8300,14 @@ For file links, arg negates `org-context-in-file-links'." (setq cpltxt (concat "file:" file) link (org-make-link cpltxt)))) - ((and buffer-file-name (org-mode-p)) + ((and (buffer-file-name (buffer-base-buffer)) (org-mode-p)) (setq custom-id (ignore-errors (org-entry-get nil "CUSTOM_ID"))) (cond ((org-in-regexp "<<\\(.*?\\)>>") (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) "::" (match-string 1)) link (org-make-link cpltxt))) ((and (featurep 'org-id) @@ -8328,11 +8329,13 @@ For file links, arg negates `org-context-in-file-links'." (error ;; probably before first headline, link to file only (concat "file:" - (abbreviate-file-name buffer-file-name)))))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) (t ;; Just link to current headline (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name))) + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) ;; Add a context search string (when (org-xor org-context-in-file-links arg) (setq txt (cond From 5908e8ed7bc87e4fbe77714d84a3087f50a545a8 Mon Sep 17 00:00:00 2001 From: Jambunathan K <kjambunathan@gmail.com> Date: Mon, 23 Aug 2010 03:37:31 +0000 Subject: [PATCH 057/348] org-store-link: Return link when invoked from within agenda buffer * org.el (org-store-link): Return link when invoked non-interactively from an agenda buffer. TINYCHANGE > Summary: > > When I trigger a org-capture, with the cursor positioned on a line in > the agenda buffer, I want the link to the agenda entry to be available > as an annotation (%a) to the capture process. Currently this is broken. > > The enclosed patch fixes this. > > Setup: > > # file todo.org > * TODO Talk to someone > SCHEDULED: <2010-08-23 Mon> > > # org-capture-templates > ("z" "Conversation" entry > (file+headline "~/conversation.org" "Conversations") > "** Note taken on %U\n %a\n %?" :prepend t :empty-lines 1) > > Steps for reporduction: > > 1. Restrict agenda to todo.org > 2. Do org-agenda > 3. Place the cursor on the above todo line > 4. Trigger an org-capture for the above capture entry > > Examine the entries in conversation.org before/after the patch is > applied. Note the absence/presence of the link to the parent todo entry. > > * Conversations > > ** Note taken on [2010-08-23 Mon 03:58] > [[file:~/todo.org::*Talk%20to%20someone][Talk to someone]] > > ** Note taken on [2010-08-23 Mon 03:42] > > Jambunathan K. --- lisp/org.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index be3b8c350..15379efce 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8218,7 +8218,7 @@ For file links, arg negates `org-context-in-file-links'." (org-load-modules-maybe) (setq org-store-link-plist nil) ; reset (let ((outline-regexp (org-get-limited-outline-regexp)) - link cpltxt desc description search txt custom-id) + link cpltxt desc description search txt custom-id agenda-link) (cond ((run-hook-with-args-until-success 'org-store-link-functions) @@ -8250,9 +8250,10 @@ For file links, arg negates `org-context-in-file-links'." (get-text-property (point) 'org-marker)))) (when m (org-with-point-at m - (if (interactive-p) - (call-interactively 'org-store-link) - (org-store-link nil)))))) + (setq agenda-link + (if (interactive-p) + (call-interactively 'org-store-link) + (org-store-link nil))))))) ((eq major-mode 'calendar-mode) (let ((cd (calendar-cursor-to-date))) @@ -8392,7 +8393,7 @@ For file links, arg negates `org-context-in-file-links'." "::#" custom-id)) (setq org-stored-links (cons (list link desc) org-stored-links)))) - (and link (org-make-link-string link desc))))) + (or agenda-link (and link (org-make-link-string link desc)))))) (defun org-store-link-props (&rest plist) "Store link properties, extract names and addresses." From 550278c13550237711a66c89696b71c8b9d04632 Mon Sep 17 00:00:00 2001 From: Harri Kiiskinen <harkiisk@gmail.com> Date: Thu, 19 Aug 2010 15:31:58 +0000 Subject: [PATCH 058/348] :body-only property for publishing projects * lisp/org-publish.el (org-publish-project-alist): Document the new body-only property. (org-publish-org-to): Use the body-only property. --- lisp/org-publish.el | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/lisp/org-publish.el b/lisp/org-publish.el index 4bf203106..cae7be6a3 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -189,7 +189,14 @@ sitemap of files or summary page for a given project. The following properties control the creation of a concept index. - :makeindex Create a concept index." + :makeindex Create a concept index. + +Other properties affecting publication. + + :body-only Set this to 't' to publish only the body of the + documents, excluding everything outside and + including the <body> tags in HTML, or + \begin{document}..\end{document} in LaTeX." :group 'org-publish :type 'alist) @@ -513,7 +520,9 @@ PUB-DIR is the publishing directory." (setq export-buf-or-file (funcall (intern (concat "org-export-as-" format)) (plist-get plist :headline-levels) - nil plist nil nil pub-dir)) + nil plist nil + (plist-get plist :body-only) + pub-dir)) (when (and (bufferp export-buf-or-file) (buffer-live-p export-buf-or-file)) (set-buffer export-buf-or-file) From 9e6391389cc196cb121647c6497c7bffd8806a56 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Mon, 23 Aug 2010 19:35:43 +0200 Subject: [PATCH 059/348] Don't try to store link if point is at end of buffer. * org-wl.el (org-wl-store-link): Don't try to store link if point is at end of buffer. --- lisp/org-wl.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/org-wl.el b/lisp/org-wl.el index f88d83026..e1222ed82 100644 --- a/lisp/org-wl.el +++ b/lisp/org-wl.el @@ -142,13 +142,14 @@ ENTITY is a message entity." (defun org-wl-store-link () "Store a link to a WL message or folder." - (cond - ((memq major-mode '(wl-summary-mode mime-view-mode)) - (org-wl-store-link-message)) - ((eq major-mode 'wl-folder-mode) - (org-wl-store-link-folder)) - (t - nil))) + (unless (eobp) + (cond + ((memq major-mode '(wl-summary-mode mime-view-mode)) + (org-wl-store-link-message)) + ((eq major-mode 'wl-folder-mode) + (org-wl-store-link-folder)) + (t + nil)))) (defun org-wl-store-link-folder () "Store a link to a WL folder." From 1d1439f91e63e71f39e93622a0af439762522c00 Mon Sep 17 00:00:00 2001 From: Erik Iverson <iverson@biostat.wisc.edu> Date: Mon, 23 Aug 2010 23:06:55 -0400 Subject: [PATCH 060/348] babel: R: Respect value of `ess-ask-for-ess-directory' --- lisp/ob-R.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 2a114214b..712ae516d 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -155,7 +155,8 @@ This function is called by `org-babel-execute-src-block'." "If there is not a current R process then create one." (unless (string= session "none") (let ((session (or session "*R*")) - (ess-ask-for-ess-directory (not (cdr (assoc :dir params))))) + (ess-ask-for-ess-directory + (and ess-ask-for-ess-directory (not (cdr (assoc :dir params)))))) (if (org-babel-comint-buffer-livep session) session (save-window-excursion From 5305fe903f6ba3679ec143e9a0fd8c5b01eb2340 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 24 Aug 2010 19:14:14 -0600 Subject: [PATCH 061/348] ob-latex :fit,:border header arguments and working with the newest latex export code * lisp/ob-latex.el (org-babel-execute:latex): adding new ":fit" and ":border" header arguments which both use the "preview" latex package to fit the resulting pdf image to the figure. (org-babel-latex-tex-to-pdf): updated to the latest code from org-latex.el --- lisp/ob-latex.el | 140 ++++++++++++++++++++++++++--------------------- 1 file changed, 77 insertions(+), 63 deletions(-) diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 54517910c..0318375fe 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -37,9 +37,18 @@ (declare-function org-splice-latex-header "org" (tpl def-pkg pkg snippets-p &optional extra)) (declare-function org-export-latex-fix-inputenc "org-latex" ()) - (add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) +(defvar org-format-latex-header) +(defvar org-format-latex-header-extra) +(defvar org-export-latex-packages-alist) +(defvar org-export-latex-default-packages-alist) +(defvar org-export-pdf-logfiles) +(defvar org-latex-to-pdf-process) +(defvar org-export-pdf-remove-logfiles) +(defvar org-format-latex-options) +(defvar org-export-latex-packages-alist) + (defvar org-babel-default-header-args:latex '((:results . "latex") (:exports . "results")) "Default arguments to use when evaluating a LaTeX source block.") @@ -53,29 +62,53 @@ (if (stringp (cdr pair)) (cdr pair) (format "%S" (cdr pair))) body))) (nth 1 (org-babel-process-params params))) - body) + (org-babel-trim body)) -(defvar org-format-latex-options) -(defvar org-export-latex-packages-alist) (defun org-babel-execute:latex (body params) "Execute a block of Latex code with Babel. This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) (if (cdr (assoc :file params)) - (let ((out-file (cdr (assoc :file params))) - (tex-file (make-temp-file "org-babel-latex" nil ".tex")) - (pdfheight (cdr (assoc :pdfheight params))) - (pdfwidth (cdr (assoc :pdfwidth params))) - (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) - (org-export-latex-packages-alist - (append (cdr (assoc :packages params)) - org-export-latex-packages-alist))) + (let* ((out-file (cdr (assoc :file params))) + (tex-file (make-temp-file "org-babel-latex" nil ".tex")) + (border (cdr (assoc :border params))) + (fit (or (cdr (assoc :fit params)) border)) + (height (and fit (cdr (assoc :pdfheight params)))) + (width (and fit (cdr (assoc :pdfwidth params)))) + (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (org-export-latex-packages-alist + (append (cdr (assoc :packages params)) + org-export-latex-packages-alist))) (cond ((string-match "\\.png$" out-file) (org-create-formula-image body out-file org-format-latex-options in-buffer)) ((string-match "\\.pdf$" out-file) - (org-babel-latex-body-to-tex-file tex-file body pdfheight pdfwidth) + (with-temp-file tex-file + (insert + (org-splice-latex-header + org-format-latex-header + (delq + nil + (mapcar + (lambda (el) + (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-export-latex-default-packages-alist)) + org-export-latex-packages-alist + org-format-latex-header-extra) + (if fit "\n\\usepackage[active, tightpage]{preview}\n" "") + (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") + (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") + (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") + (if org-format-latex-header-extra + (concat "\n" org-format-latex-header-extra) + "") + (if fit + (concat "\n\\begin{document}\n\\begin{preview}\n" body + "\n\\end{preview}\n\\end{document}\n") + (concat "\n\\begin{document}\n" body "\n\\end{document}\n"))) + (org-export-latex-fix-inputenc)) (when (file-exists-p out-file) (delete-file out-file)) (rename-file (org-babel-latex-tex-to-pdf tex-file) out-file)) ((string-match "\\.\\([^\\.]+\\)$" out-file) @@ -84,67 +117,48 @@ This function is called by `org-babel-execute-src-block'." out-file) body)) -(defvar org-format-latex-header) -(defvar org-format-latex-header-extra) -(defvar org-export-latex-packages-alist) -(defvar org-export-latex-default-packages-alist) -(defun org-babel-latex-body-to-tex-file (tex-file body &optional height width) - "Place the contents of BODY into TEX-FILE. -Extracted from `org-create-formula-image' in org.el." - (with-temp-file tex-file - (insert (org-splice-latex-header - org-format-latex-header - (delq - nil - (mapcar - (lambda (el) (unless (and (listp el) (string= "hyperref" (cadr el))) - el)) - org-export-latex-default-packages-alist)) - org-export-latex-packages-alist - org-format-latex-header-extra) - (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") - (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") - (if org-format-latex-header-extra - (concat "\n" org-format-latex-header-extra) - "") - "\n\\begin{document}\n" body "\n\\end{document}\n") - (org-export-latex-fix-inputenc))) - -(defvar org-export-pdf-logfiles) -(defvar org-latex-to-pdf-process) -(defvar org-export-pdf-remove-logfiles) -(defun org-babel-latex-tex-to-pdf (tex-file) - "Generate a pdf file according to the contents TEX-FILE. +(defun org-babel-latex-tex-to-pdf (file) + "Generate a pdf file according to the contents FILE. Extracted from `org-export-as-pdf' in org-latex.el." (let* ((wconfig (current-window-configuration)) - (default-directory (file-name-directory tex-file)) - (base (file-name-sans-extension tex-file)) + (default-directory (file-name-directory file)) + (base (file-name-sans-extension file)) (pdffile (concat base ".pdf")) (cmds org-latex-to-pdf-process) (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) cmd) + (with-current-buffer outbuf (erase-buffer)) + (message (concat "Processing LaTeX file " file "...")) + (setq output-dir (file-name-directory file)) (if (and cmds (symbolp cmds)) - (funcall cmds tex-file) + (funcall cmds (shell-quote-argument file)) (while cmds - (setq cmd (pop cmds)) - (while (string-match "%b" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument base)) - t t cmd))) - (while (string-match "%s" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument tex-file)) - t t cmd))) - (shell-command cmd outbuf outbuf))) + (setq cmd (pop cmds)) + (while (string-match "%b" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument base)) + t t cmd))) + (while (string-match "%f" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument file)) + t t cmd))) + (while (string-match "%o" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument output-dir)) + t t cmd))) + (shell-command cmd outbuf outbuf))) + (message (concat "Processing LaTeX file " file "...done")) (if (not (file-exists-p pdffile)) - (error "PDF file was not produced from %s" tex-file) + (error (concat "PDF file " pdffile " was not produced")) (set-window-configuration wconfig) (when org-export-pdf-remove-logfiles - (dolist (ext org-export-pdf-logfiles) - (setq tex-file (concat base "." ext)) - (and (file-exists-p tex-file) (delete-file tex-file)))) + (dolist (ext org-export-pdf-logfiles) + (setq file (concat base "." ext)) + (and (file-exists-p file) (delete-file file)))) + (message "Exporting to PDF...done") pdffile))) (defun org-babel-prep-session:latex (session params) From 92e491e52c09fa2789ff89c8314d77199c5a87e5 Mon Sep 17 00:00:00 2001 From: Noorul Islam <noorul@noorul.com> Date: Wed, 25 Aug 2010 14:12:27 +0000 Subject: [PATCH 062/348] org-habit.el: better error handling required Attached is the patch which catch this error and throws meaningful message. * lisp/org-habit.el (org-habit-parse-todo): Find sr-days only if scheduled-repeat is non nil. Use 4th element of the list returned by (org-heading-components) as habit-entry. Modify the error message to be more meaningful. TINYCHANGE paulusm <paulusm@bigpond.com> writes: > Hi org-mode people, > > Whilst playing with the "shaving" example from > http://orgmode.org/manual/Tracking-your-habits.html I accidentally put a > bad character in the SCHEDULED timestamp. > > Instead of: "SCHEDULED: <2010-08-26 Thu .+2d/4d>" > I had: "SCHEDULED: <2010-08-26 Thu .+2nd/4d>" > > When trying to view my agenda, I was presented with a blank agenda and Emacs > very quietly reported: > "org-habit-duration-to-days: Wrong type argument: stringp, nil" > which is not really helpful. > > Removing the bad character fixes the issue, and I can duplicate the error > condition as described above. > > Perhaps some better error trapping could be done? > > --- lisp/org-habit.el | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/org-habit.el b/lisp/org-habit.el index 2fa352fcc..f44d0fa35 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -149,15 +149,17 @@ This list represents a \"habit\" for the rest of this module." (assert (org-is-habit-p (point))) (let* ((scheduled (org-get-scheduled-time (point))) (scheduled-repeat (org-get-repeat org-scheduled-string)) - (sr-days (org-habit-duration-to-days scheduled-repeat)) (end (org-entry-end-position)) - (habit-entry (org-no-properties (nth 5 (org-heading-components)))) - closed-dates deadline dr-days) + (habit-entry (org-no-properties (nth 4 (org-heading-components)))) + closed-dates deadline dr-days sr-days) (if scheduled (setq scheduled (time-to-days scheduled)) (error "Habit %s has no scheduled date" habit-entry)) (unless scheduled-repeat - (error "Habit %s has no scheduled repeat period" habit-entry)) + (error + "Habit '%s' has no scheduled repeat period or has an incorrect one" + habit-entry)) + (setq sr-days (org-habit-duration-to-days scheduled-repeat)) (unless (> sr-days 0) (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) From 869b2693a516a164997a11385ed21567667f27f6 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 12 Aug 2010 22:59:39 +0000 Subject: [PATCH 063/348] Recognize underscores in URL * org.el (org-make-link-regexps): modified regexp of org-plain-link-re. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 15379efce..6a6278743 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4853,7 +4853,7 @@ This should be called after the variable `org-link-types' has changed." org-plain-link-re (concat "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) + (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") org-bracket-link-regexp "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" From 58f0a4ed4180b4061ee7e7ae2424f5325d849ca0 Mon Sep 17 00:00:00 2001 From: Aditya Siram <aditya.siram@gmail.com> Date: Wed, 25 Aug 2010 12:21:13 -0600 Subject: [PATCH 064/348] Noweb style references are now expanded with loading a code block in a session. * lisp/ob.el (org-babel-load-in-session): expanding noweb references when appropriate --- lisp/ob.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index 8557f094c..2ecc1db5f 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -421,8 +421,12 @@ session." (interactive) (let* ((info (or info (org-babel-get-src-block-info))) (lang (nth 0 info)) - (body (nth 1 info)) (params (nth 2 info)) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) (session (cdr (assoc :session params))) (dir (cdr (assoc :dir params))) (default-directory From 7b00073f2dd0372e9da94d8efbc472a131e32eee Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 25 Aug 2010 14:43:07 -0600 Subject: [PATCH 065/348] Babel now cleans up any temporary files created using org-babel-temp-file * lisp/ob.el (org-babel-temporary-directory): variable to hold the value of the Babel temporary directory (org-babel-temp-file): replacement for make-temp-file with cleanup on exit of Emacs (org-babel-remove-temporary-directory): cleanup function run on exit of Emacs (kill-emacs-hook): now includes babel cleanup function * lisp/ob-C.el (org-babel-C-execute): using org-babel-temp-file instead of make-temp-file * lisp/ob-R.el (org-babel-R-assign-elisp): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-R-evaluate-external-process): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-R-evaluate-session): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-asymptote.el (org-babel-execute:asymptote): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-clojure.el (org-babel-clojure-evaluate-external-process): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-ditaa.el (org-babel-execute:ditaa): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-dot.el (org-babel-execute:dot): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-gnuplot.el (org-babel-gnuplot-process-vars): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-execute:gnuplot): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-haskell.el (org-babel-load-session:haskell): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-haskell-export-to-lhs): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-latex.el (org-babel-execute:latex): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-ledger.el (org-babel-execute:ledger): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-lisp.el (org-babel-execute:lisp): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-octave.el (org-babel-octave-evaluate-external-process): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-octave-evaluate-session): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-octave-import-elisp-from-file): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-perl.el (org-babel-perl-evaluate): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-python.el (org-babel-python-evaluate): using `org-babel-temp-file' instead of `make-temp-file' using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-ruby.el (org-babel-ruby-evaluate): using `org-babel-temp-file' instead of `make-temp-file' using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-sass.el (org-babel-execute:sass): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-sh.el (org-babel-sh-evaluate): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-sql.el (org-babel-execute:sql): using `org-babel-temp-file' instead of `make-temp-file' * lisp/ob-sqlite.el (org-babel-execute:sqlite): using `org-babel-temp-file' instead of `make-temp-file' (org-babel-sqlite-expand-vars): using `org-babel-temp-file' instead of `make-temp-file' --- lisp/ob-C.el | 8 ++++---- lisp/ob-R.el | 6 +++--- lisp/ob-asymptote.el | 2 +- lisp/ob-clojure.el | 2 +- lisp/ob-ditaa.el | 2 +- lisp/ob-dot.el | 2 +- lisp/ob-gnuplot.el | 4 ++-- lisp/ob-haskell.el | 4 ++-- lisp/ob-latex.el | 2 +- lisp/ob-ledger.el | 4 ++-- lisp/ob-lisp.el | 2 +- lisp/ob-octave.el | 8 ++++---- lisp/ob-perl.el | 2 +- lisp/ob-python.el | 4 ++-- lisp/ob-ruby.el | 4 ++-- lisp/ob-sass.el | 4 ++-- lisp/ob-sh.el | 4 ++-- lisp/ob-sql.el | 4 ++-- lisp/ob-sqlite.el | 4 ++-- lisp/ob.el | 25 +++++++++++++++++++++++++ 20 files changed, 61 insertions(+), 36 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 24f5a5198..01a9fb537 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -84,12 +84,12 @@ header arguments (calls `org-babel-C-expand')." "This function should only be called by `org-babel-execute:C' or `org-babel-execute:c++'." (let* ((processed-params (org-babel-process-params params)) - (tmp-src-file (make-temp-file "org-babel-C-src" nil + (tmp-src-file (org-babel-temp-file "C-src-" nil (cond ((equal org-babel-c-variant 'c) ".c") ((equal org-babel-c-variant 'cpp) ".cpp")))) - (tmp-bin-file (make-temp-file "org-babel-C-bin")) - (tmp-out-file (make-temp-file "org-babel-C-out")) + (tmp-bin-file (org-babel-temp-file "C-bin-")) + (tmp-out-file (org-babel-temp-file "C-out-")) (cmdline (cdr (assoc :cmdline params))) (flags (cdr (assoc :flags params))) (full-body (org-babel-C-expand body params)) @@ -108,7 +108,7 @@ or `org-babel-execute:c++'." ((lambda (results) (org-babel-reassemble-table (if (member "vector" (nth 2 processed-params)) - (let ((tmp-file (make-temp-file "ob-c"))) + (let ((tmp-file (org-babel-temp-file "c-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file)) (org-babel-read results)) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 712ae516d..25c220f68 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -139,7 +139,7 @@ This function is called by `org-babel-execute-src-block'." (defun org-babel-R-assign-elisp (name value colnames-p rownames-p) "Construct R code assigning the elisp VALUE to a variable named NAME." (if (listp value) - (let ((transition-file (make-temp-file "org-babel-R-import"))) + (let ((transition-file (org-babel-temp-file "R-import-"))) ;; ensure VALUE has an orgtbl structure (depth of at least 2) (unless (listp (car value)) (setq value (list value))) (with-temp-file (org-babel-maybe-remote-file transition-file) @@ -235,7 +235,7 @@ string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value - (let ((tmp-file (make-temp-file "org-babel-R-results-"))) + (let ((tmp-file (org-babel-temp-file "R-results-"))) (org-babel-eval org-babel-R-command (format org-babel-R-wrapper-method body tmp-file @@ -256,7 +256,7 @@ string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value - (let ((tmp-file (make-temp-file "org-babel-R")) + (let ((tmp-file (org-babel-temp-file "R-")) broke) (org-babel-comint-with-output (session org-babel-R-eoe-output) (insert (mapconcat diff --git a/lisp/ob-asymptote.el b/lisp/ob-asymptote.el index df1f059d8..49ccc7c46 100644 --- a/lisp/ob-asymptote.el +++ b/lisp/ob-asymptote.el @@ -73,7 +73,7 @@ This function is called by `org-babel-execute-src-block'." (match-string 1 out-file)) "pdf")) (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-asymptote")) + (in-file (org-babel-temp-file "asymptote-")) (cmd (concat "asy " (if out-file (concat "-globalwrite -f " format " -o " out-file) diff --git a/lisp/ob-clojure.el b/lisp/ob-clojure.el index cfb3b941b..4311bb5ae 100644 --- a/lisp/ob-clojure.el +++ b/lisp/ob-clojure.el @@ -261,7 +261,7 @@ repl buffer." " ")))) (case result-type (output (org-babel-eval cmd body)) - (value (let* ((tmp-file (make-temp-file "org-babel-clojure-results-"))) + (value (let* ((tmp-file (org-babel-temp-file "clojure-results-"))) (org-babel-eval cmd (format org-babel-clojure-wrapper-method body tmp-file tmp-file)) (org-babel-clojure-table-or-string diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index f9a5bac3e..cc95765d2 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -53,7 +53,7 @@ This function is called by `org-babel-execute-src-block'." (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (out-file (cdr (assoc :file params))) (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-ditaa"))) + (in-file (org-babel-temp-file "ditaa-"))) (unless (file-exists-p org-ditaa-jar-path) (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (with-temp-file in-file (insert body)) diff --git a/lisp/ob-dot.el b/lisp/ob-dot.el index d19f075c8..8f2976e28 100644 --- a/lisp/ob-dot.el +++ b/lisp/ob-dot.el @@ -70,7 +70,7 @@ This function is called by `org-babel-execute-src-block'." (out-file (cdr (assoc :file params))) (cmdline (cdr (assoc :cmdline params))) (cmd (or (cdr (assoc :cmd params)) "dot")) - (in-file (make-temp-file "org-babel-dot"))) + (in-file (org-babel-temp-file "dot-"))) (with-temp-file in-file (insert (org-babel-expand-body:dot body params processed-params))) (org-babel-eval (concat cmd " " in-file " " cmdline " -o " out-file) "") diff --git a/lisp/ob-gnuplot.el b/lisp/ob-gnuplot.el index 5b5e82dec..ff68ad708 100644 --- a/lisp/ob-gnuplot.el +++ b/lisp/ob-gnuplot.el @@ -68,7 +68,7 @@ code." (car pair) ;; variable name (if (listp (cdr pair)) ;; variable value (org-babel-gnuplot-table-to-data - (cdr pair) (make-temp-file "org-babel-gnuplot") params) + (cdr pair) (org-babel-temp-file "gnuplot") params) (cdr pair)))) (org-babel-ref-variables params))) @@ -141,7 +141,7 @@ This function is called by `org-babel-execute-src-block'." (save-window-excursion ;; evaluate the code body with gnuplot (if (string= session "none") - (let ((script-file (make-temp-file "org-babel-gnuplot-script"))) + (let ((script-file (org-babel-temp-file "gnuplot-script"))) (with-temp-file script-file (insert (concat body "\n"))) (message "gnuplot \"%s\"" script-file) diff --git a/lisp/ob-haskell.el b/lisp/ob-haskell.el index 86efda90c..9cfda96b7 100644 --- a/lisp/ob-haskell.el +++ b/lisp/ob-haskell.el @@ -116,7 +116,7 @@ then create one. Return the initialized session." (save-window-excursion (let* ((buffer (org-babel-prep-session:haskell session params processed-params)) - (load-file (concat (make-temp-file "org-babel-haskell-load") ".hs"))) + (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) (with-temp-buffer (insert body) (write-file load-file) (haskell-mode) (inferior-haskell-load-file)) @@ -177,7 +177,7 @@ constructs (header arguments, no-web syntax etc...) are ignored." (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) (base-name (file-name-sans-extension (buffer-file-name))) - (tmp-file (make-temp-file "ob-haskell")) + (tmp-file (org-babel-temp-file "haskell-")) (tmp-org-file (concat tmp-file ".org")) (tmp-tex-file (concat tmp-file ".tex")) (lhs-file (concat base-name ".lhs")) diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 0318375fe..cb8c255a2 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -70,7 +70,7 @@ This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) (if (cdr (assoc :file params)) (let* ((out-file (cdr (assoc :file params))) - (tex-file (make-temp-file "org-babel-latex" nil ".tex")) + (tex-file (org-babel-temp-file "latex-" nil ".tex")) (border (cdr (assoc :border params))) (fit (or (cdr (assoc :fit params)) border)) (height (and fit (cdr (assoc :pdfheight params)))) diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el index 1c48dad62..edd803ff2 100644 --- a/lisp/ob-ledger.el +++ b/lisp/ob-ledger.el @@ -50,8 +50,8 @@ called by `org-babel-execute-src-block'." (message "executing Ledger source code block") (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-ledger")) - (out-file (make-temp-file "org-babel-ledger-output")) + (in-file (org-babel-temp-file "ledger-")) + (out-file (org-babel-temp-file "ledger-output-")) ) (with-temp-file in-file (insert body)) (message (concat "ledger -f " in-file " " cmdline)) diff --git a/lisp/ob-lisp.el b/lisp/ob-lisp.el index bad0d078e..4216158e3 100644 --- a/lisp/ob-lisp.el +++ b/lisp/ob-lisp.el @@ -74,7 +74,7 @@ This function is called by `org-babel-execute-src-block'" (save-window-excursion (cadr (slime-eval `(swank:eval-and-grab-output ,full-body)))) ;; external evaluation - (let ((script-file (make-temp-file "ob-lisp-script"))) + (let ((script-file (org-babel-temp-file "lisp-script-"))) (with-temp-file script-file (insert ;; return the value or the output diff --git a/lisp/ob-octave.el b/lisp/ob-octave.el index e0c27054a..19174cd7d 100644 --- a/lisp/ob-octave.el +++ b/lisp/ob-octave.el @@ -178,7 +178,7 @@ value of the last statement in BODY, as elisp." org-babel-octave-shell-command))) (case result-type (output (org-babel-eval cmd body)) - (value (let ((tmp-file (make-temp-file "org-babel-results-"))) + (value (let ((tmp-file (org-babel-temp-file "results-"))) (org-babel-eval cmd (format org-babel-octave-wrapper-method body tmp-file tmp-file)) @@ -188,8 +188,8 @@ value of the last statement in BODY, as elisp." (defun org-babel-octave-evaluate-session (session body result-type &optional matlabp) "Evaluate BODY in SESSION." - (let* ((tmp-file (make-temp-file "org-babel-results-")) - (wait-file (make-temp-file "org-babel-matlab-emacs-link-wait-signal-")) + (let* ((tmp-file (org-babel-temp-file "results-")) + (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) (full-body (case result-type (output @@ -246,7 +246,7 @@ value of the last statement in BODY, as elisp." "Import data from FILE-NAME. This removes initial blank and comment lines and then calls `org-babel-import-elisp-from-file'." - (let ((temp-file (make-temp-file "org-babel-results-")) beg end) + (let ((temp-file (org-babel-temp-file "results-")) beg end) (with-temp-file temp-file (insert-file-contents file-name) (re-search-forward "^[ \t]*[^# \t]" nil t) diff --git a/lisp/ob-perl.el b/lisp/ob-perl.el index 6e83542c2..3e4873d76 100644 --- a/lisp/ob-perl.el +++ b/lisp/ob-perl.el @@ -107,7 +107,7 @@ return the value of the last statement in BODY, as elisp." (when session (error "Sessions are not supported for Perl.")) (case result-type (output (org-babel-eval org-babel-perl-command body)) - (value (let ((tmp-file (make-temp-file "org-babel-perl-results-"))) + (value (let ((tmp-file (org-babel-temp-file "perl-results-"))) (org-babel-eval org-babel-perl-command (format org-babel-perl-wrapper-method body tmp-file)) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index 44411e45c..a96840380 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -203,7 +203,7 @@ return the value of the last statement in BODY, as elisp." ;; external process evaluation (case result-type (output (org-babel-eval org-babel-python-command body)) - (value (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (value (let ((tmp-file (org-babel-temp-file "python-results-"))) (org-babel-eval org-babel-python-command (format (if (member "pp" result-params) @@ -251,7 +251,7 @@ return the value of the last statement in BODY, as elisp." (if (or (member "code" result-params) (member "pp" result-params)) results (org-babel-python-table-or-string results))) - (let ((tmp-file (make-temp-file "org-babel-python-results-"))) + (let ((tmp-file (org-babel-temp-file "python-results-"))) (org-babel-comint-with-output (buffer org-babel-python-eoe-indicator t body) (let ((comint-process-echoes nil)) diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index e5ee508e5..f2363df33 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -186,7 +186,7 @@ return the value of the last statement in BODY, as elisp." ;; external process evaluation (case result-type (output (org-babel-eval org-babel-ruby-command body)) - (value (let ((tmp-file (make-temp-file "org-babel-ruby-results-"))) + (value (let ((tmp-file (org-babel-temp-file "ruby-results-"))) (org-babel-eval org-babel-ruby-command (format (if (member "pp" result-params) org-babel-ruby-pp-wrapper-method @@ -221,7 +221,7 @@ return the value of the last statement in BODY, as elisp." (if (or (member "code" result-params) (member "pp" result-params)) results (org-babel-ruby-table-or-string results))) - (let* ((tmp-file (make-temp-file "org-babel-ruby-results-")) + (let* ((tmp-file (org-babel-temp-file "ruby-results-")) (ppp (or (member "code" result-params) (member "pp" result-params)))) (org-babel-comint-with-output diff --git a/lisp/ob-sass.el b/lisp/ob-sass.el index b834a80ea..2e624f294 100644 --- a/lisp/ob-sass.el +++ b/lisp/ob-sass.el @@ -51,9 +51,9 @@ This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) (file (cdr (assoc :file params))) - (out-file (or file (make-temp-file "org-babel-sass-out"))) + (out-file (or file (org-babel-temp-file "sass-out-"))) (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-sass-in")) + (in-file (org-babel-temp-file "sass-in-")) (cmd (concat "sass " (or cmdline "") in-file " " out-file))) (with-temp-file in-file (insert (org-babel-expand-body:sass body params))) (shell-command cmd) diff --git a/lisp/ob-sh.el b/lisp/ob-sh.el index ced35c0ab..cf8f82928 100644 --- a/lisp/ob-sh.el +++ b/lisp/ob-sh.el @@ -155,12 +155,12 @@ return the value of the last statement in BODY." (if (or (member "scalar" result-params) (member "output" result-params)) results - (let ((tmp-file (make-temp-file "org-babel-sh"))) + (let ((tmp-file (org-babel-temp-file "sh-"))) (with-temp-file tmp-file (insert results)) (org-babel-import-elisp-from-file tmp-file)))) (if (not session) (org-babel-eval org-babel-sh-command (org-babel-trim body)) - (let ((tmp-file (make-temp-file "org-babel-sh"))) + (let ((tmp-file (org-babel-temp-file "sh-"))) (mapconcat #'org-babel-sh-strip-weird-long-prompt (mapcar diff --git a/lisp/ob-sql.el b/lisp/ob-sql.el index 60907e39e..4e1daa5e1 100644 --- a/lisp/ob-sql.el +++ b/lisp/ob-sql.el @@ -60,9 +60,9 @@ This function is called by `org-babel-execute-src-block'." (processed-params (org-babel-process-params params)) (cmdline (cdr (assoc :cmdline params))) (engine (cdr (assoc :engine params))) - (in-file (make-temp-file "org-babel-sql-in")) + (in-file (org-babel-temp-file "sql-in-")) (out-file (or (cdr (assoc :out-file params)) - (make-temp-file "org-babel-sql-out"))) + (org-babel-temp-file "sql-out-"))) (command (case (intern engine) ('mysql (format "mysql %s -e \"source %s\" > %s" (or cmdline "") in-file out-file)) diff --git a/lisp/ob-sqlite.el b/lisp/ob-sqlite.el index 99ae51bd4..e53d07404 100644 --- a/lisp/ob-sqlite.el +++ b/lisp/ob-sqlite.el @@ -73,7 +73,7 @@ This function is called by `org-babel-execute-src-block'." (insert (org-babel-expand-body:sqlite body nil (list nil vars)))) sql-file) - (make-temp-file "ob-sqlite-sql"))) + (org-babel-temp-file "sqlite-sql-"))) (cons "cmd" org-babel-sqlite3-command) (cons "header" (if headers-p "-header" "-noheader")) (cons "separator" @@ -117,7 +117,7 @@ This function is called by `org-babel-execute-src-block'." el (format "%S" el))))))) data-file) - (make-temp-file "ob-sqlite-data")) + (org-babel-temp-file "sqlite-data-")) (if (stringp val) val (format "%S" val)))) (cdr pair)) body))) diff --git a/lisp/ob.el b/lisp/ob.el index 2ecc1db5f..6f9b9a27e 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1658,6 +1658,31 @@ the remote connection." (concat "/" user (when user "@") host ":" file)) file)) +(defvar org-babel-temporary-directory + (or (and (boundp 'org-babel-temporary-directory) + org-babel-temporary-directory) + (make-temp-file "babel-" t)) + "Directory to hold temporary files created to execute code blocks. +Used by `org-babel-temp-file'. This directory will be removed on +Emacs shutdown.") + +(defun org-babel-temp-file (prefix &optional suffix) + "Create a temporary file in the `org-babel-temporary-directory'. +Passes PREFIX and SUFFIX directly to `make-temp-file' with the +value of `temporary-file-directory' temporarily set to the value +of `org-babel-temporary-directory'." + (let ((temporary-file-directory (expand-file-name + org-babel-temporary-directory + temporary-file-directory))) + (make-temp-file prefix suffix))) + +(defun org-babel-remove-temporary-directory () + "Remove `org-babel-temporary-directory' on Emacs shutdown." + (when (boundp 'org-babel-temporary-directory) + (delete-directory org-babel-temporary-directory t))) + +(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) + (provide 'ob) ;; arch-tag: 01a7ebee-06c5-4ee4-a709-e660d28c0af1 From e3d271ea5b08649c43f2fbbd350c9d45d924a6ab Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 25 Aug 2010 19:21:42 -0600 Subject: [PATCH 066/348] fixed issue in org-babel-temp-file when forcing extension types * lisp/ob-C.el (org-babel-C-execute): corrected arguments to org-babel-temp-file * lisp/ob-latex.el (org-babel-execute:latex): corrected arguments to org-babel-temp-file * lisp/ob.el (org-babel-temp-file): corrected arguments to make-temp-file --- lisp/ob-C.el | 9 +++++---- lisp/ob-latex.el | 3 ++- lisp/ob.el | 2 +- 3 files changed, 8 insertions(+), 6 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 01a9fb537..18921747c 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -84,10 +84,11 @@ header arguments (calls `org-babel-C-expand')." "This function should only be called by `org-babel-execute:C' or `org-babel-execute:c++'." (let* ((processed-params (org-babel-process-params params)) - (tmp-src-file (org-babel-temp-file "C-src-" nil - (cond - ((equal org-babel-c-variant 'c) ".c") - ((equal org-babel-c-variant 'cpp) ".cpp")))) + (tmp-src-file (org-babel-temp-file + "C-src-" + (cond + ((equal org-babel-c-variant 'c) ".c") + ((equal org-babel-c-variant 'cpp) ".cpp")))) (tmp-bin-file (org-babel-temp-file "C-bin-")) (tmp-out-file (org-babel-temp-file "C-out-")) (cmdline (cdr (assoc :cmdline params))) diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index cb8c255a2..773e3b6e0 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -70,7 +70,7 @@ This function is called by `org-babel-execute-src-block'." (setq body (org-babel-expand-body:latex body params)) (if (cdr (assoc :file params)) (let* ((out-file (cdr (assoc :file params))) - (tex-file (org-babel-temp-file "latex-" nil ".tex")) + (tex-file (org-babel-temp-file "latex-" ".tex")) (border (cdr (assoc :border params))) (fit (or (cdr (assoc :fit params)) border)) (height (and fit (cdr (assoc :pdfheight params)))) @@ -84,6 +84,7 @@ This function is called by `org-babel-execute-src-block'." (org-create-formula-image body out-file org-format-latex-options in-buffer)) ((string-match "\\.pdf$" out-file) + (require 'org-latex) (with-temp-file tex-file (insert (org-splice-latex-header diff --git a/lisp/ob.el b/lisp/ob.el index 6f9b9a27e..33dbfefc6 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1674,7 +1674,7 @@ of `org-babel-temporary-directory'." (let ((temporary-file-directory (expand-file-name org-babel-temporary-directory temporary-file-directory))) - (make-temp-file prefix suffix))) + (make-temp-file prefix nil suffix))) (defun org-babel-remove-temporary-directory () "Remove `org-babel-temporary-directory' on Emacs shutdown." From 9c43017755b201fef14c36bc64de6c3c68f73654 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 26 Aug 2010 07:22:21 -0600 Subject: [PATCH 067/348] Babel -- fix bug in final deletion of `org-babel-temporary-directory' Thanks to Noorul Islam for pointing out this issue * lisp/ob.el (org-babel-remove-temporary-directory): the version of `delete-directory' found in files.el can not be assumed to be present on all versions, so this copies the recursive behavior of that command in such a way that all calls to delete-directory will also work with the built-in internal C implementation of that function. This is not overly difficult as all elements of the directory can be assumed to be files. --- lisp/ob.el | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index 33dbfefc6..d6c63f798 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1679,7 +1679,18 @@ of `org-babel-temporary-directory'." (defun org-babel-remove-temporary-directory () "Remove `org-babel-temporary-directory' on Emacs shutdown." (when (boundp 'org-babel-temporary-directory) - (delete-directory org-babel-temporary-directory t))) + ;; taken from `delete-directory' in files.el + (mapc (lambda (file) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (eq t (car (file-attributes file))) + (delete-directory file) + (delete-file file nil))) + ;; We do not want to delete "." and "..". + (directory-files org-babel-temporary-directory 'full + "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (delete-directory org-babel-temporary-directory))) (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) From 810bb09ef32b37bf51bc6da83716090ee2108b57 Mon Sep 17 00:00:00 2001 From: Zhang Weize <zhangweize@gmail.com> Date: Thu, 26 Aug 2010 09:10:03 -0600 Subject: [PATCH 068/348] ob-plantuml.el support for evaluating plantuml scripts --- lisp/ob-plantuml.el | 52 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) create mode 100644 lisp/ob-plantuml.el diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el new file mode 100644 index 000000000..889fa9615 --- /dev/null +++ b/lisp/ob-plantuml.el @@ -0,0 +1,52 @@ +;;; ob-plantuml.el --- org-babel functions for plantuml evaluation + +;; Author: Zhang Weize + +;;; Commentary: + +;; Org-Babel support for evaluating plantuml script. +;; +;; Inspired by Ian Yang's org-export-blocks-format-plantuml +;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:plantuml + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a plantuml source block.") + +(defun org-babel-expand-body:plantuml (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defvar org-plantuml-jar-path) +(defun org-babel-execute:plantuml (body params) + "Execute a block of plantuml code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (make-temp-file "org-babel-plantuml"))) + (unless (file-exists-p org-plantuml-jar-path) + (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) + (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) + (message (concat "java -jar " org-plantuml-jar-path + " -p " cmdline " < " in-file " > " out-file)) + (shell-command (concat "java -jar " (shell-quote-argument org-plantuml-jar-path) + " -p " cmdline " < " in-file " > " out-file)) + ; The method below will produce error when exporting the buffer. + ;; (with-temp-buffer + ;; (call-process-shell-command + ;; (concat "java -jar " org-plantuml-jar-path " -p " cmdline) + ;; in-file + ;; '(t nil)) + ;; (write-region nil nil out-file)) + out-file)) + +(defun org-babel-prep-session:plantuml (session params) + "Return an error because plantuml does not support sessions." + (error "Plantuml does not support sessions")) + +(provide 'ob-plantuml) + +;;; ob-plantuml.el ends here From a89dc43e835515eff9dd6bd864e015a3729cd63c Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 26 Aug 2010 09:36:08 -0600 Subject: [PATCH 069/348] integrating ob-plantuml -- Thanks to Zhang Weize for this contribution! * Makefile (LISPF): now compiling and installing ob-plantuml.el * contrib/scripts/.gitignore : ignores the plantuml.jar file, so that it can be located next to ditaa.jar * lisp/ob-plantuml.el: adding copyright notice and FSF attribution (org-plantuml-jar-path): now a defcustom (org-babel-execute:plantuml): now using org-babel-eval which displays error messages * lisp/org.el (org-babel-load-languages): ob-plantuml is now part of org-babel-load-languages --- Makefile | 5 ++-- contrib/scripts/.gitignore | 1 + lisp/ob-plantuml.el | 57 +++++++++++++++++++++++++++----------- lisp/org.el | 1 + 4 files changed, 46 insertions(+), 18 deletions(-) create mode 100644 contrib/scripts/.gitignore diff --git a/Makefile b/Makefile index 3229f4657..e5e51b2b5 100644 --- a/Makefile +++ b/Makefile @@ -147,7 +147,8 @@ LISPF = org.el \ ob-css.el \ ob-gnuplot.el \ ob-octave.el \ - ob-screen.el + ob-screen.el \ + ob-plantuml.el LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES = $(LISPFILES0) lisp/org-install.el @@ -444,4 +445,4 @@ lisp/org-timer.elc: lisp/org.el lisp/org-vm.elc: lisp/org.el lisp/org-w3m.elc: lisp/org.el lisp/org-wl.elc: lisp/org.el -lisp/org-xoxo.elc: lisp/org-exp.el \ No newline at end of file +lisp/org-xoxo.elc: lisp/org-exp.el diff --git a/contrib/scripts/.gitignore b/contrib/scripts/.gitignore new file mode 100644 index 000000000..20d5925c6 --- /dev/null +++ b/contrib/scripts/.gitignore @@ -0,0 +1 @@ +plantuml.jar diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index 889fa9615..9959f4025 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -1,6 +1,26 @@ ;;; ob-plantuml.el --- org-babel functions for plantuml evaluation +;; Copyright (C) 2010 Free Software Foundation, Inc. + ;; Author: Zhang Weize +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01trans + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: @@ -9,8 +29,14 @@ ;; Inspired by Ian Yang's org-export-blocks-format-plantuml ;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el +;;; Requirements: + +;; plantuml | http://plantuml.sourceforge.net/ +;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file + ;;; Code: (require 'ob) +(require 'ob-eval) (defvar org-babel-default-header-args:plantuml '((:results . "file") (:exports . "results")) @@ -19,28 +45,25 @@ (defun org-babel-expand-body:plantuml (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." body) -(defvar org-plantuml-jar-path) +(defcustom org-plantuml-jar-path nil + "Path to the plantuml.jar file." + :group 'org-babel + :type 'string) + (defun org-babel-execute:plantuml (body params) "Execute a block of plantuml code with org-babel. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (cmdline (cdr (assoc :cmdline params))) - (in-file (make-temp-file "org-babel-plantuml"))) + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "plantuml-")) + (cmd (concat "java -jar " + (shell-quote-argument org-plantuml-jar-path) + " -p " cmdline " < " in-file " > " out-file))) (unless (file-exists-p org-plantuml-jar-path) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) - (message (concat "java -jar " org-plantuml-jar-path - " -p " cmdline " < " in-file " > " out-file)) - (shell-command (concat "java -jar " (shell-quote-argument org-plantuml-jar-path) - " -p " cmdline " < " in-file " > " out-file)) - ; The method below will produce error when exporting the buffer. - ;; (with-temp-buffer - ;; (call-process-shell-command - ;; (concat "java -jar " org-plantuml-jar-path " -p " cmdline) - ;; in-file - ;; '(t nil)) - ;; (write-region nil nil out-file)) + (message "%s" cmd) (org-babel-eval cmd "") out-file)) (defun org-babel-prep-session:plantuml (session params) @@ -49,4 +72,6 @@ This function is called by `org-babel-execute-src-block'." (provide 'ob-plantuml) +;; arch-tag: 451f50c5-e779-407e-ad64-70e0e8f161d1 + ;;; ob-plantuml.el ends here diff --git a/lisp/org.el b/lisp/org.el index 6a6278743..89fcdae86 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -161,6 +161,7 @@ requirements) is loaded." (const :tag "Ocaml" ocaml) (const :tag "Octave" octave) (const :tag "Perl" perl) + (const :tag "PlantUML" plantuml) (const :tag "Python" python) (const :tag "Ruby" ruby) (const :tag "Sass" sass) From 2c33b2eb660f98537c7b2c5c05c93564191ed30e Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 26 Aug 2010 10:01:21 -0600 Subject: [PATCH 070/348] Introducing ob-org and now wrapping ":results org" in org code block ob-org has two non-standard header arguments in that it exports it's results by default and the result type defaults to raw, this ensures that the body of a begin_src org block exports transparently. This is a breaking change in that if you are currently using org code blocks to export org-fontified code you will have to set the ":exports" header argument for org-mode blocks to "code" on a block, file, language or system-wide basis. * Makefile (LISPF): adding ob-org.el to the makefile * lisp/ob-org.el: defines handling of org code blocks * lisp/ob.el (org-babel-insert-result): now when "org" is a result type the results are wrapped in an org code block --- Makefile | 3 ++- lisp/ob-org.el | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/ob.el | 11 +++++++++-- lisp/org.el | 1 + 4 files changed, 65 insertions(+), 3 deletions(-) create mode 100644 lisp/ob-org.el diff --git a/Makefile b/Makefile index e5e51b2b5..c22f165f2 100644 --- a/Makefile +++ b/Makefile @@ -148,7 +148,8 @@ LISPF = org.el \ ob-gnuplot.el \ ob-octave.el \ ob-screen.el \ - ob-plantuml.el + ob-plantuml.el \ + ob-org.el LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES = $(LISPFILES0) lisp/org-install.el diff --git a/lisp/ob-org.el b/lisp/ob-org.el new file mode 100644 index 000000000..ad3b01389 --- /dev/null +++ b/lisp/ob-org.el @@ -0,0 +1,53 @@ +;;; ob-org.el --- org-babel functions for org code block evaluation + +;; Copyright (C) 2010 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org +;; Version: 7.01trans + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This is the simplest of code blocks, where upon evaluation the +;; contents of the code block are returned in a raw result. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:org + '((:results . "raw") (:exports . "results")) + "Default arguments for evaluating a org source block.") + +(defun org-babel-expand-body:org (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defun org-babel-execute:org (body params) + "Execute a block of Org code with. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:org (session params) + "Return an error because org does not support sessions." + (error "Org does not support sessions")) + +(provide 'ob-org) + +;; arch-tag: 130af5fe-cc56-46bd-9508-fa0ebd94cb1f + +;;; ob-org.el ends here diff --git a/lisp/ob.el b/lisp/ob.el index d6c63f798..4d702dbd5 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1202,7 +1202,12 @@ raw ----- results are added directly to the org-mode file. This is a good option if you code block will output org-mode formatted text. -org ----- this is the same as the 'raw' option +org ----- similar in effect to raw, only the results are wrapped + in an org code block. Similar to the raw option, on + export the results will be interpreted as org-formatted + text, however by wrapping the results in an org code + block they can be replaced upon re-execution of the + code block. html ---- results are added inside of a #+BEGIN_HTML block. This is a good option if you code block will output html @@ -1279,7 +1284,9 @@ code ---- the results are extracted in the syntax of the source ((member "code" result-params) (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" (or lang "none") results-switches result))) - ((or (member "raw" result-params) (member "org" result-params)) + ((member "org" result-params) + (insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result))) + ((member "raw" result-params) (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) (t (org-babel-examplize-region diff --git a/lisp/org.el b/lisp/org.el index 89fcdae86..1456b9594 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -160,6 +160,7 @@ requirements) is loaded." (const :tag "Mscgen" mscgen) (const :tag "Ocaml" ocaml) (const :tag "Octave" octave) + (const :tag "Org" org) (const :tag "Perl" perl) (const :tag "PlantUML" plantuml) (const :tag "Python" python) From e52909d90274d69a532f586c6b04ab8da062bfcf Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 26 Aug 2010 17:14:43 -0600 Subject: [PATCH 071/348] now possible to abort code block evaluation without throwing errors this makes it possible to export while not evaluating some code blocks * lisp/ob-exp.el (org-babel-exp-do-export): removing hacky ":noeval", which is now an alias to ":eval no" * lisp/ob.el (org-babel-confirm-evaluate): ":noeval" is an alias for ":eval no", also no longer throwing errors (org-babel-header-arg-names): adding both eval and noeval as general header arguments (org-babel-execute-src-block): now using the new non-error confirmation functionality --- lisp/ob-exp.el | 3 +- lisp/ob.el | 137 +++++++++++++++++++++++++------------------------ 2 files changed, 70 insertions(+), 70 deletions(-) diff --git a/lisp/ob-exp.el b/lisp/ob-exp.el index a7117e0e8..aec7d3149 100644 --- a/lisp/ob-exp.el +++ b/lisp/ob-exp.el @@ -195,8 +195,7 @@ options are taken from `org-babel-default-header-args'." The function respects the value of the :exports header argument." (flet ((silently () (let ((session (cdr (assoc :session (nth 2 info))))) (when (and session - (not (equal "none" session)) - (not (assoc :noeval (nth 2 info)))) + (not (equal "none" session))) (org-babel-exp-results info type 'silent)))) (clean () (org-babel-remove-result info))) (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) diff --git a/lisp/ob.el b/lisp/ob.el index 4d702dbd5..0e5149e81 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -182,18 +182,20 @@ confirmation from the user. Note disabling confirmation may result in accidental evaluation of potentially harmful code." - (let* ((eval (cdr (assoc :eval (nth 2 info)))) + (let* ((eval (or (cdr (assoc :eval (nth 2 info))) + (when (assoc :noeval (nth 2 info)) "no"))) (query (or (equal eval "query") (and (functionp org-confirm-babel-evaluate) (funcall org-confirm-babel-evaluate (nth 0 info) (nth 1 info))) org-confirm-babel-evaluate))) - (when (or (equal eval "never") - (and query - (not (yes-or-no-p - (format "Evaluate this%scode on your system? " - (if info (format " %s " (nth 0 info)) " ")))))) - (error "evaluation aborted")))) + (if (or (equal eval "never") (equal eval "no") + (and query + (not (yes-or-no-p + (format "Evaluate this%scode on your system? " + (if info (format " %s " (nth 0 info)) " ")))))) + (prog1 nil (message "evaluation aborted")) + t))) ;;;###autoload (defun org-babel-execute-safely-maybe () @@ -254,7 +256,7 @@ then run `org-babel-pop-to-session'." (defconst org-babel-header-arg-names '(cache cmdline colnames dir exports file noweb results - session tangle var noeval comments) + session tangle var eval noeval comments) "Common header arguments used by org-babel. Note that individual languages may define their own language specific header arguments as well.") @@ -322,66 +324,65 @@ Optionally supply a value for PARAMS which will be merged with the header arguments specified at the front of the source code block." (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - ;; note the `evaluation-confirmed' variable is currently not - ;; used, but could be used later to avoid the need for - ;; chaining confirmations - (evaluation-confirmed (org-babel-confirm-evaluate info)) - (lang (nth 0 info)) - (params (setf (nth 2 info) - (sort (org-babel-merge-params (nth 2 info) params) - (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) - (new-hash - (if (and (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params)))) - (org-babel-sha1-hash info))) - (old-hash (org-babel-result-hash info)) - (body (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (result-params (split-string (or (cdr (assoc :results params)) ""))) - (result-type (cond ((member "output" result-params) 'output) - ((member "value" result-params) 'value) - (t 'value))) - (cmd (intern (concat "org-babel-execute:" lang))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) - (org-babel-call-process-region-original - (if (boundp 'org-babel-call-process-region-original) org-babel-call-process-region-original - (symbol-function 'call-process-region))) - (indent (car (last info))) - result) - (unwind-protect - (flet ((call-process-region (&rest args) - (apply 'org-babel-tramp-handle-call-process-region args))) - (unless (fboundp cmd) - (error "No org-babel-execute function for %s!" lang)) - (if (and (not arg) new-hash (equal new-hash old-hash)) - (save-excursion ;; return cached result - (goto-char (org-babel-where-is-src-block-result nil info)) - (end-of-line 1) (forward-char 1) - (setq result (org-babel-read-result)) - (message (replace-regexp-in-string "%" "%%" - (format "%S" result))) result) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (setq result (funcall cmd body params)) - (if (eq result-type 'value) - (setq result (if (and (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) - result))) - (org-babel-insert-result - result result-params info new-hash indent lang) - (run-hooks 'org-babel-after-execute-hook) - result)) - (setq call-process-region 'org-babel-call-process-region-original)))) + (let ((info (or info (org-babel-get-src-block-info)))) + (when (org-babel-confirm-evaluate info) + (let* ((lang (nth 0 info)) + (params (setf + (nth 2 info) + (sort (org-babel-merge-params (nth 2 info) params) + (lambda (el1 el2) (string< (symbol-name (car el1)) + (symbol-name (car el2))))))) + (new-hash + (if (and (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params)))) + (org-babel-sha1-hash info))) + (old-hash (org-babel-result-hash info)) + (body (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (result-params (split-string (or (cdr (assoc :results params)) ""))) + (result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value))) + (cmd (intern (concat "org-babel-execute:" lang))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (org-babel-call-process-region-original + (if (boundp 'org-babel-call-process-region-original) + org-babel-call-process-region-original + (symbol-function 'call-process-region))) + (indent (car (last info))) + result) + (unwind-protect + (flet ((call-process-region (&rest args) + (apply 'org-babel-tramp-handle-call-process-region args))) + (unless (fboundp cmd) + (error "No org-babel-execute function for %s!" lang)) + (if (and (not arg) new-hash (equal new-hash old-hash)) + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (setq result (org-babel-read-result)) + (message (replace-regexp-in-string + "%" "%%" (format "%S" result))) result) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (setq result (funcall cmd body params)) + (if (eq result-type 'value) + (setq result (if (and (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) + result))) + (org-babel-insert-result + result result-params info new-hash indent lang) + (run-hooks 'org-babel-after-execute-hook) + result)) + (setq call-process-region 'org-babel-call-process-region-original)))))) (defun org-babel-expand-body:generic (body params &optional processed-params) "Expand BODY with PARAMS. From 3d2dbf8604a10b22e77eeed10002bc3f5b884a87 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 26 Aug 2010 17:36:26 -0600 Subject: [PATCH 072/348] additional ":results silent" default header argument for org code blocks Thanks to David Hajage for suggesting this fix * lisp/ob-org.el (org-babel-default-header-args:org): additional ":results silent" default header argument for org code blocks --- lisp/ob-org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob-org.el b/lisp/ob-org.el index ad3b01389..a3e77302e 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -31,7 +31,7 @@ (require 'ob) (defvar org-babel-default-header-args:org - '((:results . "raw") (:exports . "results")) + '((:results . "raw silent") (:exports . "results")) "Default arguments for evaluating a org source block.") (defun org-babel-expand-body:org (body params &optional processed-params) From 33f9d116bae28f5a51462d51c168b9bc2b0cfabb Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 27 Aug 2010 09:27:59 +0200 Subject: [PATCH 073/348] Remove some properties from ASCII-exported text --- lisp/org-ascii.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index 803770c8d..b4947d546 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -573,7 +573,10 @@ publishing directory." (goto-char (point-min)) (while (re-search-forward "\\[@start:[0-9]+\\] ?" nil t) (org-if-unprotected - (replace-match "")))) + (replace-match ""))) + (remove-text-properties + (point-min) (point-max) + '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil))) (defun org-html-expand-for-ascii (line) "Handle quoted HTML for ASCII export." From f0d58188ca0d1146cab64d3bdfd23cacf8a8872b Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 27 Aug 2010 09:29:25 +0200 Subject: [PATCH 074/348] Revert "Bug: possible bug in latex export [7.01trans (release_6.36.735.g15ca.dirty)]" This reverts commit bb0a1f190be361ce1d717d79d411b88406d74c33. --- lisp/org-latex.el | 29 +++++++---------------------- 1 file changed, 7 insertions(+), 22 deletions(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 4f27f425a..f2b9d55f3 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -952,28 +952,13 @@ Return a list reflecting the document structure." (defun org-export-latex-parse-subcontent (level odd) "Extract the subcontent of a section at LEVEL. If ODD Is non-nil, assume subcontent only contains odd sections." - - (let (nstars new-level) - ;; In the search, we should not assume there will be exactly - ;; LEVEL+1 stars in the next heading, as there may be more than - ;; that number of stars. hence the regexp should be \\*{N,} - ;; rather than just \\*{N} (i.e. no upper bound, but N is minimum - ;; number of stars to expect.) - ;; We then have to check how many stars were found, rather than - ;; assuming there were exactly N. - (when (org-re-search-forward-unprotected - (concat "^\\(\\(?:\\*\\)\\{" - (number-to-string (+ (if odd 4 2) level)) - ",\\}\\) \\(.*\\)$") - nil t) - (setq nstars (1- (- (match-end 1) (match-beginning 1)))) - (setq new-level (if odd - (/ (+ 3 nstars) 2);; not entirely sure why +3! - nstars))) - (if nstars - (org-export-latex-parse-global new-level odd) - nil) ; subcontent is nil - )) + (if (not (org-re-search-forward-unprotected + (concat "^\\(\\(?:\\*\\)\\{" + (number-to-string (+ (if odd 4 2) level)) + "\\}\\) \\(.*\\)$") + nil t)) + nil ; subcontent is nil + (org-export-latex-parse-global (+ (if odd 2 1) level) odd))) ;;; Rendering functions: (defun org-export-latex-global (content) From 7be6f7e3d58c57b6b9b1dce0225f63e46de38ec2 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 27 Aug 2010 10:02:05 +0200 Subject: [PATCH 075/348] Fix typo --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 1456b9594..0b69976c5 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14035,7 +14035,7 @@ only headings." (when (org-on-heading-p) (move-marker (make-marker) (point)))))))) -(defun org-find-exact-headling-in-buffer (heading &optional buffer pos-only) +(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) "Find node HEADING in BUFFER. Return a marker to the heading if it was found, or nil if not. If POS-ONLY is set, return just the position instead of a marker. @@ -14066,7 +14066,7 @@ When the target headline is found, return a marker to this location." (message "trying %s" file) (setq visiting (org-find-base-buffer-visiting file)) (setq buffer (or visiting (find-file-noselect file))) - (setq m (org-find-exact-headling-in-buffer + (setq m (org-find-exact-headline-in-buffer heading buffer)) (when (and (not m) (not visiting)) (kill-buffer buffer)) (and m (throw 'found m)))))) From 2554f27683f03e699c7006a472d3814278a613d3 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 27 Aug 2010 08:18:32 -0600 Subject: [PATCH 076/348] moved `org-save-outline-visibility' into org-macs.el Thanks to Nick Dokos for pointing out this as a fix to a Babel issue * lisp/org-macs.el (org-save-outline-visibility): moved from org.el * lisp/org.el: moved `org-save-outline-visibility' to org-macs.el --- lisp/org-macs.el | 19 +++++++++++++++++++ lisp/org.el | 20 -------------------- 2 files changed, 19 insertions(+), 20 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 77527d2a8..8136ff4c2 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -290,6 +290,25 @@ This is in contrast to merely setting it to 0." (match-beginning 0) string))) (replace-match newtext fixedcase literal string)) +(defmacro org-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. +This means that the buffer may change while running BODY, +but it also means that the buffer should stay alive +during the operation, because otherwise all these markers will +point nowhere." + (declare (indent 1)) + `(let ((data (org-outline-overlay-data ,use-markers))) + (unwind-protect + (progn + ,@body + (org-set-outline-overlay-data data)) + (when ,use-markers + (mapc (lambda (c) + (and (markerp (car c)) (move-marker (car c) nil)) + (and (markerp (cdr c)) (move-marker (cdr c) nil))) + data))))) + (defmacro org-with-limited-levels (&rest body) "Execute BODY with limited number of outline levels." `(let* ((outline-regexp (org-get-limited-outline-regexp))) diff --git a/lisp/org.el b/lisp/org.el index 0b69976c5..bc6263359 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6255,26 +6255,6 @@ DATA should have been made by `org-outline-overlay-data'." (overlay-put o 'invisible 'outline)) data))))) -(defmacro org-save-outline-visibility (use-markers &rest body) - "Save and restore outline visibility around BODY. -If USE-MARKERS is non-nil, use markers for the positions. -This means that the buffer may change while running BODY, -but it also means that the buffer should stay alive -during the operation, because otherwise all these markers will -point nowhere." - (declare (indent 1)) - `(let ((data (org-outline-overlay-data ,use-markers))) - (unwind-protect - (progn - ,@body - (org-set-outline-overlay-data data)) - (when ,use-markers - (mapc (lambda (c) - (and (markerp (car c)) (move-marker (car c) nil)) - (and (markerp (cdr c)) (move-marker (cdr c) nil))) - data))))) - - ;;; Folding of blocks (defconst org-block-regexp From b2861749d09ff9c09a7dca2b009a3513ec72b594 Mon Sep 17 00:00:00 2001 From: Magnus Henoch <magnus.henoch@gmail.com> Date: Fri, 27 Aug 2010 16:40:31 +0000 Subject: [PATCH 077/348] Fix :step day for agenda clockreport I just tried adding :step day to org-agenda-clockreport-parameter-plist, but then hitting R in the agenda caused a crash, since org-clocktable-steps expects ts and te to be strings, though in fact they are Gregorian day numbers. This patch fixes the problem for me. It's quite ugly, so I don't expect it to be committed in its current form :) but I hope it serves as inspiration for someone to figure out the right way to solve this. * lisp/org-clock.el (org-clocktable-steps): Allow ts and te to be day numbers. TINYCHANGE --- lisp/org-clock.el | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 4fa0397ac..5e4f4efba 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1971,10 +1971,22 @@ the currently selected interval size." (when block (setq cc (org-clock-special-range block nil t) ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (if ts (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))))) - (if te (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te))))) + (cond + ((numberp ts) + ;; If ts is a number, it's an absolute day number from org-agenda. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) + (setq ts (org-float-time (encode-time 0 0 0 day month year))))) + (ts + (setq ts (org-float-time + (apply 'encode-time (org-parse-time-string ts)))))) + (cond + ((numberp te) + ;; Likewise for te. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) + (setq te (org-float-time (encode-time 0 0 0 day month year))))) + (te + (setq te (org-float-time + (apply 'encode-time (org-parse-time-string te)))))) (setq p1 (plist-put p1 :header "")) (setq p1 (plist-put p1 :step nil)) (setq p1 (plist-put p1 :block nil)) From 344163403b648fc3a3097d6d3c1ede1deef55d00 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 27 Aug 2010 09:45:07 -0600 Subject: [PATCH 078/348] call to delete-file no longer throwing errors on some Emacsen Thanks to Erik Iverson for pointing this out * lisp/ob.el (org-babel-remove-temporary-directory): removed explicit second argument --- lisp/ob.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index 0e5149e81..cc2e116e4 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1694,7 +1694,7 @@ of `org-babel-temporary-directory'." ;; but more efficient (if (eq t (car (file-attributes file))) (delete-directory file) - (delete-file file nil))) + (delete-file file))) ;; We do not want to delete "." and "..". (directory-files org-babel-temporary-directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) From e3144785114d12981e0e3429c76b6f8f15c4b00f Mon Sep 17 00:00:00 2001 From: Glenn Morris <rgm@gnu.org> Date: Fri, 27 Aug 2010 14:35:09 -0600 Subject: [PATCH 079/348] Fix some more Org `check-declare' issues. * ob.el: Require org when compiling. (org-save-outline-visibility): Remove macro declaration. * ob-emacs-lisp.el: Require ob-comint when compiling, for macros. Remove unnecessary/macro declarations. * org-docview.el: Require doc-view when compiling. (doc-view-goto-page): Autoload rather than declaring. (doc-view-current-page): Remove macro declaration. * ob.el (tramp-compat-make-temp-file, org-edit-src-code) (org-entry-get, org-table-import): Fix declarations. (org-match-string-no-properties): Remove declaration. * ob-sh.el (org-babel-comint-in-buffer) (org-babel-comint-wait-for-output, org-babel-comint-buffer-livep) (org-babel-comint-with-output): Remove unnecessary declarations. * ob-R.el (orgtbl-to-tsv): Fix declaration. * org-list.el (org-entry-get): Fix declaration. --- lisp/ob-R.el | 2 +- lisp/ob-emacs-lisp.el | 5 +---- lisp/ob.el | 17 ++++++++++------- lisp/org-docview.el | 4 ++-- lisp/org-list.el | 3 ++- 5 files changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 25c220f68..3dda4f720 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -33,7 +33,7 @@ (require 'ob-eval) (eval-when-compile (require 'cl)) -(declare-function orgtbl-to-tsv "ob-table" (table params)) +(declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function R "ext:essd-r" (&optional start-args)) (declare-function inferior-ess-send-input "ext:ess-inf" ()) diff --git a/lisp/ob-emacs-lisp.el b/lisp/ob-emacs-lisp.el index a93abb453..efa5a674e 100644 --- a/lisp/ob-emacs-lisp.el +++ b/lisp/ob-emacs-lisp.el @@ -28,15 +28,12 @@ ;;; Code: (require 'ob) +(eval-when-compile (require 'ob-comint)) (defvar org-babel-default-header-args:emacs-lisp '((:hlines . "yes") (:colnames . "no")) "Default arguments for evaluating an emacs-lisp source block.") -(declare-function org-babel-comint-with-output "ob-comint" (&rest body)) -(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) -(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) (declare-function orgtbl-to-generic "org-table" (table params)) (defun org-babel-expand-body:emacs-lisp (body params &optional processed-params) diff --git a/lisp/ob.el b/lisp/ob.el index cc2e116e4..2ce069d7d 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -25,33 +25,36 @@ ;;; Commentary: ;; See the online documentation for more information -;; +;; ;; http://orgmode.org/worg/org-contrib/babel/ ;;; Code: -(eval-when-compile (require 'cl)) +(eval-when-compile + (require 'cl) + (require 'org)) ; org-save-outline-visibility macro (require 'org-macs) (defvar org-babel-call-process-region-original) (declare-function show-all "outline" ()) -(declare-function tramp-compat-make-temp-file "tramp" (filename &optional dir-flag)) +(declare-function tramp-compat-make-temp-file "tramp-compat" + (filename &optional dir-flag)) (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) (declare-function tramp-file-name-user "tramp" (vec)) (declare-function tramp-file-name-host "tramp" (vec)) (declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org" (context code edit-buffer-name)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) (declare-function org-save-outline-visibility "org" (use-markers &rest body)) (declare-function org-narrow-to-subtree "org" ()) -(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-make-options-regexp "org" (kwds &optional extra)) -(declare-function org-match-string-no-properties "org" (num &optional string)) (declare-function org-do-remove-indentation "org" (&optional n)) (declare-function org-show-context "org" (&optional key)) (declare-function org-at-table-p "org" (&optional table-type)) (declare-function org-cycle "org" (&optional arg)) (declare-function org-uniquify "org" (list)) -(declare-function org-table-import "org" (file arg)) +(declare-function org-table-import "org-table" (file arg)) (declare-function org-add-hook "org-compat" (hook function &optional append local)) (declare-function org-table-align "org-table" ()) (declare-function org-table-end "org-table" (&optional table-type)) diff --git a/lisp/org-docview.el b/lisp/org-docview.el index f1e465ede..0e05937f0 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -45,9 +45,9 @@ (require 'org) +(eval-when-compile (require 'doc-view)) ; doc-view-current-page macro -(declare-function doc-view-goto-page "doc-view" (page)) -(declare-function doc-view-current-page "doc-view" (&optional win)) +(autoload 'doc-view-goto-page "doc-view") (org-add-link-type "docview" 'org-docview-open) (add-hook 'org-store-link-functions 'org-docview-store-link) diff --git a/lisp/org-list.el b/lisp/org-list.el index cdfd2c510..acd6d93f0 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -51,7 +51,8 @@ (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-entry-get "org" (pom property &optional inherit)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-subtree "org" ()) From b183da4be6e4a8e5b1be8caa093b9098e5c9e8f5 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 27 Aug 2010 14:42:24 -0600 Subject: [PATCH 080/348] Babel: fixing compiler warnings * lisp/ob-R.el (ess-make-buffer-current): declared (ess-ask-for-ess-directory): declared (ess-local-process-name): declared * lisp/ob-latex.el (org-babel-latex-tex-to-pdf): capturing free variable * lisp/ob.el (org-edit-src-code): fixing arguments (org-edit-src-exit): declared (org-outline-overlay-data): declared (org-set-outline-overlay-data): declared --- lisp/ob-R.el | 3 +++ lisp/ob-latex.el | 2 +- lisp/ob.el | 5 ++++- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 3dda4f720..d16b659f3 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -36,6 +36,7 @@ (declare-function orgtbl-to-tsv "org-table" (table params)) (declare-function R "ext:essd-r" (&optional start-args)) (declare-function inferior-ess-send-input "ext:ess-inf" ()) +(declare-function ess-make-buffer-current "ext:ess-inf" ()) (defconst org-babel-header-arg-names:R '(width height bg units pointsize antialias quality compression @@ -151,6 +152,7 @@ This function is called by `org-babel-execute-src-block'." (if rownames-p "1" "NULL"))) (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) +(defvar ess-ask-for-ess-directory) (defun org-babel-R-initiate-session (session params) "If there is not a current R process then create one." (unless (string= session "none") @@ -169,6 +171,7 @@ This function is called by `org-babel-execute-src-block'." (buffer-name)))) (current-buffer)))))) +(defvar ess-local-process-name) (defun org-babel-R-associate-session (session) "Associate R code buffer with an R session. Make SESSION be the inferior ESS process associated with the diff --git a/lisp/ob-latex.el b/lisp/ob-latex.el index 773e3b6e0..dde3eae20 100644 --- a/lisp/ob-latex.el +++ b/lisp/ob-latex.el @@ -127,7 +127,7 @@ Extracted from `org-export-as-pdf' in org-latex.el." (pdffile (concat base ".pdf")) (cmds org-latex-to-pdf-process) (outbuf (get-buffer-create "*Org PDF LaTeX Output*")) - cmd) + output-dir cmd) (with-current-buffer outbuf (erase-buffer)) (message (concat "Processing LaTeX file " file "...")) (setq output-dir (file-name-directory file)) diff --git a/lisp/ob.el b/lisp/ob.el index 2ce069d7d..9711e57be 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -43,9 +43,12 @@ (declare-function tramp-file-name-host "tramp" (vec)) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name)) + (&optional context code edit-buffer-name quietp)) +(declare-function org-edit-src-exit "org-src" (&optional context)) (declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) (declare-function org-save-outline-visibility "org" (use-markers &rest body)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) +(declare-function org-set-outline-overlay-data "org" (data)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-make-options-regexp "org" (kwds &optional extra)) From de6ff60e2564c84328d38252acb8c9a88f8baaa7 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 27 Aug 2010 14:47:59 -0600 Subject: [PATCH 081/348] fixing circular require introduced by previous changes * lisp/ob.el (require): removing circular (require 'org) --- lisp/ob.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 9711e57be..59f4a8817 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -30,8 +30,7 @@ ;;; Code: (eval-when-compile - (require 'cl) - (require 'org)) ; org-save-outline-visibility macro + (require 'cl)) (require 'org-macs) (defvar org-babel-call-process-region-original) From 4054eb0b9b834816f7941652864b9e42ea2a191b Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 27 Aug 2010 16:59:08 -0600 Subject: [PATCH 082/348] ob-js: very preliminary support for evaluating Javascript code blocks This relies upon node.js as the Javascript execution engine. http://nodejs.org/ --- Makefile | 3 +- lisp/ob-js.el | 118 ++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/org.el | 1 + 3 files changed, 121 insertions(+), 1 deletion(-) create mode 100644 lisp/ob-js.el diff --git a/Makefile b/Makefile index c22f165f2..ec22eefae 100644 --- a/Makefile +++ b/Makefile @@ -149,7 +149,8 @@ LISPF = org.el \ ob-octave.el \ ob-screen.el \ ob-plantuml.el \ - ob-org.el + ob-org.el \ + ob-js.el LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES = $(LISPFILES0) lisp/org-install.el diff --git a/lisp/ob-js.el b/lisp/ob-js.el new file mode 100644 index 000000000..9c4855234 --- /dev/null +++ b/lisp/ob-js.el @@ -0,0 +1,118 @@ +;;; ob-js.el --- org-babel functions for Javascript + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, js +;; Homepage: http://orgmode.org +;; Version: 0.01 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; node.js | http://nodejs.org/ + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:js '() + "Default header arguments for js code blocks.") + +(defcustom org-babel-js-cmd "node" + "Name of command used to evaluate js blocks." + :group 'org-babel + :type 'string) + +(defvar org-babel-js-function-wrapper + "require('sys').print(require('sys').inspect(function(){%s}()));" + "Javascript code to print value of body.") + +(defun org-babel-expand-body:js (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (concat + (mapconcat ;; define any variables + (lambda (pair) (format "var %s=%s;" + (car pair) (org-babel-js-var-to-js (cdr pair)))) + vars "\n") "\n" body "\n"))) + +(defun org-babel-execute:js (body params) + "Execute a block of Javascript code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((processed-params (org-babel-process-params params)) + (session (not (string= (nth 0 processed-params) "none"))) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:js body params processed-params))) + (org-babel-js-read + (if session + (error "javascript sessions are not yet supported.") + (let ((script-file (org-babel-temp-file "js-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format org-babel-js-function-wrapper full-body) + full-body))) + (org-babel-eval (format "%s %s" org-babel-js-cmd script-file) "")))))) + +(defun org-babel-js-read (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-js-var-to-js (var) + "Convert VAR into a js variable. +Convert an elisp value into a string of js source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]") + (format "%S" var))) + +(defun org-babel-prep-session:js (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "not yet implemented")) + +(defun org-babel-js-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (error "Javascript sessions are not yet supported.")) + +(provide 'ob-js) + +;; arch-tag: 84401fb3-b8d9-4bb6-9a90-cbe2d103d494 + +;;; ob-js.el ends here diff --git a/lisp/org.el b/lisp/org.el index bc6263359..39c78860b 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -154,6 +154,7 @@ requirements) is loaded." (const :tag "Emacs Lisp" emacs-lisp) (const :tag "Gnuplot" gnuplot) (const :tag "Haskell" haskell) + (const :tag "Javascript" js) (const :tag "Latex" latex) (const :tag "Ledger" ledger) (const :tag "Matlab" matlab) From f6c09411a7a295230f8c033e54aadab14adf71e8 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 27 Aug 2010 18:01:24 -0600 Subject: [PATCH 083/348] ob-scheme: very preliminary support for evaluating scheme code blocks * Makefile (LISPF): adding ob-scheme.el to the makefile * lisp/ob-scheme.el: very preliminary support for evaluating scheme code blocks * lisp/org.el (org-babel-load-languages): adding scheme --- Makefile | 3 +- lisp/ob-scheme.el | 97 +++++++++++++++++++++++++++++++++++++++++++++++ lisp/org.el | 1 + 3 files changed, 100 insertions(+), 1 deletion(-) create mode 100644 lisp/ob-scheme.el diff --git a/Makefile b/Makefile index ec22eefae..1c1f31756 100644 --- a/Makefile +++ b/Makefile @@ -150,7 +150,8 @@ LISPF = org.el \ ob-screen.el \ ob-plantuml.el \ ob-org.el \ - ob-js.el + ob-js.el \ + ob-scheme.el LISPFILES0 = $(LISPF:%=lisp/%) LISPFILES = $(LISPFILES0) lisp/org-install.el diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el new file mode 100644 index 000000000..452a940ec --- /dev/null +++ b/lisp/ob-scheme.el @@ -0,0 +1,97 @@ +;;; ob-scheme.el --- org-babel functions for Scheme + +;; Copyright (C) 2010 Free Software Foundation + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, scheme +;; Homepage: http://orgmode.org +;; Version: 0.01 + +;;; License: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 3, or (at your option) +;; any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a working scheme implementation +;; (e.g. guile http://www.gnu.org/software/guile/guile.html) + +;;; Code: +(require 'ob) +(require 'ob-eval) + +(defvar org-babel-default-header-args:scheme '() + "Default header arguments for scheme code blocks.") + +(defcustom org-babel-scheme-cmd "guile" + "Name of command used to evaluate scheme blocks." + :group 'org-babel + :type 'string) + +(defun org-babel-expand-body:scheme (body params &optional processed-params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + +(defun org-babel-execute:scheme (body params) + "Execute a block of Scheme code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((processed-params (org-babel-process-params params)) + (session (not (string= (nth 0 processed-params) "none"))) + (result-type (nth 3 processed-params)) + (full-body (org-babel-expand-body:scheme body params processed-params))) + (read + (if session + ;; session evaluation + (error "Scheme sessions are not yet supported.") + ;; external evaluation + (let ((script-file (org-babel-temp-file "lisp-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format "(display %s)" full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-scheme-cmd script-file) "")))))) + +(defun org-babel-prep-session:scheme (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "not yet implemented")) + +(defun org-babel-scheme-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (error "Scheme sessions are not yet supported.")) + +(provide 'ob-scheme) + +;; arch-tag: 6b2fe76f-4b25-4e87-ad1c-225b2f282a71 + +;;; ob-scheme.el ends here diff --git a/lisp/org.el b/lisp/org.el index 39c78860b..d85a1702d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -167,6 +167,7 @@ requirements) is loaded." (const :tag "Python" python) (const :tag "Ruby" ruby) (const :tag "Sass" sass) + (const :tag "Scheme" scheme) (const :tag "Screen" screen) (const :tag "Shell Script" sh) (const :tag "Sql" sql) From 4b7c9136a71252c5fff1c8e3caf7e272a3b55d81 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Sun, 29 Aug 2010 21:29:16 +0200 Subject: [PATCH 084/348] Remove compile-time dependency on doc-view.el * org-docview.el (org-docview-store-link): Use expanded macro to get current page. (doc-view-goto-page, image-mode-window-get): Declare functions for byte compiler. doc-view mode is not available in Emacs22. We need to use the expanded form of the macro `doc-view-current-page' at compile-time. --- lisp/org-docview.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/org-docview.el b/lisp/org-docview.el index 0e05937f0..360c1fe01 100644 --- a/lisp/org-docview.el +++ b/lisp/org-docview.el @@ -45,7 +45,10 @@ (require 'org) -(eval-when-compile (require 'doc-view)) ; doc-view-current-page macro + +(declare-function doc-view-goto-page "ext:doc-view" (page)) +(declare-function image-mode-window-get "ext:image-mode" + (prop &optional winprops)) (autoload 'doc-view-goto-page "doc-view") @@ -66,7 +69,7 @@ (when (eq major-mode 'doc-view-mode) ;; This buffer is in doc-view-mode (let* ((path buffer-file-name) - (page (doc-view-current-page)) + (page (image-mode-window-get 'page)) (link (concat "docview:" path "::" (number-to-string page))) (description "")) (org-store-link-props From fdad92edd6c8919915eedce67da3b2571fee2543 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Sun, 29 Aug 2010 19:32:50 -0600 Subject: [PATCH 085/348] ob-plantuml: wrapping in-file and out-file in shell-quote-argument Thanks to Michael Gauland for pointing out this fix * lisp/ob-plantuml.el (org-babel-execute:plantuml): wrapping in-file and out-file in shell-quote-argument --- lisp/ob-plantuml.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index 9959f4025..c5045de6d 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -59,7 +59,10 @@ This function is called by `org-babel-execute-src-block'." (in-file (org-babel-temp-file "plantuml-")) (cmd (concat "java -jar " (shell-quote-argument org-plantuml-jar-path) - " -p " cmdline " < " in-file " > " out-file))) + " -p " cmdline " < " + (shell-quote-argument in-file) + " > " + (shell-quote-argument out-file)))) (unless (file-exists-p org-plantuml-jar-path) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) From 580a1cb3f3cb39e8cfb460a635ea0fb7325c9eff Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Mon, 30 Aug 2010 09:29:26 +0200 Subject: [PATCH 086/348] Update org-drill.el --- contrib/lisp/org-drill.el | 565 ++++++++++++++++++++++++++++++-------- 1 file changed, 447 insertions(+), 118 deletions(-) diff --git a/contrib/lisp/org-drill.el b/contrib/lisp/org-drill.el index 89c3124d0..a96916e4b 100644 --- a/contrib/lisp/org-drill.el +++ b/contrib/lisp/org-drill.el @@ -21,77 +21,8 @@ ;;; Different "card types" can be defined, which present their information to ;;; the student in different ways. ;;; -;;; -;;; Installation -;;; ============ -;;; -;;; Put the following in your .emacs: -;;; -;;; (add-to-list 'load-path "/path/to/org-drill/") -;;; (require 'org-drill) -;;; -;;; -;;; Writing the questions -;;; ===================== -;;; -;;; See the file "spanish.org" for an example set of material. -;;; -;;; Tag all items you want to be asked about with a tag that matches -;;; `org-drill-question-tag'. This is :drill: by default. -;;; -;;; You don't need to schedule the topics initially. However org-drill *will* -;;; recognise items that have been scheduled previously with `org-learn'. -;;; -;;; Within each question, the answer can be included in the following ways: -;;; -;;; - Question in the main body text, answer in subtopics. This is the -;;; default. All subtopics will be shown collapsed, while the text under -;;; the main heading will stay visible. -;;; -;;; - Each subtopic contains a piece of information related to the topic. ONE -;;; of these will revealed at random, and the others hidden. To define a -;;; topic of this type, give the topic a property `DRILL_CARD_TYPE' with -;;; value `multisided'. -;;; -;;; - Cloze deletion -- any pieces of text in the body of the card that are -;;; surrounded with [SINGLE square brackets] will be hidden when the card is -;;; presented to the user, and revealed once they press a key. Cloze deletion -;;; is automatically applied to all topics. -;;; -;;; - No explicit answer -- the user judges whether they recalled the -;;; fact adequately. -;;; -;;; - Other methods of your own devising, provided you write a function to -;;; handle selective display of the topic. See the function -;;; `org-drill-present-spanish-verb', which handles topics of type "spanish_verb", -;;; for an example. -;;; -;;; -;;; Running the drill session -;;; ========================= -;;; -;;; Start a drill session with `M-x org-drill'. This will include all eligible -;;; topics in the current buffer. `org-drill' can also be targeted at a particular -;;; subtree or particular files or sets of files; see the documentation of -;;; the function `org-drill' for details. -;;; -;;; During the drill session, you will be presented with each item, then asked -;;; to rate your recall of it by pressing a key between 0 and 5. At any time you -;;; can press 'q' to finish the drill early (your progress will be saved), or -;;; 'e' to finish the drill and jump to the current topic for editing. -;;; -;;; -;;; TODO -;;; ==== -;;; -;;; - encourage org-learn to reschedule "4" and "5" items. -;;; - nicer "cloze face" which does not hide the space preceding the cloze, -;;; and behaves more nicely across line breaks -;;; - hide drawers. -;;; - org-drill-question-tag should use a tag match string, rather than a -;;; single tag -;;; - when finished, display a message showing how many items reviewed, -;;; how many still pending, numbers in each recall category +;;; See the file README.org for more detailed documentation. + (eval-when-compile (require 'cl)) (eval-when-compile (require 'hi-lock)) @@ -132,20 +63,74 @@ Nil means unlimited." :type '(choice integer (const nil))) +(defcustom org-drill-failure-quality + 2 + "If the quality of recall for an item is this number or lower, +it is regarded as an unambiguous failure, and the repetition +interval for the card is reset to 0 days. By default this is +2. For Mnemosyne-like behaviour, set it to 1. Other values are +not really sensible." + :group 'org-drill + :type '(choice (const 2) (const 1))) -(defface org-drill-hidden-cloze-face - '((t (:foreground "blue" :background "blue"))) + +(defcustom org-drill-leech-failure-threshold + 15 + "If an item is forgotten more than this many times, it is tagged +as a 'leech' item." + :group 'org-drill + :type '(choice integer (const nil))) + + +(defcustom org-drill-leech-method + 'skip + "How should 'leech items' be handled during drill sessions? +Possible values: +- nil :: Leech items are treated the same as normal items. +- skip :: Leech items are not included in drill sessions. +- warn :: Leech items are still included in drill sessions, + but a warning message is printed when each leech item is + presented." + :group 'org-drill + :type '(choice (const 'warn) (const 'skip) (const nil))) + + +(defface org-drill-visible-cloze-face + '((t (:foreground "dark slate blue"))) "The face used to hide the contents of cloze phrases." :group 'org-drill) +(defcustom org-drill-use-visible-cloze-face-p + nil + "Use a special face to highlight cloze-deleted text in org mode +buffers?" + :group 'org-drill + :type 'boolean) + + +(defface org-drill-hidden-cloze-face + '((t (:foreground "deep sky blue" :background "blue"))) + "The face used to hide the contents of cloze phrases." + :group 'org-drill) + + +(setplist 'org-drill-cloze-overlay-defaults + '(display "[...]" + face org-drill-hidden-cloze-face + window t)) + + (defvar org-drill-cloze-regexp - "[^][]\\(\\[[^][][^]]*\\]\\)") + ;; ver 1 "[^][]\\(\\[[^][][^]]*\\]\\)" + ;; ver 2 "\\(\\[.*?\\]\\|^[^[[:cntrl:]]*?\\]\\|\\[.*?$\\)" + "\\(\\[.*?\\]\\|\\[.*?[[:cntrl:]]+.*?\\]\\)") (defcustom org-drill-card-type-alist '((nil . org-drill-present-simple-card) ("simple" . org-drill-present-simple-card) + ("twosided" . org-drill-present-two-sided-card) ("multisided" . org-drill-present-multi-sided-card) ("spanish_verb" . org-drill-present-spanish-verb)) "Alist associating card types with presentation functions. Each entry in the @@ -156,6 +141,29 @@ boolean value." :type '(alist :key-type (choice string (const nil)) :value-type function)) +(defcustom org-drill-spaced-repetition-algorithm + 'sm5 + "Which SuperMemo spaced repetition algorithm to use for scheduling items. +Available choices are SM2 and SM5." + :group 'org-drill + :type '(choice (const 'sm2) (const 'sm5))) + +(defcustom org-drill-add-random-noise-to-intervals-p + nil + "If true, the number of days until an item's next repetition +will vary slightly from the interval calculated by the SM2 +algorithm. The variation is very small when the interval is +small, and scales up with the interval. The code for calculating +random noise is adapted from Mnemosyne." + :group 'org-drill + :type 'boolean) + + +(defvar *org-drill-done-entry-count* 0) +(defvar *org-drill-pending-entry-count* 0) +(defvar *org-drill-session-qualities* nil) +(defvar *org-drill-start-time* 0) + (defun shuffle-list (list) "Randomly permute the elements of LIST (all permutations equally likely)." @@ -174,19 +182,182 @@ boolean value." +(defun org-drill-entry-p () + "Is the current entry a 'drill item'?" + (or (assoc "LEARN_DATA" (org-entry-properties nil)) + (member org-drill-question-tag (org-get-local-tags)))) + + +(defun org-part-of-drill-entry-p () + "Is the current entry either the main heading of a 'drill item', +or a subheading within a drill item?" + (or (org-drill-entry-p) + ;; Does this heading INHERIT the drill tag + (member org-drill-question-tag (org-get-tags-at)))) + + +(defun org-drill-entry-leech-p () + "Is the current entry a 'leech item'?" + (and (org-drill-entry-p) + (member "leech" (org-get-local-tags)))) + + (defun org-drill-entry-due-p () (let ((item-time (org-get-scheduled-time (point)))) - (and (or (assoc "LEARN_DATA" (org-entry-properties nil)) - (member org-drill-question-tag (org-get-local-tags))) + (and (org-drill-entry-p) + (or (not (eql 'skip org-drill-leech-method)) + (not (org-drill-entry-leech-p))) (or (null item-time) - (not (minusp ; scheduled for today/in - ; future + (not (minusp ; scheduled for today/in future (- (time-to-days (current-time)) (time-to-days item-time)))))))) +(defun org-drill-entry-new-p () + (let ((item-time (org-get-scheduled-time (point)))) + (and (org-drill-entry-p) + (null item-time)))) + + + +(defun org-drill-entry-last-quality () + (let ((quality (cdr (assoc "DRILL_LAST_QUALITY" (org-entry-properties nil))))) + (if quality + (string-to-number quality) + nil))) + + +;;; SM2 Algorithm ============================================================= + + +(defun determine-next-interval-sm2 (last-interval n ef quality of-matrix) + "Arguments: +- LAST-INTERVAL -- the number of days since the item was last reviewed. +- N -- the number of times the item has been successfully reviewed +- EF -- the 'easiness factor' +- QUALITY -- 0 to 5 +- OF-MATRIX -- a matrix of values, used by SM5 but not by SM2. + +Returns a list: (INTERVAL N EF OFMATRIX), where: +- INTERVAL is the number of days until the item should next be reviewed +- N is incremented by 1. +- EF is modified based on the recall quality for the item. +- OF-MATRIX is not modified." + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (if (<= quality org-drill-failure-quality) + ;; When an item is failed, its interval is reset to 0, + ;; but its EF is unchanged + (list -1 1 ef of-matrix) + ;; else: + (let* ((next-ef (modify-e-factor ef quality)) + (interval + (cond + ((<= n 1) 1) + ((= n 2) + (cond + (org-drill-add-random-noise-to-intervals-p + (case quality + (5 6) + (4 4) + (3 3) + (2 1) + (t -1))) + (t 6))) + (t (ceiling (* last-interval next-ef)))))) + (list (round + (if org-drill-add-random-noise-to-intervals-p + (+ last-interval (* (- interval last-interval) + (org-drill-random-dispersal-factor))) + interval)) + (1+ n) next-ef of-matrix)))) + + +;;; SM5 Algorithm ============================================================= + +;;; From http://www.supermemo.com/english/ol/sm5.htm +(defun org-drill-random-dispersal-factor () + (let ((a 0.047) + (b 0.092) + (p (- (random* 1.0) 0.5))) + (flet ((sign (n) + (cond ((zerop n) 0) + ((plusp n) 1) + (t -1)))) + (/ (+ 100 (* (* (/ -1 b) (log (- 1 (* (/ b a ) (abs p))))) + (sign p))) + 100)))) + + +(defun inter-repetition-interval-sm5 (last-interval n ef &optional of-matrix) + (let ((of (get-optimal-factor n ef of-matrix))) + (if (= 1 n) + of + (* of last-interval)))) + + +(defun determine-next-interval-sm5 (last-interval n ef quality of-matrix) + (assert (> n 0)) + (assert (and (>= quality 0) (<= quality 5))) + (let ((next-ef (modify-e-factor ef quality)) + (interval nil)) + (setq of-matrix + (set-optimal-factor n next-ef of-matrix + (modify-of (get-optimal-factor n ef of-matrix) + quality org-learn-fraction)) + ef next-ef) + + (cond + ;; "Failed" -- reset repetitions to 0, + ((<= quality org-drill-failure-quality) + (list -1 1 ef of-matrix)) ; Not clear if OF matrix is supposed to be + ; preserved + ;; For a zero-based quality of 4 or 5, don't repeat + ((and (>= quality 4) + (not org-learn-always-reschedule)) + (list 0 (1+ n) ef of-matrix)) ; 0 interval = unschedule + (t + (setq interval (inter-repetition-interval-sm5 + last-interval n ef of-matrix)) + (if org-drill-add-random-noise-to-intervals-p + (setq interval (+ last-interval + (* (- interval last-interval) + (org-drill-random-dispersal-factor))))) + (list (round interval) (1+ n) ef of-matrix))))) + + +;;; Essentially copied from `org-learn.el', but modified to +;;; optionally call the SM2 function above. +(defun org-drill-smart-reschedule (quality) + (interactive "nHow well did you remember the information (on a scale of 0-5)? ") + (let* ((learn-str (org-entry-get (point) "LEARN_DATA")) + (learn-data (or (and learn-str + (read learn-str)) + (copy-list initial-repetition-state))) + closed-dates) + (setq learn-data + (case org-drill-spaced-repetition-algorithm + (sm5 (determine-next-interval-sm5 (nth 0 learn-data) + (nth 1 learn-data) + (nth 2 learn-data) + quality + (nth 3 learn-data))) + (sm2 (determine-next-interval-sm2 (nth 0 learn-data) + (nth 1 learn-data) + (nth 2 learn-data) + quality + (nth 3 learn-data))))) + (org-entry-put (point) "LEARN_DATA" (prin1-to-string learn-data)) + (cond + ((= 0 (nth 0 learn-data)) + (org-schedule t)) + (t + (org-schedule nil (time-add (current-time) + (days-to-time (nth 0 learn-data)))))))) + (defun org-drill-reschedule () + "Returns quality rating (0-5), or nil if the user quit." (let ((ch nil)) (while (not (memq ch '(?q ?0 ?1 ?2 ?3 ?4 ?5))) (setq ch (read-char @@ -205,9 +376,21 @@ How well did you do? (0-5, ?=help, q=quit)" "How well did you do? (0-5, ?=help, q=quit)")))) (cond ((and (>= ch ?0) (<= ch ?5)) - (save-excursion - (org-smart-reschedule (- ch 48))) - ch) + (let ((quality (- ch ?0)) + (failures (cdr (assoc "DRILL_FAILURE_COUNT" (org-entry-properties nil))))) + (save-excursion + (org-drill-smart-reschedule quality)) + (push quality *org-drill-session-qualities*) + (cond + ((<= quality org-drill-failure-quality) + (when org-drill-leech-failure-threshold + (setq failures (if failures (string-to-number failures) 0)) + (org-set-property "DRILL_FAILURE_COUNT" + (format "%d" (1+ failures))) + (if (> (1+ failures) org-drill-leech-failure-threshold) + (org-toggle-tag "leech" 'on))))) + (org-set-property "DRILL_LAST_QUALITY" (format "%d" quality)) + quality)) (t nil)))) @@ -231,18 +414,54 @@ the current topic." (reverse drill-sections))) + (defun org-drill-presentation-prompt (&rest fmt-and-args) - (let ((ch (read-char (if fmt-and-args - (apply 'format - (first fmt-and-args) - (rest fmt-and-args)) - "Press any key to see the answer, 'e' to edit, 'q' to quit.")))) + (let ((ch nil) + (prompt + (if fmt-and-args + (apply 'format + (first fmt-and-args) + (rest fmt-and-args)) + "Press any key to see the answer, 'e' to edit, 'q' to quit."))) + (setq prompt + (format "(%d) %s" *org-drill-pending-entry-count* prompt)) + (if (and (eql 'warn org-drill-leech-method) + (org-drill-entry-leech-p)) + (setq prompt (concat "!!! LEECH ITEM !!! +You seem to be having a lot of trouble memorising this item. +Consider reformulating the item to make it easier to remember.\n" prompt))) + (setq ch (read-char prompt)) (case ch (?q nil) (?e 'edit) (otherwise t)))) +(defun org-drill-hide-clozed-text () + (let ((ovl nil)) + (save-excursion + (while (re-search-forward org-drill-cloze-regexp nil t) + (setf ovl (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ovl 'category + 'org-drill-cloze-overlay-defaults) + (when (find ?| (match-string 0)) + (overlay-put ovl + 'display + (format "[...%s]" + (substring-no-properties + (match-string 0) + (1+ (position ?| (match-string 0))) + (1- (length (match-string 0))))))))))) + + +(defun org-drill-unhide-clozed-text () + (save-excursion + (dolist (ovl (overlays-in (point-min) (point-max))) + (when (eql 'org-drill-cloze-overlay-defaults (overlay-get ovl 'category)) + (delete-overlay ovl))))) + + + ;;; Presentation functions ==================================================== ;; Each of these is called with point on topic heading. Each needs to show the @@ -258,6 +477,18 @@ the current topic." (org-show-subtree))) +(defun org-drill-present-two-sided-card () + (let ((drill-sections (org-drill-hide-all-subheadings-except nil))) + (when drill-sections + (save-excursion + (goto-char (nth (random (min 2 (length drill-sections))) drill-sections)) + (org-show-subtree))) + (prog1 + (org-drill-presentation-prompt) + (org-show-subtree)))) + + + (defun org-drill-present-multi-sided-card () (let ((drill-sections (org-drill-hide-all-subheadings-except nil))) (when drill-sections @@ -323,6 +554,9 @@ the current topic." Review will occur regardless of whether the topic is due for review or whether it meets the definition of a 'review topic' used by `org-drill'. +Returns a quality rating from 0 to 5, or nil if the user quit, or the symbol +EDIT if the user chose to exit the drill and edit the current item. + See `org-drill' for more details." (interactive) (unless (org-at-heading-p) @@ -332,15 +566,20 @@ See `org-drill' for more details." (save-restriction (org-narrow-to-subtree) (org-show-subtree) - (org-cycle-hide-drawers 'overview) + (org-cycle-hide-drawers 'all) (let ((presentation-fn (cdr (assoc card-type org-drill-card-type-alist)))) (cond (presentation-fn - (highlight-regexp org-drill-cloze-regexp - 'org-drill-hidden-cloze-face) - (setq cont (funcall presentation-fn)) - (unhighlight-regexp org-drill-cloze-regexp)) + (org-drill-hide-clozed-text) + ;;(highlight-regexp org-drill-cloze-regexp + ;; 'org-drill-hidden-cloze-face) + (unwind-protect + (progn + (setq cont (funcall presentation-fn))) + (org-drill-unhide-clozed-text)) + ;;(unhighlight-regexp org-drill-cloze-regexp) + ) (t (error "Unknown card type: '%s'" card-type)))) @@ -355,6 +594,80 @@ See `org-drill' for more details." (org-drill-reschedule))))))) +(defun org-drill-entries (entries) + "Returns nil, t, or a list of markers representing entries that were +'failed' and need to be presented again before the session ends." + (let ((again-entries nil) + (*org-drill-done-entry-count* 0) + (*org-drill-pending-entry-count* (length entries))) + (if (and org-drill-maximum-items-per-session + (> (length entries) + org-drill-maximum-items-per-session)) + (setq entries (subseq entries 0 + org-drill-maximum-items-per-session))) + (block org-drill-entries + (dolist (m entries) + (save-restriction + (switch-to-buffer (marker-buffer m)) + (goto-char (marker-position m)) + (setq result (org-drill-entry)) + (cond + ((null result) + (message "Quit") + (return-from org-drill-entries nil)) + ((eql result 'edit) + (setq end-pos (point-marker)) + (return-from org-drill-entries nil)) + (t + (cond + ((< result 3) + (push m again-entries)) + (t + (decf *org-drill-pending-entry-count*) + (incf *org-drill-done-entry-count*))) + (when (and org-drill-maximum-duration + (> (- (float-time (current-time)) *org-drill-start-time*) + (* org-drill-maximum-duration 60))) + (message "This drill session has reached its maximum duration.") + (return-from org-drill-entries nil)))))) + (or again-entries + t)))) + + +(defun org-drill-final-report () + (read-char +(format + "%d items reviewed, %d items awaiting review +Session duration %s + +Recall of reviewed items: + Excellent (5): %3d%% + Good (4): %3d%% + Hard (3): %3d%% + Near miss (2): %3d%% + Failure (1): %3d%% + Total failure (0): %3d%% + +Session finished. Press a key to continue..." + *org-drill-done-entry-count* + *org-drill-pending-entry-count* + (format-seconds "%h:%.2m:%.2s" + (- (float-time (current-time)) *org-drill-start-time*)) + (round (* 100 (count 5 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 4 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 3 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 2 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 1 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + (round (* 100 (count 0 *org-drill-session-qualities*)) + (max 1 (length *org-drill-session-qualities*))) + ))) + + (defun org-drill (&optional scope) "Begin an interactive 'drill session'. The user is asked to @@ -398,49 +711,65 @@ agenda-with-archives (interactive) (let ((entries nil) + (failed-entries nil) + (new-entries nil) + (old-entries nil) (result nil) (results nil) (end-pos nil)) (block org-drill + (setq *org-drill-session-qualities* nil) + (setq *org-drill-start-time* (float-time (current-time))) (save-excursion (org-map-entries - (lambda () (if (org-drill-entry-due-p) - (push (point-marker) entries))) + (lambda () (when (org-drill-entry-due-p) + (cond + ((org-drill-entry-new-p) + (push (point-marker) new-entries)) + ((<= (org-drill-entry-last-quality) + org-drill-failure-quality) + (push (point-marker) failed-entries)) + (t + (push (point-marker) old-entries))))) "" scope) + ;; Failed first, then random mix of old + new + (setq entries (append (shuffle-list failed-entries) + (shuffle-list (append old-entries + new-entries)))) (cond ((null entries) (message "I did not find any pending drill items.")) (t - (let ((start-time (float-time (current-time)))) - (dolist (m (if (and org-drill-maximum-items-per-session - (> (length entries) - org-drill-maximum-items-per-session)) - (subseq (shuffle-list entries) 0 - org-drill-maximum-items-per-session) - (shuffle-list entries))) - (save-restriction - (switch-to-buffer (marker-buffer m)) - (goto-char (marker-position m)) - (setq result (org-drill-entry)) - (cond - ((null result) - (message "Quit") - (return-from org-drill nil)) - ((eql result 'edit) - (setq end-pos (point-marker)) - (return-from org-drill nil)) - ((and org-drill-maximum-duration - (> (- (float-time (current-time)) start-time) - (* org-drill-maximum-duration 60))) - (message "This drill session has reached its maximum duration.") - (return-from org-drill nil))))) + (let ((again t)) + (while again + (when (listp again) + (setq entries (shuffle-list again))) + (setq again (org-drill-entries entries)) + (cond + ((null again) + (return-from org-drill nil)) + ((eql t again) + (setq again nil)))) (message "Drill session finished!") ))))) - (when end-pos + (cond + (end-pos (switch-to-buffer (marker-buffer end-pos)) (goto-char (marker-position end-pos)) - (message "Edit topic.")))) + (message "Edit topic.")) + (t + (org-drill-final-report))))) +(add-hook 'org-mode-hook + (lambda () + (if org-drill-use-visible-cloze-face-p + (font-lock-add-keywords + 'org-mode + `((,org-drill-cloze-regexp + (0 'org-drill-visible-cloze-face nil))) + t)))) + + (provide 'org-drill) From 9bc1d0c74f704da55d5fc0a1ac09b1056a76090c Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Mon, 30 Aug 2010 09:39:52 +0200 Subject: [PATCH 087/348] Avoid a star in a headline to be interpreted as multiline emphasis * lisp/org-exp.el (org-export-concatenate-multiline-emphasis): Ignore matches that start in a headline. --- lisp/org-exp.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 220e57c9a..67d9e28c4 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1838,7 +1838,9 @@ can work correctly." (if (and (not (= (char-after (match-beginning 3)) (char-after (match-beginning 4)))) (save-excursion (goto-char (match-beginning 0)) - (save-match-data (not (org-at-table-p))))) + (save-match-data + (and (not (org-at-table-p)) + (not (org-at-heading-p)))))) (org-if-unprotected (subst-char-in-region (match-beginning 0) (match-end 0) ?\n ?\ t) From b212d2ed606128e4cde01f2d982f318977501363 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Mon, 30 Aug 2010 13:51:04 +0200 Subject: [PATCH 088/348] Align tags after capture template tags insertion * lisp/org-capture.el (org-capture-fill-template): Align tags after insertion. --- lisp/org-capture.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index e5449642c..acbccc1fd 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1210,7 +1210,8 @@ The template may still contain \"%?\" for cursor positioning." (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) (insert ins) - (or (equal (char-after) ?:) (insert ":"))))) + (or (equal (char-after) ?:) (insert ":")) + (and (org-on-heading-p) (org-set-tags nil 'align))))) ((equal char "C") (cond ((= (length clipboards) 1) (insert (car clipboards))) ((> (length clipboards) 1) From 08cdd0557967d69a093b1642a4467e800fe84c4b Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Mon, 30 Aug 2010 09:26:02 -0700 Subject: [PATCH 089/348] babel: Cleaner session evaluation for R in :results value case * ob-comint.el (org-babel-comint-eval-invisibly-and-wait-for-file): New function to evaluate code invisibly and block until output file exists. * ob-R.el (org-babel-R-evaluate-session): Use `ess-eval-buffer' to evaluate R code in session for :results value. Write result to file invisibly using new function `org-babel-comint-eval-invisibly-and-wait-for-file'. These changes move to using standard ESS code evaluation in R sessions in the :results value case, which avoids unnecessary output to the comint buffer. In addition, the R command responsible for writing the result to file is hidden from the user. --- lisp/ob-R.el | 17 ++++++++--------- lisp/ob-comint.el | 17 +++++++++++++++++ 2 files changed, 25 insertions(+), 9 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index d16b659f3..e726d034a 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -259,21 +259,20 @@ string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value - (let ((tmp-file (org-babel-temp-file "R-")) - broke) - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat - #'org-babel-chomp - (list - body + (with-temp-buffer + (insert (org-babel-chomp body)) + (let ((ess-local-process-name + (process-name (get-buffer-process session)))) + (ess-eval-buffer nil))) + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-comint-eval-invisibly-and-wait-for-file + session (org-babel-maybe-remote-file tmp-file) (format org-babel-R-wrapper-lastvar tmp-file (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE")) - org-babel-R-eoe-indicator) "\n")) - (inferior-ess-send-input)) (org-babel-R-process-value-result (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index c7d3d14a0..ff7f0cba9 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -136,6 +136,23 @@ statement (not large blocks of code)." "comint-highlight-prompt")))) (accept-process-output (get-buffer-process buffer))))) +(defun org-babel-comint-eval-invisibly-and-wait-for-file + (buffer file string &optional period) + "Evaluate STRING in BUFFER invisibly. +Don't return until FILE exists. Code in STRING must ensure that +FILE exists at end of evaluation." + (unless (org-babel-comint-buffer-livep buffer) + (error "buffer %s doesn't exist or has no process" buffer)) + (if (file-exists-p file) (delete-file file)) + (process-send-string + (get-buffer-process buffer) + (if (string-match "\n$" string) string (concat string "\n"))) + ;; From Tramp 2.1.19 the following cache flush is not necessary + (if (file-remote-p default-directory) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v ""))) + (while (not (file-exists-p file)) (sit-for (or period 0.25)))) + (provide 'ob-comint) ;; arch-tag: 9adddce6-0864-4be3-b0b5-6c5157dc7889 From fcfba8d487ffe1c03ede5daa101137a408edeae4 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Sat, 28 Aug 2010 08:52:37 -0400 Subject: [PATCH 090/348] babel: R: Unify R write-to-file expressions * ob-R.el (org-babel-R-write-object-command): New unified R command for writing results to file (org-babel-R-wrapper-method): Remove variable (org-babel-R-wrapper-lastvar): Remove variable (org-babel-R-evaluate-external-process): Use new R command (org-babel-R-evaluate-session): Use new R command --- lisp/ob-R.el | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index e726d034a..31312d920 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -217,9 +217,7 @@ current code buffer." (defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") (defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") -(defvar org-babel-R-wrapper-method "main <- function ()\n{\n%s\n} -write.table(main(), file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") -(defvar org-babel-R-wrapper-lastvar "write.table(.Last.value, file=\"%s\", sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE)") +(defvar org-babel-R-write-object-command "{function(object, transfer.file) {invisible(if(inherits(try(write.table(object, file=transfer.file, sep=\"\\t\", na=\"nil\",row.names=%s, col.names=%s, quote=FALSE), silent=TRUE),\"try-error\")) {if(!file.exists(transfer.file)) file.create(transfer.file)})}}(object=%s, transfer.file=\"%s\")") (defun org-babel-R-evaluate (session body result-type column-names-p row-names-p) @@ -240,12 +238,13 @@ last statement in BODY, as elisp." (value (let ((tmp-file (org-babel-temp-file "R-results-"))) (org-babel-eval org-babel-R-command - (format org-babel-R-wrapper-method - body tmp-file + (format org-babel-R-write-object-command (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") - "FALSE"))) + "FALSE") + (format "{function ()\n{\n%s\n}}()" body) + tmp-file)) (org-babel-R-process-value-result (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) @@ -267,12 +266,12 @@ last statement in BODY, as elisp." (let ((tmp-file (org-babel-temp-file "R-"))) (org-babel-comint-eval-invisibly-and-wait-for-file session (org-babel-maybe-remote-file tmp-file) - (format org-babel-R-wrapper-lastvar - tmp-file - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE")) + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + ".Last.value" tmp-file)) (org-babel-R-process-value-result (org-babel-import-elisp-from-file (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) From 9c878a8290c071fbe5e97bc33c300ef2f07d6153 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Mon, 30 Aug 2010 09:34:05 -0700 Subject: [PATCH 091/348] babel: Fix temporary file processing in the remote execution case. * ob.el (org-babel-temp-file): Don't use babel temporary directory in remote case; use make-temp-file with remote file name so that temp file is guaranteed not to exist previously on remote machine. (org-babel-tramp-localname): New function to return local name portion of possibly remote file specification * ob-R.el (org-babel-R-evaluate-external-process): Respond to changes in `org-babel-temp-file'; pass local file name to remote R process. (org-babel-R-evaluate-session) Respond to changes in `org-babel-temp-file'; pass local file name to remote R process. --- lisp/ob-R.el | 14 ++++++-------- lisp/ob.el | 21 +++++++++++++++++---- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 31312d920..19632711f 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -236,7 +236,7 @@ string. If RESULT-TYPE equals 'value then return the value of the last statement in BODY, as elisp." (case result-type (value - (let ((tmp-file (org-babel-temp-file "R-results-"))) + (let ((tmp-file (org-babel-temp-file "R-"))) (org-babel-eval org-babel-R-command (format org-babel-R-write-object-command (if row-names-p "TRUE" "FALSE") @@ -244,10 +244,9 @@ last statement in BODY, as elisp." (if row-names-p "NA" "TRUE") "FALSE") (format "{function ()\n{\n%s\n}}()" body) - tmp-file)) + (org-babel-tramp-localname tmp-file))) (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) + (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p))) (output (org-babel-eval org-babel-R-command body)))) (defun org-babel-R-evaluate-session @@ -265,16 +264,15 @@ last statement in BODY, as elisp." (ess-eval-buffer nil))) (let ((tmp-file (org-babel-temp-file "R-"))) (org-babel-comint-eval-invisibly-and-wait-for-file - session (org-babel-maybe-remote-file tmp-file) + session tmp-file (format org-babel-R-write-object-command (if row-names-p "TRUE" "FALSE") (if column-names-p (if row-names-p "NA" "TRUE") "FALSE") - ".Last.value" tmp-file)) + ".Last.value" (org-babel-tramp-localname tmp-file))) (org-babel-R-process-value-result - (org-babel-import-elisp-from-file - (org-babel-maybe-remote-file tmp-file) '(16)) column-names-p))) + (org-babel-import-elisp-from-file tmp-file '(16)) column-names-p))) (output (mapconcat #'org-babel-chomp diff --git a/lisp/ob.el b/lisp/ob.el index 59f4a8817..619421a84 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1671,6 +1671,13 @@ the remote connection." (concat "/" user (when user "@") host ":" file)) file)) +(defun org-babel-tramp-localname (file) + "Return the local name component of FILE." + (if (file-remote-p file) + (with-parsed-tramp-file-name file nil + localname) + file)) + (defvar org-babel-temporary-directory (or (and (boundp 'org-babel-temporary-directory) org-babel-temporary-directory) @@ -1684,10 +1691,16 @@ Emacs shutdown.") Passes PREFIX and SUFFIX directly to `make-temp-file' with the value of `temporary-file-directory' temporarily set to the value of `org-babel-temporary-directory'." - (let ((temporary-file-directory (expand-file-name - org-babel-temporary-directory - temporary-file-directory))) - (make-temp-file prefix nil suffix))) + (if (file-remote-p default-directory) + (make-temp-file + (concat (file-remote-p default-directory) + (expand-file-name + prefix temporary-file-directory) + nil suffix)) + (let ((temporary-file-directory (expand-file-name + org-babel-temporary-directory + temporary-file-directory))) + (make-temp-file prefix nil suffix)))) (defun org-babel-remove-temporary-directory () "Remove `org-babel-temporary-directory' on Emacs shutdown." From 8cb53ddc1a2960c4e5eccc3c9be605ea7f492e4b Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Mon, 30 Aug 2010 18:20:01 -0700 Subject: [PATCH 092/348] babel: Eliminate compiler warnings * ob.el (with-parsed-tramp-file-name): declared (org-babel-tramp-localname): Ensure variable name exists locally * ob-R.el (ess-eval-buffer): declared * ob-comint.el (with-parsed-tramp-file-name): declared (tramp-flush-directory-property): declared (org-babel-comint-eval-invisibly-and-wait-for-file): Ensure variable name exists locally --- lisp/ob-R.el | 1 + lisp/ob-comint.el | 7 +++++-- lisp/ob.el | 6 ++++-- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 19632711f..76e83e8f3 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -37,6 +37,7 @@ (declare-function R "ext:essd-r" (&optional start-args)) (declare-function inferior-ess-send-input "ext:ess-inf" ()) (declare-function ess-make-buffer-current "ext:ess-inf" ()) +(declare-function ess-eval-buffer "ext:ess-inf" (vis)) (defconst org-babel-header-arg-names:R '(width height bg units pointsize antialias quality compression diff --git a/lisp/ob-comint.el b/lisp/ob-comint.el index ff7f0cba9..cef27ff60 100644 --- a/lisp/ob-comint.el +++ b/lisp/ob-comint.el @@ -34,6 +34,8 @@ (require 'ob) (require 'comint) (eval-when-compile (require 'cl)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function tramp-flush-directory-property "tramp" (vec directory)) (defun org-babel-comint-buffer-livep (buffer) "Check if BUFFER is a comint buffer with a live process." @@ -149,8 +151,9 @@ FILE exists at end of evaluation." (if (string-match "\n$" string) string (concat string "\n"))) ;; From Tramp 2.1.19 the following cache flush is not necessary (if (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v ""))) + (let (v) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v "")))) (while (not (file-exists-p file)) (sit-for (or period 0.25)))) (provide 'ob-comint) diff --git a/lisp/ob.el b/lisp/ob.el index 619421a84..56005a6d3 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -40,6 +40,7 @@ (declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) (declare-function tramp-file-name-user "tramp" (vec)) (declare-function tramp-file-name-host "tramp" (vec)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-edit-src-code "org-src" (&optional context code edit-buffer-name quietp)) @@ -1674,8 +1675,9 @@ the remote connection." (defun org-babel-tramp-localname (file) "Return the local name component of FILE." (if (file-remote-p file) - (with-parsed-tramp-file-name file nil - localname) + (let (localname) + (with-parsed-tramp-file-name file nil + localname)) file)) (defvar org-babel-temporary-directory From fc567582a8fb4302db6ae9200b1ba38ae2b9c6f5 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Tue, 31 Aug 2010 08:23:11 +0200 Subject: [PATCH 093/348] Fix typos patch by Stephen Eglen --- doc/org.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 2e61ddfc2..4ce32ce47 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11176,10 +11176,10 @@ Include the code block in the tangled output to file @samp{filename}. @kindex C-c C-v t @subsubheading Functions @table @code -@item org-babel-tangle @kbd{C-c C-v t} -Tangle the current file. +@item org-babel-tangle +Tangle the current file. Bound to @kbd{C-c C-v t}. @item org-babel-tangle-file -Choose a file to tangle. +Choose a file to tangle. Bound to @kbd{C-c C-v f}. @end table @subsubheading Hooks From 288d1bbb0dc6a016130242759c81a9c14084eb27 Mon Sep 17 00:00:00 2001 From: Christian Egli <christian.egli@alumni.ethz.ch> Date: Mon, 30 Aug 2010 19:58:34 +0000 Subject: [PATCH 094/348] Make the number of printed weeks configureable This is useful for the hipster PDA where you might want to print more weeks than just four. --- contrib/scripts/org2hpda | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/contrib/scripts/org2hpda b/contrib/scripts/org2hpda index 1957aa92b..6b308f38b 100755 --- a/contrib/scripts/org2hpda +++ b/contrib/scripts/org2hpda @@ -44,6 +44,11 @@ EMACS = emacs -batch -l ~/.emacs LATEX = latex DIARY = $($(EMACS) -eval "diary-file") +# Number of weeks to be printed. Should be a multiple of 4, because 4 +# of them are merged on one page. Can be set when invoking the script +# as follows: make NUMBER_OF_WEEKS=8 -f org2hpda +NUMBER_OF_WEEKS = 4 + hipsterFiles = weekCalendar.pdf yearCalendar.pdf monthCalendar3.pdf monthCalendar2.pdf monthCalendar1.pdf pocketModFiles = weekCalendar.pdf yearCalendar-rotated.pdf \ monthCalendar3-rotated.pdf monthCalendar2-rotated.pdf monthCalendar1-rotated.pdf @@ -73,7 +78,7 @@ all: pocketMod.pdf hipsterPDA.pdf done weekCalendar.tex: $(DIARY) - $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-week-iso 4) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" + $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-week-iso $(NUMBER_OF_WEEKS)) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" monthCalendar1.tex: $(DIARY) $(EMACS) -eval "(progn (calendar) (cal-tex-cursor-month-landscape 1) (with-current-buffer cal-tex-buffer (write-file \"$@\")))" From 2cf61365235efb00c78c670e31550d7d3334edba Mon Sep 17 00:00:00 2001 From: Manish Sharma <mailtomanish.sharma@gmail.com> Date: Sat, 21 Aug 2010 00:30:31 +0000 Subject: [PATCH 095/348] Allow "#" and "%" in tags Patch largely from Manish, missing points added by Carsten --- lisp/org-agenda.el | 10 +++---- lisp/org-archive.el | 2 +- lisp/org-ascii.el | 4 +-- lisp/org-capture.el | 2 +- lisp/org-clock.el | 2 +- lisp/org-colview-xemacs.el | 2 +- lisp/org-colview.el | 2 +- lisp/org-docbook.el | 4 +-- lisp/org-exp.el | 2 +- lisp/org-html.el | 6 ++-- lisp/org-latex.el | 2 +- lisp/org-remember.el | 2 +- lisp/org.el | 56 +++++++++++++++++++------------------- 13 files changed, 48 insertions(+), 48 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 44edca5d1..3f667254e 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4025,11 +4025,11 @@ MATCH is being ignored." "\\)\\>")) (tags (nth 2 org-stuck-projects)) (tags-re (if (member "*" tags) - (org-re "^\\*+ .*:[[:alnum:]_@]+:[ \t]*$") + (org-re "^\\*+ .*:[[:alnum:]_@#%]+:[ \t]*$") (if tags (concat "^\\*+ .*:\\(" (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@:]*[ \t]*$"))))) + (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) (gen-re (nth 3 org-stuck-projects)) (re-list (delq nil @@ -4988,7 +4988,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq h (/ m 60) m (- m (* h 60))) (setq s2 (format "%02d:%02d" h m)))) - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) @@ -5062,7 +5062,7 @@ Any match of REMOVE-RE will be removed from TXT." The modified list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") txt) + (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) (setq txt (substring txt 0 (match-beginning 0)))) (setq tags (delq nil @@ -6728,7 +6728,7 @@ If FORCE-TAGS is non nil, the car of it returns the new tags." (let ((inhibit-read-only t) l c) (save-excursion (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$") + (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") (if line (point-at-eol) nil) t) (add-text-properties (match-beginning 2) (match-end 2) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index df6c68f36..865f4d1d1 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -268,7 +268,7 @@ this heading." (progn (if (re-search-forward (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\($\\|\r\\)")) + (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) nil t) (goto-char (match-end 0)) ;; Heading not found, just insert it at the end diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index b4947d546..869e73804 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -400,7 +400,7 @@ publishing directory." (if (and (memq org-export-with-tags '(not-in-toc nil)) (string-match - (org-re "[ \t]+:[[:alnum:]_@:]+:[ \t]*$") + (org-re "[ \t]+:[[:alnum:]_@#%:]+:[ \t]*$") txt)) (setq txt (replace-match "" t t txt))) (if (string-match quote-re0 txt) @@ -648,7 +648,7 @@ publishing directory." (insert "\n")) (setq char (nth (- umax level) (reverse org-export-ascii-underline))) (unless org-export-with-tags - (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (if (string-match (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match "" t t title)))) (if org-export-with-section-numbers (setq title (concat (org-section-number level) " " title))) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index acbccc1fd..21480d835 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -1205,7 +1205,7 @@ The template may still contain \"%?\" for cursor positioning." 'org-tags-history))) (setq ins (mapconcat 'identity (org-split-string - ins (org-re "[^[:alnum:]_@]+")) + ins (org-re "[^[:alnum:]_@#%]+")) ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 5e4f4efba..a0757c753 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1863,7 +1863,7 @@ the currently selected interval size." (when (setq time (get-text-property p :org-clock-minutes)) (save-excursion (beginning-of-line 1) - (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@:]+:\\)?[ \t]*$")) + (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) (setq level (org-reduced-level (- (match-end 1) (match-beginning 1)))) (<= level maxlevel)) diff --git a/lisp/org-colview-xemacs.el b/lisp/org-colview-xemacs.el index 35e55f8de..e2bf811b9 100644 --- a/lisp/org-colview-xemacs.el +++ b/lisp/org-colview-xemacs.el @@ -685,7 +685,7 @@ Where possible, use the standard interface for changing this line." (txt (match-string 3)) (post "") txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt) + (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) (setq post (match-string 0 txt) txt (substring txt 0 (match-beginning 0)))) (setq txt2 (read-string "Edit: " txt)) diff --git a/lisp/org-colview.el b/lisp/org-colview.el index dc0ab0467..5303e7121 100644 --- a/lisp/org-colview.el +++ b/lisp/org-colview.el @@ -519,7 +519,7 @@ Where possible, use the standard interface for changing this line." (txt (match-string 3)) (post "") txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@]+:[ \t]*$") txt) + (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) (setq post (match-string 0 txt) txt (substring txt 0 (match-beginning 0)))) (setq txt2 (read-string "Edit: " txt)) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 7bb75658d..926db24bd 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1249,7 +1249,7 @@ When TITLE is nil, just close all open levels." ;; all levels, so the rest is done only if title is given. ;; ;; Format tags: put them into a superscript like format. - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags @@ -1273,7 +1273,7 @@ When TITLE is nil, just close all open levels." Applies all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) (while (setq m (string-match re string)) (setq s (substring string 0 m) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 67d9e28c4..fafdb07cb 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -2796,7 +2796,7 @@ If yes remove the column and the special lines." (defun org-export-cleanup-toc-line (s) "Remove tags and timestamps from lines going into the toc." (when (memq org-export-with-tags '(not-in-toc nil)) - (if (string-match (org-re " +:[[:alnum:]_@:]+: *$") s) + (if (string-match (org-re " +:[[:alnum:]_@#%:]+: *$") s) (setq s (replace-match "" t t s)))) (when org-export-remove-timestamps-from-toc (while (string-match org-maybe-keyword-time-regexp s) diff --git a/lisp/org-html.el b/lisp/org-html.el index 450a9de9d..099b2e300 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1095,7 +1095,7 @@ lang=\"%s\" xml:lang=\"%s\"> (org-search-todo-below line lines level)))) (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) + (org-re "[ \t]+:\\([[:alnum:]_@#%:]+\\):[ \t]*$") txt) (setq txt (replace-match "   <span class=\"tag\"> \\1</span>" t nil txt))) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) @@ -2164,7 +2164,7 @@ that uses these same face definitions." "Prepare STRING for HTML export. Apply all active conversions. If there are links in the string, don't modify these." (let* ((re (concat org-bracket-link-regexp "\\|" - (org-re "[ \t]+\\(:[[:alnum:]_@:]+:\\)[ \t]*$"))) + (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"))) m s l res) (if (string-match "^[ \t]*\\+-[-+]*\\+[ \t]*$" string) string @@ -2328,7 +2328,7 @@ When TITLE is nil, just close all open levels." (when title ;; If title is nil, this means this function is called to close ;; all levels, so the rest is done only if title is given - (when (string-match (org-re "\\(:[[:alnum:]_@:]+:\\)[ \t]*$") title) + (when (string-match (org-re "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") title) (setq title (replace-match (if org-export-with-tags (save-match-data diff --git a/lisp/org-latex.el b/lisp/org-latex.el index f2b9d55f3..524beaf25 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -1329,7 +1329,7 @@ links, keywords, lists, tables, fixed-width" (replace-match "") (replace-match (format "\\textbf{%s}" (match-string 0)) t t))) ;; convert tags - (when (re-search-forward "\\(:[a-zA-Z0-9_@]+\\)+:" nil t) + (when (re-search-forward "\\(:[a-zA-Z0-9_@#%]+\\)+:" nil t) (if (or (not org-export-with-tags) (plist-get remove-list :tags)) (replace-match "") diff --git a/lisp/org-remember.el b/lisp/org-remember.el index ee464fe37..a9cc11f43 100644 --- a/lisp/org-remember.el +++ b/lisp/org-remember.el @@ -574,7 +574,7 @@ to be run from that hook to function properly." 'org-tags-completion-function nil nil nil 'org-tags-history))) (setq ins (mapconcat 'identity - (org-split-string ins (org-re "[^[:alnum:]_@]+")) + (org-split-string ins (org-re "[^[:alnum:]_@#%]+")) ":")) (when (string-match "\\S-" ins) (or (equal (char-before) ?:) (insert ":")) diff --git a/lisp/org.el b/lisp/org.el index d85a1702d..5d16b6044 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -3088,7 +3088,7 @@ points to a file, `org-agenda-diary-entry' will be used instead." (defcustom org-format-latex-options '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" + :html-foreground "Black" :html-background "Transparent" :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) "Options for creating images from LaTeX fragments. This is a property list with the following properties: @@ -4377,7 +4377,7 @@ means to push this value onto the list in the variable.") ((equal e "{") (push '(:startgroup) tgs)) ((equal e "}") (push '(:endgroup) tgs)) ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@]+\\)(\\(.\\))$") e) + ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) (push (cons (match-string 1 e) (string-to-char (match-string 2 e))) tgs)) @@ -4421,7 +4421,7 @@ means to push this value onto the list in the variable.") (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(.*?\\)" - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") org-complex-heading-regexp-format (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") @@ -4430,7 +4430,7 @@ means to push this value onto the list in the variable.") "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie "[ \t]*\\(%s\\)" "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie - "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") org-nl-done-regexp (concat "\n\\*+[ \t]+" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") @@ -4439,7 +4439,7 @@ means to push this value onto the list in the variable.") (concat "^\\(\\*+\\)[ \t]+\\(?:\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@]+:[ \t]*\\)?$\\)")) + "\\)\\>\\)? *\\(.*?\\([ \t]:[[:alnum:]:_@#%]+:[ \t]*\\)?$\\)")) org-looking-at-done-regexp (concat "^" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") "\\)" @@ -5353,7 +5353,7 @@ between words." "\\)\\>"))) (defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \r\n]") limit t) + (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t) (progn (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -6711,7 +6711,7 @@ This is important for non-interactive uses of the command." (when hide-previous (show-children) (org-show-entry)) - (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$") + (looking-at ".*?\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") (setq tags (and (match-end 2) (match-string 2))) (and (match-end 1) (delete-region (match-beginning 1) (match-end 1))) @@ -6747,7 +6747,7 @@ This is important for non-interactive uses of the command." (org-back-to-heading t) (if (looking-at (if no-tags - (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@]+:[ \t]*\\)?$") + (org-re "\\*+[ \t]+\\([^\n\r]*?\\)\\([ \t]+:[[:alnum:]:_@#%]+:[ \t]*\\)?$") "\\*+[ \t]+\\([^\r\n]*\\)")) (match-string 1) ""))) @@ -8441,7 +8441,7 @@ according to FMT (default from `org-email-link-description-format')." ;; We are using a headline, clean up garbage in there. (if (string-match org-todo-regexp s) (setq s (replace-match "" t t s))) - (if (string-match (org-re ":[[:alnum:]_@:]+:[ \t]*$") s) + (if (string-match (org-re ":[[:alnum:]_@#%:]+:[ \t]*$") s) (setq s (replace-match "" t t s))) (setq s (org-trim s)) (if (string-match (concat "^\\(" org-quote-string "\\|" @@ -9057,7 +9057,7 @@ application the system uses for this file type." (setq type (match-string 1) path (match-string 2)) (throw 'match t))) (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@:]+\\):[ \t]*$")) + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) (setq type "tags" path (match-string 1)) (while (string-match ":" path) @@ -9411,7 +9411,7 @@ in all files. If AVOID-POS is given, ignore matches near that position." (when (equal (string-to-char s) ?*) ;; Anchor on headlines, post may include tags. (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" - post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@:+]:[ \t]*\\)?$") + post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$") s (substring s 1))) (remove-text-properties 0 (length s) @@ -10591,7 +10591,7 @@ At all other locations, this simply calls the value of (let* ((a nil) (end (point)) (beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]_@")) + (skip-chars-backward (org-re "[:alnum:]_@#%")) (point))) (beg (save-excursion (skip-chars-backward "a-zA-Z0-9_:$") @@ -12218,7 +12218,7 @@ only lines with a TODO keyword are included in the output." (let* ((re (concat "^" outline-regexp " *\\(\\<\\(" (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") (org-re - "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*$"))) + "\\>\\)\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -12418,7 +12418,7 @@ also TODO lines." ;; Parse the string and create a lisp form (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@]+\\)")) + (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) minus tag mm tagsmatch todomatch tagsmatcher todomatcher kwd matcher orterms term orlist re-p str-p level-p level-op time-p @@ -12448,7 +12448,7 @@ also TODO lines." (equal (match-string 1 term) "-")) tag (save-match-data (replace-regexp-in-string "\\\\-" "-" - (match-string 2 term))) + (match-string 2 term))) re-p (equal (string-to-char tag) ?{) level-p (match-end 4) prop-p (match-end 5) @@ -12627,7 +12627,7 @@ ignore inherited ones." (while (not (equal lastpos (point))) (setq lastpos (point)) (when (looking-at - (org-re "[^\r\n]+?:\\([[:alnum:]_@:]+\\):[ \t]*$")) + (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) (setq ltags (org-split-string (org-match-string-no-properties 1) ":")) (when parent @@ -12654,7 +12654,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." (let (res current) (save-excursion (org-back-to-heading t) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t]*$") + (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") (point-at-eol) t) (progn (setq current (match-string 1)) @@ -12684,7 +12684,7 @@ If ONOFF is `on' or `off', don't toggle but set to this state." ;; Assumes that this is a headline (let ((pos (point)) (col (current-column)) ncol tags-l p) (beginning-of-line 1) - (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (< pos (match-beginning 2))) (progn (setq tags-l (- (match-end 2) (match-beginning 2))) @@ -12804,7 +12804,7 @@ With prefix ARG, realign all tags in headings in the current buffer." (if org-tags-sort-function (setq tags (mapconcat 'identity - (sort (org-split-string tags (org-re "[^[:alnum:]_@]+")) + (sort (org-split-string tags (org-re "[^[:alnum:]_@#%]+")) org-tags-sort-function) ":"))) (if (string-match "\\`[\t ]*\\'" tags) @@ -12961,7 +12961,7 @@ Returns the new tags string, or nil to not change the current settings." (save-excursion (beginning-of-line 1) (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (setq ov-start (match-beginning 1) ov-end (match-end 1) ov-prefix "") @@ -13111,7 +13111,7 @@ Returns the new tags string, or nil to not change the current settings." (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) (while (re-search-forward - (org-re "\\[.\\] \\([[:alnum:]_@]+\\)") nil t) + (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) (setq tg (match-string 1)) (add-text-properties (match-beginning 1) (match-end 1) @@ -13132,7 +13132,7 @@ Returns the new tags string, or nil to not change the current settings." (error "Not on a heading")) (save-excursion (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@:]+:\\)[ \t]*$")) + (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) (org-match-string-no-properties 1) ""))) @@ -13146,7 +13146,7 @@ Returns the new tags string, or nil to not change the current settings." (save-excursion (goto-char (point-min)) (while (re-search-forward - (org-re "[ \t]:\\([[:alnum:]_@:]+\\):[ \t\r\n]") nil t) + (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t) (when (equal (char-after (point-at-bol 0)) ?*) (mapc (lambda (x) (add-to-list 'tags x)) (org-split-string (org-match-string-no-properties 1) ":"))))) @@ -15984,14 +15984,14 @@ Some of the options can be changed using the variable (unless checkdir ; make sure the directory exists (setq checkdir t) (or (file-directory-p todir) (make-directory todir t))) - + (unless executables-checked (org-check-external-command "latex" "needed to convert LaTeX fragments to images") (org-check-external-command "dvipng" "needed to convert LaTeX fragments to images") (setq executables-checked t)) - + (unless (file-exists-p movefile) (org-create-formula-image txt movefile opt forbuffer)) @@ -17306,7 +17306,7 @@ See the individual commands for more information." (call-interactively 'org-open-at-point)) ((and (org-at-heading-p) (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$"))) + (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) (org-show-entry) (end-of-line 1) (newline)) @@ -18867,7 +18867,7 @@ beyond the end of the headline." (t 'end-of-line))) (let ((pos (point))) (beginning-of-line 1) - (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@:]+:\\)?[ \t]*\\)?$")) + (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) (if (eq special t) (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) @@ -18921,7 +18921,7 @@ depending on context." (not (y-or-n-p "Kill hidden subtree along with headline? "))) (error "C-k aborted - would kill hidden subtree"))) (call-interactively 'kill-line)) - ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@:]+:\\)\\)[ \t]*$")) + ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) (kill-region (point) (match-beginning 1)) (org-set-tags nil t)) (t (kill-region (point) (point-at-eol))))) From dabfd646aec0c4a5ebcacb52e62e5b3130544e0b Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Tue, 31 Aug 2010 08:31:14 +0200 Subject: [PATCH 096/348] LaTeX export: remove the t1enc package * lisp/org.el (org-export-latex-default-packages-alist): Remove the t1enc package - this is already covered by fontenc. --- lisp/org.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 5d16b6044..81dd59e53 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -3176,7 +3176,6 @@ will be appended." ("" "float" nil) ("" "wrapfig" nil) ("" "soul" t) - ("" "t1enc" t) ("" "textcomp" t) ("" "marvosym" t) ("" "wasysym" t) @@ -3191,7 +3190,7 @@ with another package you are using. The packages in this list are needed by one part or another of Org-mode to function properly. -- inputenc, fontenc, t1enc: for basic font and character selection +- inputenc, fontenc: for basic font and character selection - textcomp, marvosymb, wasysym, latexsym, amssym: for various symbols used for interpreting the entities in `org-entities'. You can skip some of these packages if you don't use any of the symbols in it. From ab959590575063137f7ddda5ad7a5242aec57e78 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 31 Aug 2010 01:12:43 -0600 Subject: [PATCH 097/348] ob-scheme: now supports session-based evaluation * lisp/ob-scheme.el (org-babel-scheme-eoe): for marking the end of session-based evaluation (org-babel-execute:scheme): now supports session-based evaluation (org-babel-prep-session:scheme): now works and defines variables (org-babel-scheme-initiate-session): now works using run-scheme from cmuscheme --- lisp/ob-scheme.el | 51 ++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 46 insertions(+), 5 deletions(-) diff --git a/lisp/ob-scheme.el b/lisp/ob-scheme.el index 452a940ec..38df35b53 100644 --- a/lisp/ob-scheme.el +++ b/lisp/ob-scheme.el @@ -35,14 +35,25 @@ ;; - a working scheme implementation ;; (e.g. guile http://www.gnu.org/software/guile/guile.html) +;; +;; - for session based evaluation cmuscheme.el is required which is +;; included in Emacs ;;; Code: (require 'ob) +(require 'ob-ref) +(require 'ob-comint) (require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-scheme "ext:cmuscheme" (cmd)) (defvar org-babel-default-header-args:scheme '() "Default header arguments for scheme code blocks.") +(defvar org-babel-scheme-eoe "org-babel-scheme-eoe" + "String to indicate that evaluation has completed.") + (defcustom org-babel-scheme-cmd "guile" "Name of command used to evaluate scheme blocks." :group 'org-babel @@ -59,17 +70,25 @@ ")\n" body ")") body))) +(defvar scheme-program-name) (defun org-babel-execute:scheme (body params) "Execute a block of Scheme code with org-babel. This function is called by `org-babel-execute-src-block'" (let* ((processed-params (org-babel-process-params params)) - (session (not (string= (nth 0 processed-params) "none"))) (result-type (nth 3 processed-params)) + (org-babel-scheme-cmd (or (cdr (assoc :scheme params)) org-babel-scheme-cmd)) (full-body (org-babel-expand-body:scheme body params processed-params))) (read - (if session + (if (not (string= (nth 0 processed-params) "none")) ;; session evaluation - (error "Scheme sessions are not yet supported.") + (let ((session (org-babel-prep-session:scheme + (nth 0 processed-params) params))) + (org-babel-comint-with-output + (session (format "%S" org-babel-scheme-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body (format "%S" org-babel-scheme-eoe))))) ;; external evaluation (let ((script-file (org-babel-temp-file "lisp-script-"))) (with-temp-file script-file @@ -83,12 +102,34 @@ This function is called by `org-babel-execute-src-block'" (defun org-babel-prep-session:scheme (session params) "Prepare SESSION according to the header arguments specified in PARAMS." - (error "not yet implemented")) + (let* ((session (org-babel-scheme-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines + (mapcar + (lambda (var) (format "%S" (print `(define ,(car var) ',(cdr var))))) + vars))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) (defun org-babel-scheme-initiate-session (&optional session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." - (error "Scheme sessions are not yet supported.")) + (require 'cmuscheme) + (unless (string= session "none") + (let ((session-buffer (save-window-excursion + (run-scheme org-babel-scheme-cmd) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-scheme-initiate-session session))))) (provide 'ob-scheme) From fa18c1c23278d9768e799dee7eff100cc7cef18c Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Tue, 31 Aug 2010 09:22:26 +0200 Subject: [PATCH 098/348] Fix read-date problem that could result in August 34th Paul Sexton writes: > Today (31 August), > if I evaluate "(org-read-date t)", then at the prompt type > "+3" > The string returned is: > "2010-08-34" --- lisp/org.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/org.el b/lisp/org.el index 81dd59e53..7d47ad107 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14343,6 +14343,10 @@ user." (setq org-read-date-overlay nil))))) (setq final (org-read-date-analyze ans def defdecode)) + + ;; One round trip to get rid of 34th of August and stuff like that.... + (setq final (decode-time (apply 'encode-time final))) + (setq org-read-date-final-answer ans) (if to-time From 3d6c1090cbaf2a58d65d827be8d2caff4c02b802 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Tue, 31 Aug 2010 22:58:08 +0200 Subject: [PATCH 099/348] Protect escape char in `org-complex-heading-regexp-format' * org.el (org-set-regexps-and-options): Protect escape char in `org-complex-heading-regexp-format'. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 7d47ad107..7be144370 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -4429,7 +4429,7 @@ means to push this value onto the list in the variable.") "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie "[ \t]*\\(%s\\)" "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie - "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?[ \t]*$") + "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?[ \t]*$") org-nl-done-regexp (concat "\n\\*+[ \t]+" "\\(?:" (mapconcat 'regexp-quote org-done-keywords "\\|") From c7ed188859a93a45ea1e7b8ae27f6d41db60d02d Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 1 Sep 2010 08:48:21 -0600 Subject: [PATCH 100/348] ob-js: now supports session based evaluation through mozrepl * lisp/ob-js.el (org-babel-js-eoe): indicate end of input (org-babel-execute:js): support for session evaluation (org-babel-prep-session:js): fleshed out definition (org-babel-js-initiate-session): can initiate a session using mozrepl --- lisp/ob-js.el | 64 ++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 58 insertions(+), 6 deletions(-) diff --git a/lisp/ob-js.el b/lisp/ob-js.el index 9c4855234..a59a134d1 100644 --- a/lisp/ob-js.el +++ b/lisp/ob-js.el @@ -33,15 +33,28 @@ ;;; Requirements: -;; node.js | http://nodejs.org/ +;; - a non-browser javascript engine such as node.js http://nodejs.org/ +;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; +;; - for session based evaluation mozrepl and moz.el are required see +;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; configuration instructions ;;; Code: (require 'ob) +(require 'ob-ref) +(require 'ob-comint) (require 'ob-eval) +(eval-when-compile (require 'cl)) + +(declare-function run-mozilla "ext:moz" (arg)) (defvar org-babel-default-header-args:js '() "Default header arguments for js code blocks.") +(defvar org-babel-js-eoe "org-babel-js-eoe" + "String to indicate that evaluation has completed.") + (defcustom org-babel-js-cmd "node" "Name of command used to evaluate js blocks." :group 'org-babel @@ -64,12 +77,22 @@ "Execute a block of Javascript code with org-babel. This function is called by `org-babel-execute-src-block'" (let* ((processed-params (org-babel-process-params params)) - (session (not (string= (nth 0 processed-params) "none"))) + (org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) (result-type (nth 3 processed-params)) (full-body (org-babel-expand-body:js body params processed-params))) (org-babel-js-read - (if session - (error "javascript sessions are not yet supported.") + (if (not (string= (nth 0 processed-params) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:js + (nth 0 processed-params) params))) + (nth 1 + (org-babel-comint-with-output + (session (format "%S" org-babel-js-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body (format "%S" org-babel-js-eoe)))))) + ;; external evaluation (let ((script-file (org-babel-temp-file "js-script-"))) (with-temp-file script-file (insert @@ -104,12 +127,41 @@ specifying a variable of the same value." (defun org-babel-prep-session:js (session params) "Prepare SESSION according to the header arguments specified in PARAMS." - (error "not yet implemented")) + (let* ((session (org-babel-js-initiate-session session)) + (vars (org-babel-ref-variables params)) + (var-lines + (mapcar + (lambda (pair) (format "var %s=%s;" + (car pair) (org-babel-js-var-to-js (cdr pair)))) + vars))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) (defun org-babel-js-initiate-session (&optional session) "If there is not a current inferior-process-buffer in SESSION then create. Return the initialized session." - (error "Javascript sessions are not yet supported.")) + (unless (string= session "none") + (cond + ((string= "mozrepl" org-babel-js-cmd) + (require 'moz) + (let ((session-buffer (save-window-excursion + (run-mozilla nil) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-js-initiate-session session)))) + ((string= "node" org-babel-js-cmd ) + (error "session evaluation with node.js is not supported")) + (t + (error "sessions are only supported with mozrepl add \":cmd mozrepl\""))))) (provide 'ob-js) From 5fda851968e1df5ec515ebc1430f899cb50066e7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 10 Jul 2010 17:02:58 +0200 Subject: [PATCH 101/348] Initial commit. --- lisp/org-latex.el | 2 +- lisp/org-list.el | 1820 ++++++++++++++++++++++++--------------------- lisp/org.el | 287 ++++--- 3 files changed, 1085 insertions(+), 1024 deletions(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 524beaf25..c01ab267d 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2238,7 +2238,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "Convert plain text lists in current buffer into LaTeX lists." (let (res) (goto-char (point-min)) - (while (org-re-search-forward-unprotected org-list-beginning-re nil t) + (while (org-re-search-forward-unprotected (org-item-re) nil t) (beginning-of-line) (setq res (org-list-to-latex (org-list-parse-list t) org-export-latex-list-parameters)) diff --git a/lisp/org-list.el b/lisp/org-list.el index acd6d93f0..64d7cdfff 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -140,10 +140,10 @@ the safe choice." (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. When nil, no bullet will have two spaces after them. -When a string, it will be used as a regular expression. When the bullet -type of a list is changed, the new bullet type will be matched against this -regexp. If it matches, there will be two spaces instead of one after -the bullet in each item of he list." +When a string, it will be used as a regular expression. When the +bullet type of a list is changed, the new bullet type will be +matched against this regexp. If it matches, there will be two +spaces instead of one after the bullet in each item of he list." :group 'org-plain-lists :type '(choice (const :tag "never" nil) @@ -151,9 +151,8 @@ the bullet in each item of he list." (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. -This is currently effective only during export. It should also have -an effect for indentation and plain list folding, but it does not. -When nil, empty lines are part of the preceding item." +Otherwise it will take two blank lines to end them." + :group 'org-plain-lists :type 'boolean) @@ -188,9 +187,6 @@ When the indentation would be larger than this, it will become :group 'org-plain-lists :type 'integer) -(defvar org-list-beginning-re - "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$") - (defcustom org-list-radio-list-templates '((latex-mode "% BEGIN RECEIVE ORGLST %n % END RECEIVE ORGLST %n @@ -218,9 +214,14 @@ list, obtained by prompting the user." (list (symbol :tag "Major mode") (string :tag "Format")))) -;;;; Plain list items, including checkboxes +;;; Internal functions -;;; Plain list items +(defun org-list-end-re () + "Return the regex corresponding to the end of a list. +It depends on `org-empty-line-terminates-plain-lists'." + (if org-empty-line-terminates-plain-lists + "^\\([ \t]*\n\\)+" + "^[ \t]*\n\\([ \t]*\n\\)+")) (defun org-item-re (&optional general) "Return the correct regular expression for plain lists. @@ -235,9 +236,104 @@ of `org-plain-list-ordered-item-terminator'." "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) +(defun org-list-terminator-between (min max &optional firstp) + "Find the position of a list ender between MIN and MAX, or nil. +This function looks for `org-list-end-re' not matching a block. + +If FIRSTP in non-nil, return the point at the beginning of the +nearest valid terminator from min. Otherwise, return the point at +the end of the nearest terminator from max." + (save-excursion + (let* ((start (if firstp min max)) + (end (if firstp max min)) + (search-fun (if firstp + #'org-search-forward-unenclosed + #'org-search-backward-unenclosed)) + (list-end-p (progn + (goto-char start) + (funcall search-fun (org-list-end-re) end)))) + ;; Is there a valid list terminator somewhere ? + (and list-end-p + ;; we want to be on the first line of the list ender + (match-beginning 0))))) + +(defun org-search-backward-unenclosed (regexp &optional bound noerror) + "Like `re-search-backward' but don't stop inside blocks or throw errors." + (ignore-errors + (prog1 + (re-search-backward regexp bound noerror) + (when (save-match-data + (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" + '(concat "^[ \t]*#\\+end_" (match-string 1))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]\\)}" + '(concat "^[ \t]*\\\\end{" (match-string 1) "}")))) + (org-search-backward-unenclosed regexp bound noerror))))) + +(defun org-search-forward-unenclosed (regexp &optional bound noerror) + "Like `re-search-forward' but don't stop inside blocks or throw errors." + (ignore-errors + (prog1 + (re-search-forward regexp bound noerror) + (when (save-match-data + (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" + '(concat "^[ \t]*#\\+end_" (match-string 1))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]\\)}" + '(concat "^[ \t]*\\\\end{" (match-string 1) "}")))) + (org-search-forward-unenclosed regexp bound noerror))))) + +(defun org-get-item-same-level-internal (search-fun pos limit pre-move) + "Return point at the beginning of next item at the same level. +Search items using function SEARCH-FUN, from POS to LIMIT. It +uses PRE-MOVE before searches. Return nil if no item was found. + +Internal use only. Prefer `org-get-next-item' and +`org-get-previous-item' for cleaner code." + (save-excursion + (when pos (goto-char pos)) + (let* ((begin (point)) + (ind (progn + (org-beginning-of-item) + (org-get-indentation))) + (start (point-at-bol))) + ;; we don't want to match the current line. + (funcall pre-move) + ;; we skip any sublist on the way + (while (and (funcall search-fun (org-item-re) limit) + (> (org-get-indentation) ind)) + (funcall pre-move)) + (when (and (/= (point-at-bol) start) ; Have we moved ? + (= (org-get-indentation) ind)) + (point-at-bol))))) + +;;; Predicates + +(defun org-in-item-p () + "Is the cursor inside a plain list ?" + (save-restriction + (save-excursion + (widen) + ;; we move to eol so that the current line can be matched by + ;; `org-item-re'. + (let* ((limit (or (save-excursion (outline-previous-heading)) (point-min))) + (actual-pos (goto-char (point-at-eol))) + (last-item-start (save-excursion + (org-search-backward-unenclosed (org-item-re) limit))) + (list-ender (org-list-terminator-between last-item-start actual-pos))) + ;; We are in a list when we are on an item line or we can find + ;; an item before and there is no valid list ender between us + ;; and the item found. + (and last-item-start + (not list-ender)))))) + +(defun org-first-list-item-p () + "Is this heading the first item in a plain list?" + (unless (org-at-item-p) + (error "Not at a plain list item")) + (save-excursion + (= (save-excursion (org-beginning-of-item)) (org-beginning-of-item-list)))) + (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (save-excursion (goto-char (point-at-bol)) (looking-at (org-item-re)))) @@ -248,80 +344,6 @@ of `org-plain-list-ordered-item-terminator'." (not (member (char-after) '(?\ ?\t))) (< (point) (match-end 0)))) -(defun org-in-item-p () - "Is the cursor inside a plain list item. -Does not have to be the first line." - (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - t) - (error nil)))) - -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -Return t when things worked, nil when we are not in an item." - (when (save-excursion - (condition-case nil - (progn - (org-beginning-of-item) - (org-at-item-p) - (if (org-invisible-p) (error "Invisible item")) - t) - (error nil))) - (let* ((bul (match-string 0)) - (descp (save-excursion (goto-char (match-beginning 0)) - (beginning-of-line 1) - (save-match-data - (and (looking-at "[ \t]*\\(.*?\\) ::") - (match-string 1))))) - (empty-line-p (save-excursion - (goto-char (match-beginning 0)) - (and (not (bobp)) - (or (beginning-of-line 0) t) - (save-match-data - (looking-at "[ \t]*$"))))) - (timerp (and descp - (save-match-data - (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$" - descp)))) - (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*") - (match-end 0))) - (blank-a (if org-empty-line-terminates-plain-lists - nil - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos) - (if descp (setq checkbox nil)) - (if timerp - (progn (org-timer-item) t) - (cond - ((and (org-at-item-p) (<= (point) eow)) - ;; before the bullet - (beginning-of-line 1) - (open-line (if blank 2 1))) - ((<= (point) eow) - (beginning-of-line 1)) - (t - (unless (org-get-alist-option org-M-RET-may-split-line 'item) - (end-of-line 1) - (delete-horizontal-space)) - (newline (if blank 2 1)))) - (insert bul - (if checkbox "[ ]" "") - (if descp (concat (if checkbox " " "") - (read-string "Term: ") " :: ") "")) - (just-one-space) - (setq pos (point)) - (end-of-line 1) - (unless (= (point) pos) (just-one-space) (backward-delete-char 1))) - (org-maybe-renumber-ordered-list) - (and checkbox (org-update-checkbox-count-maybe)) - t))) - -;;; Checkboxes - (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" (and (org-at-item-p) @@ -330,6 +352,609 @@ Return t when things worked, nil when we are not in an item." (skip-chars-forward " \t") (looking-at "\\[[- X]\\]")))) +(defun org-checkbox-blocked-p () + "Is the current checkbox blocked from for being checked now? +A checkbox is blocked if all of the following conditions are fulfilled: + +1. The checkbox is not checked already. +2. The current entry has the ORDERED property set. +3. There is an unchecked checkbox in this entry before the current line." + (catch 'exit + (save-match-data + (save-excursion + (unless (org-at-item-checkbox-p) (throw 'exit nil)) + (when (equal (match-string 0) "[X]") + ;; the box is already checked! + (throw 'exit nil)) + (let ((end (point-at-bol))) + (condition-case nil (org-back-to-heading t) + (error (throw 'exit nil))) + (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) + (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) + (org-current-line) + nil)))))) + +;;; Navigate + +(defun org-list-top-point () + "Return point at the top level item in a list, or nil if not in a list." + (save-excursion + (and (org-in-item-p) + (let ((pos (point-at-eol)) + (bound (or (outline-previous-heading) (point-min)))) + ;; Is there some list above this one ? If so, go to its ending. + ;; Otherwise, go back to the heading above or bob. + (goto-char (or (org-list-terminator-between bound pos) bound)) + ;; From there, search down our list. + (org-search-forward-unenclosed (org-item-re) pos) + (point-at-bol))))) + +(defun org-list-bottom-point () + "Return point just before list ending or nil if not in a list." + (save-excursion + (and (org-in-item-p) + (let ((pos (org-beginning-of-item)) + (bound (or (and (outline-next-heading) + (skip-chars-backward "[ \t\r\n]") + (1+ (point-at-eol))) + (point-max)))) + ;; The list ending is either first point matching + ;; org-list-end-re, point at first white-line before next + ;; heading, or eob. + (or (org-list-terminator-between pos bound t) bound))))) + +(defun org-beginning-of-item () + "Go to the beginning of the current hand-formatted item. +If the cursor is not in an item, throw an error. Return point." + (interactive) + (if (org-in-item-p) + (if (org-at-item-p) + (progn (beginning-of-line 1) + (point)) + (org-search-backward-unenclosed (org-item-re)) + (goto-char (point-at-bol))) + (error "Not in an item"))) + +(defun org-end-of-item () + "Go to the end of the current hand-formatted item. +If the cursor is not in an item, throw an error." + (interactive) + (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (cond ((not (org-in-item-p)) + (error "Not in an item")) + (next-p + (goto-char next-p)) + (t + (org-end-of-item-list))))) + +(defun org-end-of-item-text-before-children () + "Move to the end of the item text, stops before the first child if any. +Assumes that the cursor is in the first line of an item." + (let ((limit (org-list-bottom-point))) + (end-of-line) + (goto-char + (if (org-search-forward-unenclosed (org-item-re) limit) + (point-at-bol) + limit)))) + +(defun org-end-of-item-before-blank () + "Return point at end of item, before any blank line. +Point returned is at eol." + (save-excursion + (org-end-of-item) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + +(defun org-get-next-item (pos limit) + "Get the point of the next item at the same level as POS. + Stop searching at LIMIT. Return nil if no item is found. This + function does not move point." + (org-get-item-same-level-internal + #'org-search-forward-unenclosed + pos + limit + #'end-of-line)) + +(defun org-get-previous-item (pos limit) + "Get the point of the previous item at the same level as POS. + Stop searching at LIMIT. Return nil if no item is found. This + function does not move point." + (org-get-item-same-level-internal + #'org-search-backward-unenclosed + pos + limit + #'beginning-of-line)) + +(defun org-next-item () + "Move to the beginning of the next item. +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the last item in the list." + (interactive) + (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (if next-p + (goto-char next-p) + (error "On last item")))) + +(defun org-previous-item () + "Move to the beginning of the previous item. +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the first item in the list." + (interactive) + (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) + (if prev-p + (goto-char prev-p) + (error "On first item")))) + +(defun org-beginning-of-item-list () + "Go to the beginning item of the current list or sublist. +Return point." + (interactive) + (let ((limit (org-list-top-point)) + (move-up (lambda (pos bound) + ;; prev-p: any item of same level before ? + (let ((prev-p (org-get-previous-item pos bound))) + ;; recurse until no more item of the same level + ;; can be found. + (if prev-p + (funcall move-up prev-p bound) + pos))))) + ;; Go to the last item found and at bol in case we didn't move + (goto-char (funcall move-up (point) limit)) + (goto-char (point-at-bol)))) + +(defun org-end-of-item-list () + "Go to the end of the current list or sublist. + Return point." + (interactive) + (org-beginning-of-item) + (let ((limit (org-list-bottom-point)) + (ind (org-get-indentation)) + (get-last-item (lambda (pos bound) + ;; next-p: any item of same level after ? + (let ((next-p (org-get-next-item pos bound))) + ;; recurse until no more item of the same level + ;; can be found. + (if next-p + (funcall get-last-item next-p bound) + pos))))) + ;; Move to the last item of every list or sublist encountered, and + ;; down to bol of a higher-level item, or limit. + (while (and (/= (point) limit) + (>= (org-get-indentation) ind)) + (goto-char (funcall get-last-item (point) limit)) + (end-of-line) + (when (org-search-forward-unenclosed (org-item-re) limit 'move) + (beginning-of-line))) + (point))) + +;;; Manipulate + +(defun org-list-exchange-items (beg-A beg-B) + "Swap item starting at BEG-A with item starting at BEG-B. + Blank lines at the end of items are left in place. Assumes + BEG-A is lesser than BEG-B." + (save-excursion + (let* ((end-of-item-no-blank (lambda (pos) + (goto-char pos) + (goto-char (org-end-of-item-before-blank)))) + (end-A-no-blank (funcall end-of-item-no-blank beg-A)) + (end-B-no-blank (funcall end-of-item-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))) + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A))))) + +(defun org-move-item-down () + "Move the plain list item at point down, i.e. swap with following item. +Subitems (items with larger indentation) are considered part of the item, +so this really moves item trees." + (interactive) + (let ((pos (point)) + (col (current-column)) + (actual-item (org-beginning-of-item)) + (next-item (org-get-next-item (point) (save-excursion (org-end-of-item-list))))) + (if (not next-item) + (progn + (goto-char pos) + (error "Cannot move this item further down")) + (org-list-exchange-items actual-item next-item) + (org-maybe-renumber-ordered-list) + (org-next-item) + (move-to-column col)))) + +(defun org-move-item-up () + "Move the plain list item at point up, i.e. swap with previous item. +Subitems (items with larger indentation) are considered part of the item, +so this really moves item trees." + (interactive) + (let ((pos (point)) + (col (current-column)) + (actual-item (org-beginning-of-item)) + (prev-item (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list))))) + (if (not prev-item) + (progn + (goto-char pos) + (error "Cannot move this item further up")) + (org-list-exchange-items prev-item actual-item) + (org-maybe-renumber-ordered-list) + (move-to-column col)))) + +(defun org-insert-item (&optional checkbox) + "Insert a new item at the current level. + +If cursor is before first character after bullet of the item, the +new item will be created before the current one. Return t when +things worked, nil when we are not in an item, or we are inside a +block, or item is invisible." + (unless (or (not (org-in-item-p)) + (org-invisible-p) + (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" + '(concat "^[ \t]*#\\+end_" (match-string 1))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]\\)}" + '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))) + (let* ((pos (point)) + (before-p (and (org-at-item-p) + (<= (point) (match-end 0)))) + (item-start (org-beginning-of-item)) + (bullet-init (and (looking-at (org-item-re)) + (match-string 0))) + (description-p (and (looking-at "[ \t]*\\(.*?\\) ::") + (match-string 1))) + (timer-p (and description-p + (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$" description-p))) + ;; Guess number of blank lines used to separate items. + (blank-lines-nb (let* ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + (limit (save-excursion (org-end-of-item-list))) + (next-item-p (org-get-next-item (point) limit))) + (cond + ;; cases where there should be no blank line. + ((or (not insert-blank-p) + org-empty-line-terminates-plain-lists) 0) + ;; If there's a next item, count blank + ;; lines between current and next item. + (next-item-p (and (goto-char next-item-p) + (org-back-over-empty-lines))) + ;; if we're not on the first item, there + ;; is one above. Count blank lines between. + ((not (org-first-list-item-p)) (org-back-over-empty-lines)) + ;; Only one item list: can't guess. + ;; Follow `org-blank-before-new-entry' + ((eq insert-blank-p 'auto) 0) + (t 1)))) + (insert-fun (lambda (&optional string-after-bullet) + ;; insert bullet above item in order to avoid + ;; bothering with possible blank lines ending + ;; last item + (org-beginning-of-item) + (insert (concat bullet-init + (when checkbox "[ ] ") + (when (and description-p (not timer-p)) + (concat (read-string "Term: ") " :: ")))) + (save-excursion + (insert (concat string-after-bullet + (make-string (1+ blank-lines-nb) ?\n)))) + (unless before-p (org-move-item-down))))) + (goto-char pos) + (cond + ;; if we're adding a timer, delegate to `org-timer-item'. + (timer-p (org-timer-item) t) + (before-p + (funcall insert-fun) + ;; Renumber in this case, as we're not moving down. + (org-maybe-renumber-ordered-list) t) + ;; if we can't split item, just insert bullet at the end of + ;; item. + ((not (org-get-alist-option org-M-RET-may-split-line 'item)) + (funcall insert-fun) t) + ;; else, insert a new bullet along with everything from point + ;; down to last non-blank line of item + (t + (delete-horizontal-space) + ;; get pos again in case previous command changed line. + (let* ((pos (point)) + (end-before-blank (org-end-of-item-before-blank)) + (after-bullet (when (< pos end-before-blank) + (prog1 + (buffer-substring pos end-before-blank) + (delete-region pos end-before-blank))))) + (funcall insert-fun after-bullet) t)))))) + +;;; Indentation + +(defun org-get-string-indentation (s) + "What indentation has S due to SPACE and TAB at the beginning of the string?" + (let ((n -1) (i 0) (w tab-width) c) + (catch 'exit + (while (< (setq n (1+ n)) (length s)) + (setq c (aref s n)) + (cond ((= c ?\ ) (setq i (1+ i))) + ((= c ?\t) (setq i (* (/ (+ w i) w) w))) + (t (throw 'exit t))))) + i)) + +(defvar org-suppress-item-indentation) ; dynamically scoped parameter + +(defun org-shift-item-indentation (delta) + "Shift the indentation in current item by DELTA." + (unless (org-bound-and-true-p org-suppress-item-indentation) + (save-excursion + (let ((beg (point-at-bol)) + (end (progn (org-end-of-item) (point))) + i) + (goto-char end) + (beginning-of-line 0) + (while (> (point) beg) + (when (looking-at "[ \t]*\\S-") + ;; this is not an empty line + (setq i (org-get-indentation)) + (if (and (> i 0) (> (setq i (+ i delta)) 0)) + (indent-line-to i))) + (beginning-of-line 0)))))) + + +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) + +(defun org-outdent-item (arg) + "Outdent a local list item, but not its children." + (interactive "p") + (org-indent-item-tree (- arg) 'no-subtree)) + +(defun org-indent-item (arg) + "Indent a local list item, but not its children." + (interactive "p") + (org-indent-item-tree arg 'no-subtree)) + +(defun org-outdent-item-tree (arg &optional no-subtree) + "Outdent a local list item including its children. +If NO-SUBTREE is set, only outdent the item itself, not its children." + (interactive "p") + (org-indent-item-tree (- arg) no-subtree)) + +(defun org-indent-item-tree (arg &optional no-subtree) + "Indent a local list item including its children. +If NO-SUBTREE is set, only indent the item itself, not its children." + (interactive "p") + (and (org-region-active-p) (org-cursor-to-region-beginning)) + (unless (org-at-item-p) + (error "Not on an item")) + (let ((origin-ind (save-excursion + (goto-char (org-list-top-point)) + (org-get-indentation))) + beg end ind ind1 ind-bul delta ind-down ind-up firstp) + (setq firstp (org-first-list-item-p)) + (save-excursion + (setq end (and (org-region-active-p) (region-end))) + (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (setq beg org-last-indent-begin-marker + end org-last-indent-end-marker) + (org-beginning-of-item) + (setq beg (move-marker org-last-indent-begin-marker (point))) + (if no-subtree + (org-end-of-item-text-before-children) + (org-end-of-item)) + (setq end (move-marker org-last-indent-end-marker (or end (point))))) + (goto-char beg) + (setq ind-bul (org-item-indent-positions) + ind (caar ind-bul) + ind-down (car (nth 2 ind-bul)) + ind-up (car (nth 1 ind-bul)) + delta (if (> arg 0) + (if ind-down (- ind-down ind) 2) + (if ind-up (- ind-up ind) -2))) + (if (and (< (+ delta ind) origin-ind) + ;; verify we're not at the top level item + (/= (point-at-bol) (org-list-top-point))) + (error "Cannot outdent beyond top level item")) + (while (< (point) end) + (beginning-of-line 1) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (delete-region (point-at-bol) (point)) + (or (eolp) (org-indent-to-column (+ ind1 delta))) + (beginning-of-line 2))) + (org-fix-bullet-type + (and (> arg 0) + (not firstp) + (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet)))) + (org-maybe-renumber-ordered-list-safe) + (save-excursion + (beginning-of-line 0) + (ignore-errors (org-beginning-of-item)) + (org-maybe-renumber-ordered-list-safe)))) + +(defun org-item-indent-positions () + "Return indentation for plain list items. +This returns a list with three values: The current indentation, the +parent indentation and the indentation a child should have. +Assumes cursor in item line." + (let* ((bolpos (point-at-bol)) + (ind (org-get-indentation)) + (bullet (org-get-bullet)) + ind-down ind-up bullet-up bullet-down pos) + (save-excursion + (org-beginning-of-item-list) + (skip-chars-backward "\n\r \t") + (when (org-in-item-p) + (org-beginning-of-item) + (let ((prev-indent (org-get-indentation))) + (when (< prev-indent ind) + (setq ind-up prev-indent) + (setq bullet-up (org-get-bullet)))))) + (setq pos (point)) + (save-excursion + (cond + ((and (ignore-errors (progn (org-previous-item) t)) + (or (end-of-line) t) + (re-search-forward (org-item-re) bolpos t)) + (setq ind-down (org-get-indentation) + bullet-down (org-get-bullet))) + ((and (goto-char pos) + (org-at-item-p)) + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (setq ind-down (current-column) + bullet-down (org-get-bullet))))) + (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down)) + (setq bullet-down (concat "1" (match-string 1 bullet-down)))) + (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up)) + (setq bullet-up (concat "1" (match-string 1 bullet-up)))) + (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet)) + (setq bullet (concat "1" (match-string 1 bullet)))) + (list (cons ind bullet) + (cons ind-up bullet-up) + (cons ind-down bullet-down)))) + +(defvar org-tab-ind-state) ; defined in org.el +(defun org-cycle-item-indentation () + (let ((org-suppress-item-indentation t) + (org-adapt-indentation nil)) + (cond + ((and (looking-at "[ \t]*$") + (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+")) + (setq this-command 'org-cycle-item-indentation) + (if (eq last-command 'org-cycle-item-indentation) + (condition-case nil + (progn (org-outdent-item 1) + (if (equal org-tab-ind-state (org-get-indentation)) + (org-outdent-item 1)) + (end-of-line 1)) + (error + (progn + (while (< (org-get-indentation) org-tab-ind-state) + (progn (org-indent-item 1) (end-of-line 1))) + (setq this-command 'org-cycle)))) + (setq org-tab-ind-state (org-get-indentation)) + (org-indent-item 1)) + t)))) + +;;; Bullets + +(defun org-get-bullet () + (save-excursion + (goto-char (point-at-bol)) + (and (looking-at + "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") + (or (match-string 2) (match-string 4))))) + +(defun org-fix-bullet-type (&optional force-bullet) + "Make sure all items in this list have the same bullet as the first item. +Also, fix the indentation." + (interactive) + (unless (org-at-item-p) (error "This is not a list")) + (org-preserve-lc + (let* ((bullet + (progn + (org-beginning-of-item-list) + (looking-at "[ \t]*\\(\\S-+\\)") + (concat (or force-bullet (match-string 1)) " " + ;; do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp bullet)) + " ")))) + (replace-bullet + (lambda (counter bullet) + (let* ((old (progn + (skip-chars-forward " \t") + (looking-at "\\S-+ *") + (match-string 0)))) + (unless (equal bullet old) + (replace-match bullet) + ;; when bullet lengths are differents, move the whole + ;; sublist accordingly + (org-shift-item-indentation (- (length bullet) (length old)))))))) + (org-apply-on-list replace-bullet bullet) + ;; fix item numbers if necessary + (when (string-match "[0-9]" bullet) (org-renumber-ordered-list))))) + +(defun org-renumber-ordered-list (&optional arg) + "Renumber an ordered plain list. +Cursor needs to be in the first line of an item, the line that starts +with something like \"1.\" or \"2)\". Start to count at ARG or 1." + (interactive "p") + (unless (and (org-at-item-p) + (match-beginning 3)) + (error "This is not an ordered list")) + (org-preserve-lc + (let* ((offset (progn + (org-beginning-of-item) + (or (and (looking-at "[ \t]*\\[@start:\\([0-9]+\\)") + (string-to-number (match-string 1))) + arg + 1))) + (item-fmt (progn + (looking-at "[ \t]*[0-9]+\\([.)]\\)") + (concat "%d" (or (match-string 1) ".")))) + ;; Here is the function applied at each item of the list. + (renumber-item (lambda (counter off fmt) + (let* ((new (format fmt (+ counter off))) + (old (progn + (looking-at (org-item-re)) + (match-string 2))) + (begin (match-beginning 2)) + (end (match-end 2))) + (delete-region begin end) + (goto-char begin) + (insert new) + ;; In case item number went from 9. to 10. + ;; or the other way. + (org-shift-item-indentation (- (length new) (length old))))))) + (org-apply-on-list renumber-item offset item-fmt)))) + +(defun org-maybe-renumber-ordered-list () + "Renumber the ordered list at point if setup allows it. +This tests the user option `org-auto-renumber-ordered-lists' before +doing the renumbering." + (interactive) + (when (and org-auto-renumber-ordered-lists + (org-at-item-p)) + (if (match-beginning 3) + (org-renumber-ordered-list 1) + (org-fix-bullet-type)))) + +(defun org-maybe-renumber-ordered-list-safe () + (ignore-errors + (save-excursion + (org-maybe-renumber-ordered-list)))) + +(defun org-cycle-list-bullet (&optional which) + "Cycle through the different itemize/enumerate bullets. +This cycle the entire list level through the sequence: + + `-' -> `+' -> `*' -> `1.' -> `1)' + +If WHICH is a string, use that as the new bullet. If WHICH is an integer, +0 means `-', 1 means `+' etc." + (interactive "P") + (org-preserve-lc + (let* ((current (progn + (org-beginning-of-item-list) + (org-at-item-p) + (match-string 0))) + (prevp (eq which 'previous)) + (new (cond + ((and (numberp which) + (nth (1- which) '("-" "+" "*" "1." "1)")))) + ((string-match "-" current) (if prevp "1)" "+")) + ((string-match "\\+" current) + (if prevp "-" (if (looking-at "\\S-") "1." "*"))) + ((string-match "\\*" current) (if prevp "+" "1.")) + ((string-match "\\." current) + (if prevp (if (looking-at "\\S-") "+" "*") "1)")) + ((string-match ")" current) (if prevp "1." "-")) + (t (error "This should not happen")))) + (old (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)") + (match-string 2)))) + (replace-match (concat "\\1" new)) + (org-shift-item-indentation (- (length new) (length old))) + (org-fix-bullet-type) + (org-maybe-renumber-ordered-list)))) + +;;; Checkboxes + (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. @@ -413,28 +1038,6 @@ text below the heading." (beginning-of-line 2)))) (org-update-checkbox-count-maybe))) -(defun org-checkbox-blocked-p () - "Is the current checkbox blocked from for being checked now? -A checkbox is blocked if all of the following conditions are fulfilled: - -1. The checkbox is not checked already. -2. The current entry has the ORDERED property set. -3. There is an unchecked checkbox in this entry before the current line." - (catch 'exit - (save-match-data - (save-excursion - (unless (org-at-item-checkbox-p) (throw 'exit nil)) - (when (equal (match-string 0) "[X]") - ;; the box is already checked! - (throw 'exit nil)) - (let ((end (point-at-bol))) - (condition-case nil (org-back-to-heading t) - (error (throw 'exit nil))) - (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) - (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) - (org-current-line) - nil)))))) - (defvar org-checkbox-statistics-hook nil "Hook that is run whenever Org thinks checkbox statistics should be updated. This hook runs even if `org-provide-checkbox-statistics' is nil, to it can @@ -447,112 +1050,114 @@ be used to implement alternative ways of collecting statistics information.") (run-hooks 'org-checkbox-statistics-hook)) (defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. + "Update the checkbox statistics in the current section. This will find all statistic cookies like [57%] and [6/12] and update them with the current numbers. With optional prefix argument ALL, do this for the whole buffer." - (interactive "P") - (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (org-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - (re-find (concat re "\\|" re-box)) - beg-cookie end-cookie is-percent c-on c-off lim new - eline curr-ind next-ind continue-from startsearch - (recursive - (or (not org-hierarchical-checkbox-statistics) - (string-match "\\<recursive\\>" - (or (ignore-errors - (org-entry-get nil "COOKIE_DATA")) - "")))) - (cstat 0) - ) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char end) - ;; find each statistics cookie - (while (and (re-search-backward re-find beg t) - (not (save-match-data - (and (org-on-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get - nil "COOKIE_DATA") - ""))))))) - (setq beg-cookie (match-beginning 1) - end-cookie (match-end 1) - cstat (+ cstat (if end-cookie 1 0)) - startsearch (point-at-eol) - continue-from (match-beginning 0) - is-percent (match-beginning 2) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 - c-off 0) - (when lim - ;; find first checkbox for this cookie and gather - ;; statistics from all that are at this indentation level - (goto-char startsearch) - (if (re-search-forward re-box lim t) - (progn - (org-beginning-of-item) - (setq curr-ind (org-get-indentation)) - (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) - (if recursive - (<= curr-ind next-ind) - (= curr-ind next-ind))) - (save-excursion (end-of-line) (setq eline (point))) - (if (re-search-forward re-box eline t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) - (if (not recursive) - (org-end-of-item) - (end-of-line) - (when (re-search-forward org-list-beginning-re lim t) - (beginning-of-line))) - (setq next-ind (org-get-indentation))))) - (goto-char continue-from) - ;; update cookie - (when end-cookie - (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (goto-char beg-cookie) - (insert new) - (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) - ;; update items checkbox if it has one - (when (org-at-item-p) - (org-beginning-of-item) - (when (and (> (+ c-on c-off) 0) - (re-search-forward re-box (point-at-eol) t)) - (setq beg-cookie (match-beginning 2) - end-cookie (match-end 2)) - (delete-region beg-cookie end-cookie) - (goto-char beg-cookie) - (cond ((= c-off 0) (insert "[X]")) - ((= c-on 0) (insert "[ ]")) - (t (insert "[-]"))) - ))) - (goto-char continue-from)) - (when (interactive-p) - (message "Checkbox statistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) + (interactive "P") + (save-excursion + (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 + (beg (condition-case nil + (progn (org-back-to-heading) (point)) + (error (point-min)))) + (end (move-marker (make-marker) + (progn (outline-next-heading) (point)))) + (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") + (re-find (concat re "\\|" re-box)) + beg-cookie end-cookie is-percent c-on c-off lim new + eline curr-ind next-ind continue-from startsearch + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (ignore-errors + (org-entry-get nil "COOKIE_DATA")) + "")))) + (cstat 0) + ) + (when all + (goto-char (point-min)) + (outline-next-heading) + (setq beg (point) end (point-max))) + (goto-char end) + ;; find each statistics cookie + (while (and (re-search-backward re-find beg t) + (not (save-match-data + (and (org-on-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))))) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1) + cstat (+ cstat (if end-cookie 1 0)) + startsearch (point-at-eol) + continue-from (match-beginning 0) + is-percent (match-beginning 2) + lim (cond + ((org-on-heading-p) (outline-next-heading) (point)) + ((org-at-item-p) (org-end-of-item) (point)) + (t nil)) + c-on 0 + c-off 0) + (when lim + ;; find first checkbox for this cookie and gather + ;; statistics from all that are at this indentation level + (goto-char startsearch) + (if (re-search-forward re-box lim t) + (progn + (org-beginning-of-item) + (setq curr-ind (org-get-indentation)) + (setq next-ind curr-ind) + (while (and (bolp) (org-at-item-p) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) + (save-excursion (end-of-line) (setq eline (point))) + (if (re-search-forward re-box eline t) + (if (member (match-string 2) '("[ ]" "[-]")) + (setq c-off (1+ c-off)) + (setq c-on (1+ c-on)))) + (if (not recursive) + ;; org-get-next-item goes through list-enders + ;; with proper limit. + (goto-char (or (org-get-next-item (point) lim) lim)) + (end-of-line) + (when (re-search-forward (org-item-re) lim t) + (beginning-of-line))) + (setq next-ind (org-get-indentation))))) + (goto-char continue-from) + ;; update cookie + (when end-cookie + (setq new (if is-percent + (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) + (format "[%d/%d]" c-on (+ c-on c-off)))) + (goto-char beg-cookie) + (insert new) + (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) + ;; update items checkbox if it has one + (when (org-at-item-p) + (org-beginning-of-item) + (when (and (> (+ c-on c-off) 0) + (re-search-forward re-box (point-at-eol) t)) + (setq beg-cookie (match-beginning 2) + end-cookie (match-end 2)) + (delete-region beg-cookie end-cookie) + (goto-char beg-cookie) + (cond ((= c-off 0) (insert "[X]")) + ((= c-on 0) (insert "[ ]")) + (t (insert "[-]"))) + ))) + (goto-char continue-from)) + (when (interactive-p) + (message "Checkbox statistics updated %s (%d places)" + (if all "in entire file" "in current outline entry") cstat))))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. Otherwise -it will be `org-todo'." +The face will be `org-done' when all relevant boxes are checked. +Otherwise it will be `org-todo'." (if (match-end 1) (if (equal (match-string 1) "100%") 'org-checkbox-statistics-done @@ -562,584 +1167,111 @@ it will be `org-todo'." 'org-checkbox-statistics-done 'org-checkbox-statistics-todo))) -(defun org-beginning-of-item () - "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let ((pos (point)) - (limit (save-excursion - (condition-case nil - (progn - (org-back-to-heading) - (beginning-of-line 2) (point)) - (error (point-min))))) - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - ind ind1) - (if (org-at-item-p) - (beginning-of-line 1) - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq ind (current-column)) - (if (catch 'exit - (while t - (beginning-of-line 0) - (if (or (bobp) (< (point) limit)) (throw 'exit nil)) +;;; Misc Tools - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (< ind1 ind) - (progn (beginning-of-line 1) (throw 'exit (org-at-item-p)))))) - nil - (goto-char pos) - (error "Not in an item"))))) +(defun org-apply-on-list (function &rest args) + "Call FUNCTION for each item of a the list under point. -(defun org-end-of-item () - "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error." - (interactive) - (let* ((pos (point)) - ind1 - (ind-empty (if org-empty-line-terminates-plain-lists 0 10000)) - (limit (save-excursion (outline-next-heading) (point))) - (ind (save-excursion - (org-beginning-of-item) - (skip-chars-forward " \t") - (current-column))) - (end (catch 'exit - (while t - (beginning-of-line 2) - (if (eobp) (throw 'exit (point))) - (if (>= (point) limit) (throw 'exit (point-at-bol))) - (if (looking-at "[ \t]*$") - (setq ind1 ind-empty) - (skip-chars-forward " \t") - (setq ind1 (current-column))) - (if (<= ind1 ind) - (throw 'exit (point-at-bol))))))) - (if end - (goto-char end) - (goto-char pos) - (error "Not in an item")))) + FUNCTION is called with at least one argument : the number of + items visited, starting at 0, plus ARGS extra arguments. -(defun org-end-of-item-text-before-children () - "Move to the end of the item text, stops before the first child if any. -Assumes that the cursor is in the first line of an item." - (goto-char - (min (save-excursion (org-end-of-item) (point)) - (save-excursion - (goto-char (point-at-eol)) - (if (re-search-forward (concat "^" (org-item-re t)) nil 'move) - (match-beginning 0) - (point-max)))))) - -(defun org-next-item () - "Move to the beginning of the next item in the current plain list. -Error if not at a plain list, or if this is the last item in the list." - (interactive) - (let (ind ind1 (pos (point))) - (org-beginning-of-item) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq ind1 (org-get-indentation)) - (unless (and (org-at-item-p) (= ind ind1)) - (goto-char pos) - (error "On last item")))) - -(defun org-previous-item () - "Move to the beginning of the previous item in the current plain list. -Error if not at a plain list, or if this is the first item in the list." - (interactive) - (let (beg ind ind1 (pos (point))) - (org-beginning-of-item) - (setq beg (point)) - (setq ind (org-get-indentation)) - (goto-char beg) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - nil - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))) - (if (bobp) (throw 'exit t)))) - (condition-case nil - (if (or (not (org-at-item-p)) - (< ind1 (1- ind))) - (error "") - (org-beginning-of-item)) - (error (goto-char pos) - (error "On first item"))))) - -(defun org-first-list-item-p () - "Is this heading the first item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) + Sublists of the list are skipped. Cursor is always at the + beginning of the item." (save-excursion - (org-beginning-of-item) - (= (point) (save-excursion (org-beginning-of-item-list))))) + (let ((move-down-action + (lambda (pos item-count &rest args) + (goto-char pos) + (apply function item-count args) + ;; we need to recompute each time end of list in case + ;; function modified list. + (let ((next-p (org-get-next-item pos (org-end-of-item-list)))) + (when next-p + (apply move-down-action next-p (1+ item-count) args)))))) + (apply move-down-action (org-beginning-of-item-list) 0 args)))) -(defun org-move-item-down () - "Move the plain list item at point down, i.e. swap with following item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive) - (let ((col (current-column)) - (pos (point)) - beg beg0 end end0 ind ind1 txt ne-end ne-beg) - (org-beginning-of-item) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (setq ind (org-get-indentation)) - (org-end-of-item) - (setq end0 (point)) - (setq ind1 (org-get-indentation)) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (org-first-list-item-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - (goto-char end0) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (org-end-of-item) - (org-back-over-empty-lines) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (goto-char pos) (org-skip-whitespace) - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further down")))) +(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) + "Sort plain list items. +The cursor may be at any item of the list that should be sorted. +Sublists are not sorted. -(defun org-move-item-up (arg) - "Move the plain list item at point up, i.e. swap with previous item. -Subitems (items with larger indentation) are considered part of the item, -so this really moves item trees." - (interactive "p") - (let ((col (current-column)) (pos (point)) - beg beg0 end ind ind1 txt - ne-beg ne-ins ins-end) - (org-beginning-of-item) - (setq beg0 (point)) - (setq ind (org-get-indentation)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (goto-char beg0) - (org-end-of-item) - (org-back-over-empty-lines) - (setq end (point)) - (goto-char beg0) - (catch 'exit - (while t - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (if org-empty-line-terminates-plain-lists - (progn - (goto-char pos) - (error "Cannot move this item further up")) - nil) - (if (<= (setq ind1 (org-get-indentation)) ind) - (throw 'exit t))))) - (condition-case nil - (org-beginning-of-item) - (error (goto-char beg0) - (move-to-column col) - (error "Cannot move this item further up"))) - (setq ind1 (org-get-indentation)) - (if (and (org-at-item-p) (= ind ind1)) - (progn - (setq ne-ins (org-back-over-empty-lines)) - (setq txt (buffer-substring beg end)) - (save-excursion - (delete-region beg end)) - (setq pos (point)) - (insert txt) - (setq ins-end (point)) - (goto-char pos) (org-skip-whitespace) +Sorting can be alphabetically, numerically, by date/time as given by +a time stamp, by a property or by priority. - (when (and (org-first-list-item-p) (> ne-ins ne-beg)) - ;; Move whitespace back to beginning - (save-excursion - (goto-char ins-end) - (let ((kill-whole-line t)) - (kill-line (- ne-ins ne-beg)) (point))) - (insert (make-string (- ne-ins ne-beg) ?\n))) +The command prompts for the sorting type unless it has been given to the +function through the SORTING-TYPE argument, which needs to be a character, +\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the +precise meaning of each character: - (org-maybe-renumber-ordered-list) - (move-to-column col)) - (goto-char pos) - (move-to-column col) - (error "Cannot move this item further up")))) +n Numerically, by converting the beginning of the entry/item to a number. +a Alphabetically, ignoring the TODO keyword and the priority, if any. +t By date/time, either the first active time stamp in the entry, or, if + none exist, by the first inactive one. + In items, only the first line will be checked. -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." - (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) +Capital letters will reverse the sort order. -(defun org-maybe-renumber-ordered-list-safe () - (condition-case nil - (save-excursion - (org-maybe-renumber-ordered-list)) - (error nil))) +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a +function to be called with point at the beginning of the record. +It must return either a string or a number that should serve as +the sorting key for that record. -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: - - `-' -> `+' -> `*' -> `1.' -> `1)' - -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 means `-', 1 means `+' etc." +Comparing entries ignores case by default. However, with an +optional argument WITH-CASE, the sorting considers case as well." (interactive "P") - (org-preserve-lc - (org-beginning-of-item-list) - (org-at-item-p) - (beginning-of-line 1) - (let ((current (match-string 0)) - (prevp (eq which 'previous)) - new old) - (setq new (cond - ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) - (if prevp (if (looking-at "\\S-") "+" "*") "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) - (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)") - (setq old (match-string 2)) - (replace-match (concat "\\1" new))) - (org-shift-item-indentation (- (length new) (length old))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) - -(defun org-get-string-indentation (s) - "What indentation has S due to SPACE and TAB at the beginning of the string?" - (let ((n -1) (i 0) (w tab-width) c) - (catch 'exit - (while (< (setq n (1+ n)) (length s)) - (setq c (aref s n)) - (cond ((= c ?\ ) (setq i (1+ i))) - ((= c ?\t) (setq i (* (/ (+ w i) w) w))) - (t (throw 'exit t))))) - i)) - -(defun org-renumber-ordered-list (arg) - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\"." - (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let ((line (org-current-line)) - (col (current-column)) - (ind (org-get-string-indentation - (buffer-substring (point-at-bol) (match-beginning 3)))) - ;; (term (substring (match-string 3) -1)) - ind1 (n (1- arg)) - fmt bobp old new delta) - ;; find where this list begins - (org-beginning-of-item-list) - (setq bobp (bobp)) - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (setq fmt (concat "%d" (or (match-string 1) "."))) - (save-excursion - (goto-char (match-end 0)) - (if (looking-at "[ \t]*\\[@start:\\([0-9]+\\)") - (setq n (1- (string-to-number (match-string 1)))))) - (beginning-of-line 0) - ;; walk forward and replace these numbers - (catch 'exit - (while t - (catch 'next - (if bobp (setq bobp nil) (beginning-of-line 2)) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (setq old (match-string 2)) - (delete-region (match-beginning 2) (match-end 2)) - (goto-char (match-beginning 2)) - (insert (setq new (format fmt (setq n (1+ n))))) - (setq delta (- (length new) (length old))) - (org-shift-item-indentation delta) - (if (= (org-current-line) line) (setq col (+ col delta)))))) - (org-goto-line line) - (org-move-to-column col))) - -(defvar org-suppress-item-indentation) ; dynamically scoped parameter -(defun org-fix-bullet-type (&optional force-bullet) - "Make sure all items in this list have the same bullet as the first item. -Also, fix the indentation." - (interactive) - (unless (org-at-item-p) (error "This is not a list")) - (let ((line (org-current-line)) - (chars-from-eol (- (point-at-eol) (point))) - (ind (current-indentation)) - ind1 bullet oldbullet) - ;; find where this list begins - (org-beginning-of-item-list) - (beginning-of-line 1) - ;; find out what the bullet type is - (looking-at "[ \t]*\\(\\S-+\\)") - (setq bullet (concat (or force-bullet (match-string 1)) " ")) - (if (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - (setq bullet (concat bullet " "))) - ;; walk forward and replace these numbers - (beginning-of-line 0) - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (eobp) (throw 'exit nil)) - (if (looking-at "[ \t]*$") (throw 'next nil)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (> ind1 ind) (throw 'next t)) - (if (< ind1 ind) (throw 'exit t)) - (if (not (org-at-item-p)) (throw 'exit nil)) - (skip-chars-forward " \t") - (looking-at "\\S-+ *") - (setq oldbullet (match-string 0)) - (unless (equal bullet oldbullet) (replace-match bullet)) - (org-shift-item-indentation (- (length bullet) - (length oldbullet)))))) - (org-goto-line line) - (goto-char (max (point-at-bol) (- (point-at-eol) chars-from-eol))) - (if (string-match "[0-9]" bullet) - (org-renumber-ordered-list 1)))) - -(defun org-shift-item-indentation (delta) - "Shift the indentation in current item by DELTA." - (unless (org-bound-and-true-p org-suppress-item-indentation) - (save-excursion - (let ((beg (point-at-bol)) - (end (progn (org-end-of-item) (point))) - i) - (goto-char end) - (beginning-of-line 0) - (while (> (point) beg) - (when (looking-at "[ \t]*\\S-") - ;; this is not an empty line - (setq i (org-get-indentation)) - (if (and (> i 0) (> (setq i (+ i delta)) 0)) - (indent-line-to i))) - (beginning-of-line 0)))))) - -(defun org-beginning-of-item-list () - "Go to the beginning of the current item list. -I.e. to the first item in this list." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 0) - (if (looking-at "[ \t]*$") - (throw (if (bobp) 'exit 'next) t)) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (and (= (point-at-bol) (point-min)) - (setq pos (point-min)))) - (throw 'exit t) - (when (org-at-item-p) (setq pos (point-at-bol))))))) - (goto-char pos))) - -(defun org-end-of-item-list () - "Go to the end of the current item list. -I.e. to the text after the last item." - (interactive) - (org-beginning-of-item) - (let ((pos (point-at-bol)) - (ind (org-get-indentation)) - ind1) - ;; find where this list begins - (catch 'exit - (while t - (catch 'next - (beginning-of-line 2) - (if (looking-at "[ \t]*$") - (if (eobp) - (progn (setq pos (point)) (throw 'exit t)) - (throw 'next t))) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (if (or (< ind1 ind) - (and (= ind1 ind) - (not (org-at-item-p))) - (eobp)) - (progn - (setq pos (point-at-bol)) - (throw 'exit t)))))) - (goto-char pos))) - - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) - -(defun org-outdent-item (arg) - "Outdent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree (- arg) 'no-subtree)) - -(defun org-indent-item (arg) - "Indent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree arg 'no-subtree)) - -(defun org-outdent-item-tree (arg &optional no-subtree) - "Outdent a local list item including its children. -If NO-SUBTREE is set, only outdent the item itself, not its children." - (interactive "p") - (org-indent-item-tree (- arg) no-subtree)) - -(defun org-indent-item-tree (arg &optional no-subtree) - "Indent a local list item including its children. -If NO-SUBTREE is set, only indent the item itself, not its children." - (interactive "p") - (and (org-region-active-p) (org-cursor-to-region-beginning)) - (unless (org-at-item-p) - (error "Not on an item")) - (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp) - (setq firstp (org-first-list-item-p)) - (save-excursion - (setq end (and (org-region-active-p) (region-end))) - (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - (if no-subtree - (org-end-of-item-text-before-children) - (org-end-of-item)) - (setq end (move-marker org-last-indent-end-marker (or end (point))))) - (goto-char beg) - (setq ind-bul (org-item-indent-positions) - ind (caar ind-bul) - ind-down (car (nth 2 ind-bul)) - ind-up (car (nth 1 ind-bul)) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - (while (< (point) end) - (beginning-of-line 1) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (org-indent-to-column (+ ind1 delta))) - (beginning-of-line 2))) - (org-fix-bullet-type - (and (> arg 0) - (not firstp) - (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet)))) - (org-maybe-renumber-ordered-list-safe) - (save-excursion - (beginning-of-line 0) - (condition-case nil (org-beginning-of-item) (error nil)) - (org-maybe-renumber-ordered-list-safe)))) - -(defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should have. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - (bullet (org-get-bullet)) - ind-down ind-up bullet-up bullet-down pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (setq ind-up (org-get-indentation)) - (setq bullet-up (org-get-bullet)))) - (setq pos (point)) - (save-excursion - (cond - ((and (condition-case nil (progn (org-previous-item) t) - (error nil)) - (or (forward-char 1) t) - (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t)) - (setq ind-down (org-get-indentation) - bullet-down (org-get-bullet))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column) - bullet-down (org-get-bullet))))) - (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down)) - (setq bullet-down (concat "1" (match-string 1 bullet-down)))) - (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up)) - (setq bullet-up (concat "1" (match-string 1 bullet-up)))) - (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet)) - (setq bullet (concat "1" (match-string 1 bullet)))) - (list (cons ind bullet) - (cons ind-up bullet-up) - (cons ind-down bullet-down)))) - -(defvar org-tab-ind-state) ; defined in org.el -(defun org-cycle-item-indentation () - (let ((org-suppress-item-indentation t) - (org-adapt-indentation nil)) - (cond - ((and (looking-at "[ \t]*$") - (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+")) - (setq this-command 'org-cycle-item-indentation) - (if (eq last-command 'org-cycle-item-indentation) - (condition-case nil - (progn (org-outdent-item 1) - (if (equal org-tab-ind-state (org-get-indentation)) - (org-outdent-item 1)) - (end-of-line 1)) - (error - (progn - (while (< (org-get-indentation) org-tab-ind-state) - (progn (org-indent-item 1) (end-of-line 1))) - (setq this-command 'org-cycle)))) - (setq org-tab-ind-state (org-get-indentation)) - (org-indent-item 1)) - t)))) - -(defun org-get-bullet () - (save-excursion - (goto-char (point-at-bol)) - (and (looking-at - "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") - (or (match-string 2) (match-string 4))))) + (let* ((case-func (if with-case 'identity 'downcase)) + (start (org-beginning-of-item-list)) + (end (save-excursion (org-end-of-item-list))) + (sorting-type + (progn + (message + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:") + (read-char-exclusive))) + (getkey-func (and (= (downcase sorting-type) ?f) + (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil) + (intern getkey-func)))) + (message "Sorting items...") + (save-restriction + (narrow-to-region start end) + (let* ((dcst (downcase sorting-type)) + (case-fold-search nil) + (now (current-time)) + (sort-func (cond + ((= dcst ?a) 'string<) + ((= dcst ?f) compare-func) + ((member dcst '(?p ?t ?s ?d ?c)) '<) + (t nil))) + (begin-record (lambda () + (let ((next-p (org-get-next-item (point) (point-max)))) + (goto-char (or next-p (point-max)))))) + (end-record (lambda () + (goto-char (org-end-of-item-before-blank)))) + (value-to-sort (lambda nil + (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") + (cond + ((= dcst ?n) + (string-to-number (buffer-substring (match-end 0) + (point-at-eol)))) + ((= dcst ?a) + (buffer-substring (match-end 0) (point-at-eol))) + ((= dcst ?t) + (if (or (re-search-forward org-ts-regexp (point-at-eol) t) + (re-search-forward org-ts-regexp-both + (point-at-eol) t)) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now))) + ((= dcst ?f) + (if getkey-func + (let ((value (funcall getkey-func))) + (if (stringp value) + (funcall case-func value) + value)) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type))))))) + (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func) + (org-maybe-renumber-ordered-list) + (run-hooks 'org-after-sorting-entries-or-items-hook) + (message "Sorting items...done"))))) ;;; Send and receive lists @@ -1147,36 +1279,22 @@ Assumes cursor in item line." "Parse the list at point and maybe DELETE it. Return a list containing first level items as strings and sublevels as a list of strings." - (let* ((item-beginning (org-list-item-beginning)) - (start (car item-beginning)) - (end (save-excursion - (goto-char (org-list-end (cdr item-beginning))) - (org-back-over-empty-lines) - (point))) + (let* ((start (goto-char (org-list-top-point))) + (end (save-excursion (org-list-bottom-point))) output itemsep ltype) - (while (re-search-forward org-list-beginning-re end t) - (goto-char (match-beginning 3)) - (save-match-data - (cond ((string-match "[0-9]" (match-string 2)) + (while (re-search-forward (org-item-re) end t) + (save-excursion + (beginning-of-line) + (cond ((looking-at-p "^[ \t]*[0-9]") (setq itemsep "[0-9]+\\(?:\\.\\|)\\)" ltype 'ordered)) - ((string-match "^.*::" (match-string 0)) - (setq itemsep "[-+]" ltype 'descriptive)) - (t (setq itemsep "[-+]" ltype 'unordered)))) - (let* ((indent1 (match-string 1)) - (nextitem (save-excursion - (save-match-data - (or (and (re-search-forward - (concat "^" indent1 itemsep " *?") end t) - (match-beginning 0)) end)))) - (item (buffer-substring - (point) - (or (and (org-re-search-forward-unprotected - org-list-beginning-re end t) - (goto-char (match-beginning 0))) - (goto-char end)))) - (nextindent (match-string 1)) - (item (org-trim item)) + ((looking-at-p "^.*::") + (setq itemsep "[-+*]" ltype 'descriptive)) + (t (setq itemsep "[-+*]" ltype 'unordered)))) + (let* ((indent1 (org-get-indentation)) + (nextitem (or (org-get-next-item (point) end) end)) + (item (org-trim (buffer-substring (point) (org-end-of-item-text-before-children)))) + (nextindent (org-get-indentation)) (item (if (string-match "^\\[\\([xX ]\\)\\]" item) (replace-match (if (equal (match-string 1 item) " ") "[CBOFF]" @@ -1184,8 +1302,7 @@ sublevels as a list of strings." t nil item) item))) (push item output) - (when (> (length nextindent) - (length indent1)) + (when (> nextindent indent1) (narrow-to-region (point) nextitem) (push (org-list-parse-list) output) (widen)))) @@ -1193,35 +1310,14 @@ sublevels as a list of strings." (setq output (nreverse output)) (push ltype output))) -(defun org-list-item-beginning () - "Find the beginning of the list item. -Return a cons which car is the beginning position of the item and -cdr is the indentation string." - (save-excursion - (if (not (or (looking-at org-list-beginning-re) - (re-search-backward - org-list-beginning-re nil t))) - (progn (goto-char (point-min)) (point)) - (cons (match-beginning 0) (match-string 1))))) - -(defun org-list-goto-true-beginning () - "Go to the beginning of the list at point." - (beginning-of-line 1) - (while (looking-at org-list-beginning-re) - (beginning-of-line 0)) - (progn - (re-search-forward org-list-beginning-re nil t) - (goto-char (match-beginning 0)))) - (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) - (org-list-goto-true-beginning) + (goto-char (org-list-top-point)) (let ((list (org-list-parse-list t)) nstars) (save-excursion - (if (condition-case nil - (org-back-to-heading) - (error nil)) + (if (ignore-errors + (org-back-to-heading)) (progn (re-search-forward org-complex-heading-regexp nil t) (setq nstars (length (match-string 1)))) (setq nstars 0))) @@ -1239,20 +1335,6 @@ cdr is the indentation string." (org-list-make-subtrees item (1+ level)))) list))) -(defun org-list-end (indent) - "Return the position of the end of the list. -INDENT is the indentation of the list, as a string." - (save-excursion - (catch 'exit - (while (or (looking-at org-list-beginning-re) - (looking-at (concat "^" indent "[ \t]+\\|^$")) - (> (or (get-text-property (point) 'original-indentation) -1) - (length indent))) - (if (eq (point) (point-max)) - (throw 'exit (point-max))) - (forward-line 1))) - (point))) - (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." (interactive) @@ -1276,7 +1358,7 @@ this list." (catch 'exit (unless (org-at-item-p) (error "Not at a list")) (save-excursion - (org-list-goto-true-beginning) + (goto-char (org-list-top-point)) (beginning-of-line 0) (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (if maybe @@ -1284,10 +1366,11 @@ this list." (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) - (item-beginning (org-list-item-beginning)) - (list (save-excursion (org-list-goto-true-beginning) - (org-list-parse-list))) - txt beg) + (txt (buffer-substring-no-properties + (org-list-top-point) + (org-list-bottom-point))) + (list (org-list-parse-list)) + beg) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform list))) @@ -1339,21 +1422,21 @@ Valid parameters PARAMS are (interactive) (let* ((p params) sublist (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (dstart (plist-get p :dstart)) - (dend (plist-get p :dend)) - (dtstart (plist-get p :dtstart)) - (dtend (plist-get p :dtend)) - (ddstart (plist-get p :ddstart)) - (ddend (plist-get p :ddend)) - (istart (plist-get p :istart)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep)) - (cbon (plist-get p :cbon)) + (ostart (plist-get p :ostart)) + (oend (plist-get p :oend)) + (ustart (plist-get p :ustart)) + (uend (plist-get p :uend)) + (dstart (plist-get p :dstart)) + (dend (plist-get p :dend)) + (dtstart (plist-get p :dtstart)) + (dtend (plist-get p :dtend)) + (ddstart (plist-get p :ddstart)) + (ddend (plist-get p :ddend)) + (istart (plist-get p :istart)) + (iend (plist-get p :iend)) + (isep (plist-get p :isep)) + (lsep (plist-get p :lsep)) + (cbon (plist-get p :cbon)) (cboff (plist-get p :cboff))) (let ((wrapper (cond ((eq (car list) 'ordered) @@ -1369,19 +1452,20 @@ Valid parameters PARAMS are (when (string-match "^\\(.*\\) ::" sublist) (setq term (org-trim (format (concat dtstart "%s" dtend) (match-string 1 sublist)))) - (setq sublist (substring sublist (1+ (length term))))) + (setq sublist (concat ddstart + (org-trim (substring sublist (match-end 0))) + ddend))) (if (string-match "\\[CBON\\]" sublist) (setq sublist (replace-match cbon t t sublist))) (if (string-match "\\[CBOFF\\]" sublist) (setq sublist (replace-match cboff t t sublist))) (if (string-match "\\[-\\]" sublist) (setq sublist (replace-match "$\\boxminus$" t t sublist))) - (setq rtn (concat rtn istart term ddstart - sublist ddend iend isep))) - (t (setq rtn (concat rtn ;; previous list - lsep ;; list separator + (setq rtn (concat rtn istart term sublist iend isep))) + (t (setq rtn (concat rtn ;; previous list + lsep ;; list separator (org-list-to-generic sublist p) - lsep ;; list separator + lsep ;; list separator ))))) (format wrapper rtn)))) diff --git a/lisp/org.el b/lisp/org.el index 7be144370..3410d9802 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -7516,13 +7516,15 @@ and still retain the repeater to cover future instances of the task." ;;; Outline Sorting (defun org-sort (with-case) - "Call `org-sort-entries-or-items' or `org-table-sort-lines'. + "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. Optional argument WITH-CASE means sort case-sensitively. With a double prefix argument, also remove duplicate entries." (interactive "P") - (if (org-at-table-p) - (org-call-with-arg 'org-table-sort-lines with-case) - (org-call-with-arg 'org-sort-entries-or-items with-case))) + (cond + ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) + ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) + (t + (org-call-with-arg 'org-sort-entries with-case)))) (defun org-sort-remove-invisible (s) (remove-text-properties 0 (length s) org-rm-props s) @@ -7540,14 +7542,12 @@ When children are sorted, the cursor is in the parent line when this hook gets called. When a region or a plain list is sorted, the cursor will be in the first entry of the sorted region/list.") -(defun org-sort-entries-or-items +(defun org-sort-entries (&optional with-case sorting-type getkey-func compare-func property) - "Sort entries on a certain level of an outline tree, or plain list items. + "Sort entries on a certain level of an outline tree. If there is an active region, the entries in the region are sorted. Else, if the cursor is before the first entry, sort the top-level items. Else, the children of the entry at point are sorted. -If the cursor is at the first item in a plain list, the list items will be -sorted. Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. @@ -7561,7 +7561,6 @@ n Numerically, by converting the beginning of the entry/item to a number. a Alphabetically, ignoring the TODO keyword and the priority, if any. t By date/time, either the first active time stamp in the entry, or, if none exist, by the first inactive one. - In items, only the first line will be checked. s By the scheduled date/time. d By deadline date/time. c By creation time, which is assumed to be the first inactive time stamp @@ -7580,7 +7579,7 @@ WITH-CASE, the sorting considers case as well." (interactive "P") (let ((case-func (if with-case 'identity 'downcase)) start beg end stars re re2 - txt what tmp plain-list-p) + txt what tmp) ;; Find beginning and end of region to sort (cond ((org-region-active-p) @@ -7590,15 +7589,6 @@ WITH-CASE, the sorting considers case as well." (goto-char (region-beginning)) (if (not (org-on-heading-p)) (outline-next-heading)) (setq start (point))) - ((org-at-item-p) - ;; we will sort this plain list - (org-beginning-of-item-list) (setq start (point)) - (org-end-of-item-list) - (or (bolp) (insert "\n")) - (setq end (point)) - (goto-char start) - (setq plain-list-p t - what "plain list")) ((or (org-on-heading-p) (condition-case nil (progn (org-back-to-heading) t) (error nil))) ;; we will sort the children of the current headline @@ -7631,43 +7621,39 @@ WITH-CASE, the sorting considers case as well." (setq beg (point)) (if (>= beg end) (error "Nothing to sort")) - (unless plain-list-p - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (error "Region to sort contains a level above the first entry"))) + (looking-at "\\(\\*+\\)") + (setq stars (match-string 1) + re (concat "^" (regexp-quote stars) " +") + re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[^*]") + txt (buffer-substring beg end)) + (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) + (if (and (not (equal stars "*")) (string-match re2 txt)) + (error "Region to sort contains a level above the first entry")) (unless sorting-type (message - (if plain-list-p - "Sort %s: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:" - "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc + "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc [t]ime [s]cheduled [d]eadline [c]reated - A/N/T/S/D/C/P/O/F means reversed:") + A/N/T/S/D/C/P/O/F means reversed:" what) (setq sorting-type (read-char-exclusive)) (and (= (downcase sorting-type) ?f) (setq getkey-func (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) + obarray 'fboundp t nil nil)) (setq getkey-func (intern getkey-func))) (and (= (downcase sorting-type) ?r) (setq property (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) + (mapcar 'list (org-buffer-property-keys t)) + nil t)))) (message "Sorting entries...") (save-restriction (narrow-to-region start end) - (let ((dcst (downcase sorting-type)) (case-fold-search nil) (now (current-time))) @@ -7675,99 +7661,70 @@ WITH-CASE, the sorting considers case as well." (/= dcst sorting-type) ;; This function moves to the beginning character of the "record" to ;; be sorted. - (if plain-list-p - (lambda nil - (if (org-at-item-p) t (goto-char (point-max)))) - (lambda nil - (if (re-search-forward re nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))))) + (lambda nil + (if (re-search-forward re nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) ;; This function moves to the last character of the "record" being ;; sorted. - (if plain-list-p - 'org-end-of-item - (lambda nil - (save-match-data - (condition-case nil - (outline-forward-same-level 1) - (error - (goto-char (point-max))))))) - + (lambda nil + (save-match-data + (condition-case nil + (outline-forward-same-level 1) + (error + (goto-char (point-max)))))) ;; This function returns the value that gets sorted against. - (if plain-list-p - (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (or (re-search-forward org-ts-regexp (point-at-eol) t) - (re-search-forward org-ts-regexp-both - (point-at-eol) t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at org-complex-heading-regexp) - (string-to-number (match-string 4)) - nil)) - ((= dcst ?a) - (if (looking-at org-complex-heading-regexp) - (funcall case-func (match-string 4)) - nil)) - ((= dcst ?t) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (or (re-search-forward org-ts-regexp end t) - (re-search-forward org-ts-regexp-both end t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?c) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward - (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") - end t) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?s) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-scheduled-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?d) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-deadline-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?p) - (if (re-search-forward org-priority-regexp (point-at-eol) t) - (string-to-char (match-string 2)) - org-default-priority)) - ((= dcst ?r) - (or (org-entry-get nil property) "")) - ((= dcst ?o) - (if (looking-at org-complex-heading-regexp) - (- 9999 (length (member (match-string 2) - org-todo-keywords-1))))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))) + (lambda nil + (cond + ((= dcst ?n) + (if (looking-at org-complex-heading-regexp) + (string-to-number (match-string 4)) + nil)) + ((= dcst ?a) + (if (looking-at org-complex-heading-regexp) + (funcall case-func (match-string 4)) + nil)) + ((= dcst ?t) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (or (re-search-forward org-ts-regexp end t) + (re-search-forward org-ts-regexp-both end t)) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?c) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward + (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") + end t) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?s) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-scheduled-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?d) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-deadline-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?p) + (if (re-search-forward org-priority-regexp (point-at-eol) t) + (string-to-char (match-string 2)) + org-default-priority)) + ((= dcst ?r) + (or (org-entry-get nil property) "")) + ((= dcst ?o) + (if (looking-at org-complex-heading-regexp) + (- 9999 (length (member (match-string 2) + org-todo-keywords-1))))) + ((= dcst ?f) + (if getkey-func + (progn + (setq tmp (funcall getkey-func)) + (if (stringp tmp) (setq tmp (funcall case-func tmp))) + tmp) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type)))) nil (cond ((= dcst ?a) 'string<) @@ -18272,16 +18229,25 @@ really on, so that the block visually is on the match." (throw 'exit t))) nil)))) -(defun org-in-regexps-block-p (start-re end-re) - "Return t if the current point is between matches of START-RE and END-RE. -This will also return to if point is on one of the two matches." - (interactive) - (let ((p (point))) +(defun org-in-regexps-block-p (start-re end-re &optional bound) + "Returns t if the current point is between matches of START-RE and END-RE. +This will also return t if point is on one of the two matches or +in an unfinished block. END-RE can be a string or a form +returning a string. + +An optional third argument bounds the search. It defaults to +previous heading or `point-min'." + (let ((pos (point)) + (limit (or bound + (save-excursion (outline-previous-heading)) + (point-min)))) (save-excursion - (and (or (org-at-regexp-p start-re) - (re-search-backward start-re nil t)) - (re-search-forward end-re nil t) - (>= (point) p))))) + ;; we're on a block when point is on start-re... + (or (org-at-regexp-p start-re) + ;; ... or start-re can be found above... + (and (re-search-backward start-re bound t) + ;; ... but no end-re between start-re and point. + (not (re-search-forward (eval end-re) pos t))))))) (defun org-occur-in-agenda-files (regexp &optional nlines) "Call `multi-occur' with buffers for all agenda files." @@ -18573,25 +18539,8 @@ which make use of the date at the cursor." (re-search-backward (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) (setq column (org-get-indentation (match-string 0)))) - (t - (beginning-of-line 0) - (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]") - (not (looking-at "[ \t]*:END:")) - (not (looking-at org-drawer-regexp))) - (beginning-of-line 0)) - (cond - ((looking-at "\\*+[ \t]+") - (if (not org-adapt-indentation) - (setq column 0) - (goto-char (match-end 0)) - (setq column (current-column)))) - ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ((looking-at "\\([ \t]*\\):END:") - (goto-char (match-end 1)) - (setq column (current-column))) - ((org-in-item-p) + ;; Are we in a list ? + ((org-in-item-p) (org-beginning-of-item) (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") (setq bpos (match-beginning 1) tpos (match-end 0) @@ -18603,8 +18552,8 @@ which make use of the date at the cursor." (setq tcol (+ bcol 5))) (if (not itemp) (setq column tcol) - (goto-char pos) (beginning-of-line 1) + (goto-char pos) (if (looking-at "\\S-") (progn (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") @@ -18612,6 +18561,34 @@ which make use of the date at the cursor." btype (if (string-match "[0-9]" bullet) "n" bullet)) (setq column (if (equal btype bullet-type) bcol tcol))) (setq column (org-get-indentation))))) + ;; This line has nothing special, look upside to get a clue about + ;; what to do. + (t + (beginning-of-line 0) + (while (and (not (bobp)) (looking-at "[ \t]*[\n:#|]") + (not (looking-at "[ \t]*:END:")) + (not (looking-at org-drawer-regexp))) + (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: indent consequently. + ((looking-at org-drawer-regexp) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; The drawer had ended: indent like its :END: line. + ((looking-at "\\([ \t]*\\):END:") + (goto-char (match-end 1)) + (setq column (current-column))) + ;; There was a list that since ended: indent like top point. + ((org-in-item-p) + (goto-char (org-list-top-point)) + (setq column (org-get-indentation))) + ;; Else, nothing noticeable found: get indentation and go on. (t (setq column (org-get-indentation)))))) (goto-char pos) (if (<= (current-column) (current-indentation)) From 9996da73a39f88357bea5f3180fe87c0fed32012 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 10 Jul 2010 23:56:41 +0200 Subject: [PATCH 102/348] Fix radio lists and radio templates. * lisp/org-list.el (org-list-parse-list): Better handling of restrictions when function is called on a list with sublists. * lisp/org-list.el (org-list-send-list): find the true ending of the list being sent. * lisp/org-list.el (org-list-radio-list-templates): templates are more specific to lists. --- lisp/org-list.el | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 64d7cdfff..964277fad 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1303,9 +1303,9 @@ sublevels as a list of strings." item))) (push item output) (when (> nextindent indent1) - (narrow-to-region (point) nextitem) - (push (org-list-parse-list) output) - (widen)))) + (save-restriction + (narrow-to-region (point) nextitem) + (push (org-list-parse-list) output))))) (when delete (delete-region start end)) (setq output (nreverse output)) (push ltype output))) @@ -1366,11 +1366,15 @@ this list." (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) - (txt (buffer-substring-no-properties - (org-list-top-point) - (org-list-bottom-point))) - (list (org-list-parse-list)) - beg) + (top-point (org-list-top-point)) + (bottom-point + (save-excursion + (goto-char (org-list-bottom-point)) + (re-search-backward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" top-point t))) + (list (save-restriction + (narrow-to-region top-point bottom-point) + (org-list-parse-list))) + beg txt) (unless (fboundp transform) (error "No such transformation function %s" transform)) (let ((txt (funcall transform list))) From 6167dfa4449d16f341e4dfa09d76496d103e8a17 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 10 Jul 2010 21:19:06 +0200 Subject: [PATCH 103/348] Notice end of lists. * lisp/org-html.el: Notice end of lists. --- lisp/org-html.el | 41 ++++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 19 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 099b2e300..f0c04c31d 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -561,7 +561,11 @@ This may also be a function, building and inserting the postamble.") (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label) (setq l1 (substring label (match-beginning 1))) (setq l1 label))) - (replace-match (format "[[#%s][%s]]" label l1) t t))))) + (replace-match (format "[[#%s][%s]]" label l1) t t)))) + (goto-char (point-min)) + (while (org-search-forward-unenclosed (org-item-re) nil 'move) + (goto-char (org-list-bottom-point)) + (insert "ORG-LIST-END\n"))) ;;;###autoload (defun org-export-as-html-and-open (arg) @@ -1486,14 +1490,14 @@ lang=\"%s\" xml:lang=\"%s\"> (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) (setq head-count (+ head-count 1))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + ;; (when in-local-list + ;; ;; Close any local lists before inserting a new header line + ;; (while local-list-type + ;; (org-close-li (car local-list-type)) + ;; (insert (format "</%sl>\n" (car local-list-type))) + ;; (pop local-list-type)) + ;; (setq local-list-indent nil + ;; in-local-list nil)) (setq first-heading-pos (or first-heading-pos (point))) (org-html-level-start level txt umax (and org-export-with-toc (<= level umax)) @@ -1505,17 +1509,16 @@ lang=\"%s\" xml:lang=\"%s\"> (insert "<pre>") (setq inquote t))) - ((string-match "^[ \t]*- __+[ \t]*$" line) + ((string-match "^ORG-LIST-END$" line) ;; Explicit list closure - (when local-list-type - (let ((ind (org-get-indentation line))) - (while (and local-list-indent - (<= ind (car local-list-indent))) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) - (pop local-list-indent)) - (or local-list-indent (setq in-local-list nil)))) + (let ((ind (org-get-indentation line))) + (while (and local-list-indent + (<= ind (car local-list-indent))) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) + (pop local-list-indent)) + (or local-list-indent (setq in-local-list nil))) (throw 'nextline nil)) ((and org-export-with-tables From 1d99d9ee73f8f4b1c09c769491fa5fc2e53cfa47 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 11:04:32 +0200 Subject: [PATCH 104/348] Do not try to guess list ending and let org-list.el do its job. * lisp/org-html.el: preprocess buffer string and add ORG-LIST-END where needed. Lists should not end before seeing this. --- lisp/org-html.el | 80 ++++++++++++++++++++++++------------------------ 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index f0c04c31d..e992d8ea4 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1185,7 +1185,7 @@ lang=\"%s\" xml:lang=\"%s\"> (org-open-par)) (throw 'nextline nil)) - (org-export-html-close-lists-maybe line) + ;; (org-export-html-close-lists-maybe line) ;; Protected HTML (when (get-text-property 0 'org-protected line) @@ -1490,14 +1490,14 @@ lang=\"%s\" xml:lang=\"%s\"> (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) (setq head-count (+ head-count 1))) - ;; (when in-local-list - ;; ;; Close any local lists before inserting a new header line - ;; (while local-list-type - ;; (org-close-li (car local-list-type)) - ;; (insert (format "</%sl>\n" (car local-list-type))) - ;; (pop local-list-type)) - ;; (setq local-list-indent nil - ;; in-local-list nil)) + (when in-local-list + ;; Close any local lists before inserting a new header line + (while local-list-type + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type)) + (setq local-list-indent nil + in-local-list nil)) (setq first-heading-pos (or first-heading-pos (point))) (org-html-level-start level txt umax (and org-export-with-toc (<= level umax)) @@ -1509,7 +1509,7 @@ lang=\"%s\" xml:lang=\"%s\"> (insert "<pre>") (setq inquote t))) - ((string-match "^ORG-LIST-END$" line) + ((string-match "^ORG-LIST-END" line) ;; Explicit list closure (let ((ind (org-get-indentation line))) (while (and local-list-indent @@ -1667,14 +1667,14 @@ lang=\"%s\" xml:lang=\"%s\"> (when inquote (insert "</pre>\n") (org-open-par)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + ;; (when in-local-list + ;; ;; Close any local lists before inserting a new header line + ;; (while local-list-type + ;; (org-close-li (car local-list-type)) + ;; (insert (format "</%sl>\n" (car local-list-type))) + ;; (pop local-list-type)) + ;; (setq local-list-indent nil + ;; in-local-list nil)) (org-html-level-start 1 nil umax (and org-export-with-toc (<= level umax)) head-count) @@ -2277,28 +2277,28 @@ If there are links in the string, don't modify these." (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -(defun org-export-html-close-lists-maybe (line) - "Close local lists based on the original indentation of the line." - (let* ((rawhtml (and in-local-list - (get-text-property 0 'org-protected line) - (not (get-text-property 0 'org-example line)))) - ;; rawhtml means: This was between #+begin_html..#+end_html - ;; originally, thus it excludes stuff that was a source code example - ;; Actually, this code seems wrong, I don't know why it works, but - ;; it seems to work.... So keep it like this for now. - (ind (if rawhtml - (org-get-indentation line) - (get-text-property 0 'original-indentation line))) - didclose) - (when ind - (while (and in-local-list - (<= ind (car local-list-indent))) - (setq didclose t) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (and didclose (org-open-par))))) +;; (defun org-export-html-close-lists-maybe (line) +;; "Close local lists based on the original indentation of the line." +;; (let* ((rawhtml (and in-local-list +;; (get-text-property 0 'org-protected line) +;; (not (get-text-property 0 'org-example line)))) +;; ;; rawhtml means: This was between #+begin_html..#+end_html +;; ;; originally, thus it excludes stuff that was a source code example +;; ;; Actually, this code seems wrong, I don't know why it works, but +;; ;; it seems to work.... So keep it like this for now. +;; (ind (if rawhtml +;; (org-get-indentation line) +;; (get-text-property 0 'original-indentation line))) +;; didclose) +;; (when ind +;; (while (and in-local-list +;; (<= ind (car local-list-indent))) +;; (setq didclose t) +;; (org-close-li (car local-list-type)) +;; (insert (format "</%sl>\n" (car local-list-type))) +;; (pop local-list-type) (pop local-list-indent) +;; (setq in-local-list local-list-indent)) +;; (and didclose (org-open-par))))) (defvar body-only) ; dynamically scoped into this. (defun org-html-level-start (level title umax with-toc head-count) From 4c0bf39469517cf9fe9c35be881457d790cc8a44 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 15:01:57 +0200 Subject: [PATCH 105/348] Do not delete space between end of list and beginning of the following * lisp/org-html.el: Do not delete space between end of list and beginning of the following. --- lisp/org-html.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index e992d8ea4..a2b82ed33 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1755,8 +1755,8 @@ lang=\"%s\" xml:lang=\"%s\"> (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) (replace-match "")) (goto-char (point-min)) - (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) - (replace-match "")) + ;; (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) + ;; (replace-match "")) ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end n) From a0a86fbba00ad97b2692b75949579022c06f19c5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 15:07:34 +0200 Subject: [PATCH 106/348] Minor fix. * lisp/org-list.el (org-list-bottom-point): No need for square brackets for `skip-chars-backward'. --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 964277fad..790c5320e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -395,7 +395,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: (and (org-in-item-p) (let ((pos (org-beginning-of-item)) (bound (or (and (outline-next-heading) - (skip-chars-backward "[ \t\r\n]") + (skip-chars-backward " \t\r\n") (1+ (point-at-eol))) (point-max)))) ;; The list ending is either first point matching From e3813fcfcb3a6e5ccc9b81e7ea818bd6f9a74042 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 15:17:58 +0200 Subject: [PATCH 107/348] List ending is replaced by a blank line during html export. * org-html.el (org-export-html-preprocess): Replace `org-list-end-re' by a blank line during pre-process. --- lisp/org-html.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/org-html.el b/lisp/org-html.el index a2b82ed33..d80a852f9 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -565,6 +565,8 @@ This may also be a function, building and inserting the postamble.") (goto-char (point-min)) (while (org-search-forward-unenclosed (org-item-re) nil 'move) (goto-char (org-list-bottom-point)) + (when (looking-at (org-list-end-re)) + (replace-match "")) (insert "ORG-LIST-END\n"))) ;;;###autoload From 82f0bd75e73388bda5ddc47c7bd0463710854aaa Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 15:39:49 +0200 Subject: [PATCH 108/348] Delete `org-list-end-re' when `org-list-parse-list' is used for export. * org-list.el (org-list-parse-list): Delete `org-list-end-re' when called with t argument. --- lisp/org-list.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 790c5320e..66a4e7b9f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1306,7 +1306,10 @@ sublevels as a list of strings." (save-restriction (narrow-to-region (point) nextitem) (push (org-list-parse-list) output))))) - (when delete (delete-region start end)) + (when delete + (delete-region start end) + (when (looking-at (org-list-end-re)) + (replace-match ""))) (setq output (nreverse output)) (push ltype output))) From a0ad769d0b73a6232e5a300428d62e4d5daef073 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 19:24:35 +0200 Subject: [PATCH 109/348] Fixed blocks regexp. * lisp/org-list.el (org-search-backward-unenclosed): fix block regexp. * lisp/org-list.el (org-search-forward-unenclosed): fix block regexp. * lisp/org-list.el (org-list-parse-list): minor fix. --- lisp/org-list.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 66a4e7b9f..60927a813 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -263,9 +263,9 @@ the end of the nearest terminator from max." (prog1 (re-search-backward regexp bound noerror) (when (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" + (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]\\)}" + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" '(concat "^[ \t]*\\\\end{" (match-string 1) "}")))) (org-search-backward-unenclosed regexp bound noerror))))) @@ -275,9 +275,9 @@ the end of the nearest terminator from max." (prog1 (re-search-forward regexp bound noerror) (when (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" + (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]\\)}" + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" '(concat "^[ \t]*\\\\end{" (match-string 1) "}")))) (org-search-forward-unenclosed regexp bound noerror))))) @@ -1280,7 +1280,7 @@ optional argument WITH-CASE, the sorting considers case as well." Return a list containing first level items as strings and sublevels as a list of strings." (let* ((start (goto-char (org-list-top-point))) - (end (save-excursion (org-list-bottom-point))) + (end (org-list-bottom-point)) output itemsep ltype) (while (re-search-forward (org-item-re) end t) (save-excursion @@ -1308,8 +1308,9 @@ sublevels as a list of strings." (push (org-list-parse-list) output))))) (when delete (delete-region start end) - (when (looking-at (org-list-end-re)) - (replace-match ""))) + (save-match-data + (when (looking-at (org-list-end-re)) + (replace-match "\n")))) (setq output (nreverse output)) (push ltype output))) From 30fb7a570aa797506c1782bbd6d267c1fe6aba7b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 11 Jul 2010 19:29:11 +0200 Subject: [PATCH 110/348] Fix documentation. * lisp/org.el (org-in-regexps-block-p): Fix documentation. --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 3410d9802..f3c3dd6e7 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18235,8 +18235,8 @@ This will also return t if point is on one of the two matches or in an unfinished block. END-RE can be a string or a form returning a string. -An optional third argument bounds the search. It defaults to -previous heading or `point-min'." +An optional third argument bounds the search for START-RE. It +defaults to previous heading or `point-min'." (let ((pos (point)) (limit (or bound (save-excursion (outline-previous-heading)) From f7f07198dd1331424cb02ca66e91b7d010152595 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 12 Jul 2010 10:48:17 +0200 Subject: [PATCH 111/348] Fix for `org-search-forward-unenclosed' and `org-search-backward-unenclosed'. * lisp/org-list.el (org-search-forward-unenclosed): fix behavior when last occurence was enclosed. * lisp/org-list.el (org-search-backward-unenclosed): fix behavior when last occurence was enclosed. --- lisp/org-list.el | 62 +++++++++++++++++++++++++++++++----------------- 1 file changed, 40 insertions(+), 22 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 60927a813..0647a407f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -257,29 +257,47 @@ the end of the nearest terminator from max." ;; we want to be on the first line of the list ender (match-beginning 0))))) -(defun org-search-backward-unenclosed (regexp &optional bound noerror) - "Like `re-search-backward' but don't stop inside blocks or throw errors." - (ignore-errors - (prog1 - (re-search-backward regexp bound noerror) - (when (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" - '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" - '(concat "^[ \t]*\\\\end{" (match-string 1) "}")))) - (org-search-backward-unenclosed regexp bound noerror))))) +(defun org-search-backward-unenclosed (regexp &optional bound noerror count) + "Like `re-search-backward' but don't stop inside blocks or throw errors. -(defun org-search-forward-unenclosed (regexp &optional bound noerror) - "Like `re-search-forward' but don't stop inside blocks or throw errors." - (ignore-errors - (prog1 - (re-search-forward regexp bound noerror) - (when (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" - '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" - '(concat "^[ \t]*\\\\end{" (match-string 1) "}")))) - (org-search-forward-unenclosed regexp bound noerror))))) +Optional fourth argument COUNT searches for that many occurrences, +valid or not, then makes sure the last one is valid." + (let ((origin (point))) + (cond + ;; nothing found: return nil + ((not (re-search-backward regexp bound (or noerror t) count)) nil) + ;; match is not enclosed: return point. + ((not (save-match-data + (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" + '(concat "^[ \t]*#\\+end_" (match-string 1))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" + '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))))) + (point)) + (t + ;; else: we start again, searching one more occurrence away. + (goto-char origin) + (org-search-backward-unenclosed regexp bound noerror (1+ (or count 1))))))) + +(defun org-search-forward-unenclosed (regexp &optional bound noerror count) + "Like `re-search-forward' but don't stop inside blocks or throw errors. + +Optional fourth argument COUNT searches for that many occurrences, +valid or not, then makes sure the last one is valid." + (let ((origin (point))) + (cond + ;; nothing found: return nil + ((not (re-search-forward regexp bound (or noerror t) count)) nil) + ;; match is not enclosed: return point. + ((not (save-match-data + (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" + '(concat "^[ \t]*#\\+end_" (match-string 1))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" + '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))))) + (point)) + ;; else: we start again, searching one more occurrence away. + (t + (goto-char origin) + (org-search-forward-unenclosed regexp bound noerror (1+ (or count 1))))))) (defun org-get-item-same-level-internal (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. From 2dec9eb4736ae45f8e8afca303442188f97b7f21 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 12 Jul 2010 14:31:20 +0200 Subject: [PATCH 112/348] Fix regression in `org-sort-list'. * lisp/org-list.el (org-sort-list): end-rec function was ill-defined. --- lisp/org-list.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 0647a407f..721f68148 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1260,8 +1260,8 @@ optional argument WITH-CASE, the sorting considers case as well." ((member dcst '(?p ?t ?s ?d ?c)) '<) (t nil))) (begin-record (lambda () - (let ((next-p (org-get-next-item (point) (point-max)))) - (goto-char (or next-p (point-max)))))) + (skip-chars-forward " \r\t\n") + (beginning-of-line))) (end-record (lambda () (goto-char (org-end-of-item-before-blank)))) (value-to-sort (lambda nil From fb5cab814e5700280b093181741f593a113473a3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 12 Jul 2010 15:41:27 +0200 Subject: [PATCH 113/348] Better regexps in searches unenclosed. * lisp/org.el (org-in-regexps-block-p): minor fix: limit wasn't correctly used. * lisp/org-list.el (org-search-forward-unenclosed): Better regexp used. * lisp/org-list.el (org-search-backward-unenclosed): Better regexp used. --- lisp/org-list.el | 12 ++++++------ lisp/org.el | 2 +- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 721f68148..61a21f918 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -268,9 +268,9 @@ valid or not, then makes sure the last one is valid." ((not (re-search-backward regexp bound (or noerror t) count)) nil) ;; match is not enclosed: return point. ((not (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" - '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" + (or (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z0-9_]+\\)}" '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))))) (point)) (t @@ -289,9 +289,9 @@ valid or not, then makes sure the last one is valid." ((not (re-search-forward regexp bound (or noerror t) count)) nil) ;; match is not enclosed: return point. ((not (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]+\\)" - '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]+\\)}" + (or (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) + (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z0-9_]+\\)}" '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))))) (point)) ;; else: we start again, searching one more occurrence away. diff --git a/lisp/org.el b/lisp/org.el index f3c3dd6e7..f66677570 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18245,7 +18245,7 @@ defaults to previous heading or `point-min'." ;; we're on a block when point is on start-re... (or (org-at-regexp-p start-re) ;; ... or start-re can be found above... - (and (re-search-backward start-re bound t) + (and (re-search-backward start-re limit t) ;; ... but no end-re between start-re and point. (not (re-search-forward (eval end-re) pos t))))))) From ecd5a4b0f1be15fbca4bbf8f7ebb887647ff55ab Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 12 Jul 2010 17:40:00 +0200 Subject: [PATCH 114/348] Make `org-apply-to-list' more functional. * lisp/org-list.el (org-apply-to-list): Now a return value is handed at each new call of the function applied. * lisp/org-list.el (org-fix-bullet-type): Use the new `org-apply-to-list' format. * lisp/org-list.el (org-renumber-ordered-list): Use the new `org-apply-to-list' format. --- lisp/org-list.el | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 61a21f918..65be37693 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -874,7 +874,7 @@ Also, fix the indentation." (string-match org-list-two-spaces-after-bullet-regexp bullet)) " ")))) (replace-bullet - (lambda (counter bullet) + (lambda (result bullet) (let* ((old (progn (skip-chars-forward " \t") (looking-at "\\S-+ *") @@ -884,7 +884,7 @@ Also, fix the indentation." ;; when bullet lengths are differents, move the whole ;; sublist accordingly (org-shift-item-indentation (- (length bullet) (length old)))))))) - (org-apply-on-list replace-bullet bullet) + (org-apply-on-list replace-bullet nil bullet) ;; fix item numbers if necessary (when (string-match "[0-9]" bullet) (org-renumber-ordered-list))))) @@ -919,8 +919,9 @@ with something like \"1.\" or \"2)\". Start to count at ARG or 1." (insert new) ;; In case item number went from 9. to 10. ;; or the other way. - (org-shift-item-indentation (- (length new) (length old))))))) - (org-apply-on-list renumber-item offset item-fmt)))) + (org-shift-item-indentation (- (length new) (length old))) + (1+ counter))))) + (org-apply-on-list renumber-item 0 offset item-fmt)))) (defun org-maybe-renumber-ordered-list () "Renumber the ordered list at point if setup allows it. @@ -1187,25 +1188,31 @@ Otherwise it will be `org-todo'." ;;; Misc Tools -(defun org-apply-on-list (function &rest args) +(defun org-apply-on-list (function init-value &rest args) "Call FUNCTION for each item of a the list under point. - FUNCTION is called with at least one argument : the number of - items visited, starting at 0, plus ARGS extra arguments. +FUNCTION must be called with at least one argument : a return +value that will contain the value returned by the function at +the previous item, plus ARGS extra arguments. INIT-VALUE will be +the value passed to the function at the first item of the list. - Sublists of the list are skipped. Cursor is always at the - beginning of the item." +As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) +will return the number of items in the current list. + +Sublists of the list are skipped. Cursor is always at the +beginning of the item." (save-excursion (let ((move-down-action - (lambda (pos item-count &rest args) + (lambda (pos value &rest args) (goto-char pos) - (apply function item-count args) - ;; we need to recompute each time end of list in case - ;; function modified list. - (let ((next-p (org-get-next-item pos (org-end-of-item-list)))) - (when next-p - (apply move-down-action next-p (1+ item-count) args)))))) - (apply move-down-action (org-beginning-of-item-list) 0 args)))) + (let ((return-value (apply function value args)) + ;; we need to recompute each time end of list in case + ;; function modified list. + (next-p (org-get-next-item pos (org-end-of-item-list)))) + (if next-p + (apply move-down-action next-p return-value args) + return-value))))) + (apply move-down-action (org-beginning-of-item-list) init-value args)))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) "Sort plain list items. From f6770132767da202b711e684805a3e5399b23850 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 12 Jul 2010 18:48:12 +0200 Subject: [PATCH 115/348] Use `org-search-forward-unenclosed' instead of `re-search-forward'. * lisp/org-list.el: Replaced `re-search-forward' by `org-search-forward-unenclosed' where it made sense. --- lisp/org-list.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 65be37693..bb6015c2f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -807,7 +807,7 @@ Assumes cursor in item line." (cond ((and (ignore-errors (progn (org-previous-item) t)) (or (end-of-line) t) - (re-search-forward (org-item-re) bolpos t)) + (org-search-forward-unenclosed (org-item-re) bolpos t)) (setq ind-down (org-get-indentation) bullet-down (org-get-bullet))) ((and (goto-char pos) @@ -1143,7 +1143,7 @@ the whole buffer." ;; with proper limit. (goto-char (or (org-get-next-item (point) lim) lim)) (end-of-line) - (when (re-search-forward (org-item-re) lim t) + (when (org-search-forward-unenclosed (org-item-re) lim t) (beginning-of-line))) (setq next-ind (org-get-indentation))))) (goto-char continue-from) @@ -1307,7 +1307,7 @@ sublevels as a list of strings." (let* ((start (goto-char (org-list-top-point))) (end (org-list-bottom-point)) output itemsep ltype) - (while (re-search-forward (org-item-re) end t) + (while (org-search-forward-unenclosed (org-item-re) end t) (save-excursion (beginning-of-line) (cond ((looking-at-p "^[ \t]*[0-9]") From 99306969b06d4c91d0b9a0addd2ab7f0fc0bd33d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 11:46:51 +0200 Subject: [PATCH 116/348] Both latex and html should now export correctly. * org-html.el (org-export-html-preprocess): Remove unneeded insertion of list end marker, as it is now handled by `org-export-mark-list-ending'. * org-html.el (org-export-as-html): Cleaner termination of lists. * org-exp.el (org-export-mark-list-ending): New function to insert specific markers at the end of lists when exporting to a backend not using `org-list-parse-list'. This function is called early in `org-export-preprocess-string', while it is still able to recognize lists. * org-latex.el (org-export-latex-lists): Better search for lists. It now only finds items not enclosed and not protected. --- lisp/org-exp.el | 16 ++++++++++++++++ lisp/org-html.el | 27 ++++++++++----------------- lisp/org-latex.el | 27 ++++++++++++++------------- 3 files changed, 40 insertions(+), 30 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index fafdb07cb..bfa3b464e 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1076,6 +1076,9 @@ on this string to produce the exported version." (plist-get parameters :exclude-tags)) (run-hooks 'org-export-preprocess-after-tree-selection-hook) + ;; Mark end of lists + (org-export-mark-list-ending backend) + ;; Handle source code snippets (org-export-replace-src-segments-and-examples backend) @@ -1626,6 +1629,19 @@ These special cookies will later be interpreted by the backend." (delete-region beg end) (insert (org-add-props content nil 'original-indentation ind)))))) +(defun org-export-mark-list-ending (backend) + "Mark list endings with special cookies. +These special cookies will later be interpreted by the backend. +`org-list-end-re' is replaced by a blank line in the process." + ;; Backends using `org-list-parse-list' do not need this. + (unless (eq backend 'latex) + (goto-char (point-min)) + (while (org-search-forward-unenclosed (org-item-re) nil 'move) + (goto-char (org-list-bottom-point)) + (when (looking-at (org-list-end-re)) + (replace-match "\n")) + (insert "ORG-LIST-END\n")))) + (defun org-export-attach-captions-and-attributes (backend target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. If the next thing following is a table, add the text properties to the first diff --git a/lisp/org-html.el b/lisp/org-html.el index d80a852f9..694c1863a 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -561,13 +561,7 @@ This may also be a function, building and inserting the postamble.") (if (string-match "\\`[a-z]\\{1,10\\}:\\(.+\\)" label) (setq l1 (substring label (match-beginning 1))) (setq l1 label))) - (replace-match (format "[[#%s][%s]]" label l1) t t)))) - (goto-char (point-min)) - (while (org-search-forward-unenclosed (org-item-re) nil 'move) - (goto-char (org-list-bottom-point)) - (when (looking-at (org-list-end-re)) - (replace-match "")) - (insert "ORG-LIST-END\n"))) + (replace-match (format "[[#%s][%s]]" label l1) t t))))) ;;;###autoload (defun org-export-as-html-and-open (arg) @@ -1511,16 +1505,15 @@ lang=\"%s\" xml:lang=\"%s\"> (insert "<pre>") (setq inquote t))) - ((string-match "^ORG-LIST-END" line) - ;; Explicit list closure - (let ((ind (org-get-indentation line))) - (while (and local-list-indent - (<= ind (car local-list-indent))) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) - (pop local-list-indent)) - (or local-list-indent (setq in-local-list nil))) + ;; Explicit list closure + ((equal "ORG-LIST-END" line) + (while local-list-indent + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) + (pop local-list-indent)) + (setq in-local-list nil) + (org-open-par) (throw 'nextline nil)) ((and org-export-with-tables diff --git a/lisp/org-latex.el b/lisp/org-latex.el index c01ab267d..838cc68ef 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2238,19 +2238,20 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "Convert plain text lists in current buffer into LaTeX lists." (let (res) (goto-char (point-min)) - (while (org-re-search-forward-unprotected (org-item-re) nil t) - (beginning-of-line) - (setq res (org-list-to-latex (org-list-parse-list t) - org-export-latex-list-parameters)) - (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" - res) - (setq res (replace-match - (concat (format "\\setcounter{enumi}{%d}" - (1- (string-to-number - (match-string 2 res)))) - "\n" - (match-string 1 res)) - t t res))) + (while (org-search-forward-unenclosed (org-item-re) nil t) + (org-if-unprotected + (beginning-of-line) + (setq res (org-list-to-latex (org-list-parse-list t) + org-export-latex-list-parameters)) + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" + res) + (setq res (replace-match + (concat (format "\\setcounter{enumi}{%d}" + (1- (string-to-number + (match-string 2 res)))) + "\n" + (match-string 1 res)) + t t res)))) (insert res "\n")))) (defconst org-latex-entities From 4c2bc51c52292014cd7c48aacebc64a8fa11e10e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 11:54:00 +0200 Subject: [PATCH 117/348] Remove the no longer needed didclose variable. * org-html.el (org-export-as-html): Delete didclose and everything related to it, as it is no longer needed. --- lisp/org-html.el | 339 +++++++++++++++++++++++------------------------ 1 file changed, 167 insertions(+), 172 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 694c1863a..382b09f96 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -890,8 +890,8 @@ PUB-DIR is set, use this as the publishing directory." (string-match "\\S-" (plist-get opt-plist :link-up)) (plist-get opt-plist :link-up))) (link-home (and (plist-get opt-plist :link-home) - (string-match "\\S-" (plist-get opt-plist :link-home)) - (plist-get opt-plist :link-home))) + (string-match "\\S-" (plist-get opt-plist :link-home)) + (plist-get opt-plist :link-home))) (dummy (setq opt-plist (plist-put opt-plist :title title))) (html-table-tag (plist-get opt-plist :html-table-tag)) (quote-re0 (concat "^[ \t]*" org-quote-string "\\>")) @@ -960,7 +960,7 @@ PUB-DIR is set, use this as the publishing directory." "")) table-open type table-buffer table-orig-buffer - ind item-type starter didclose + ind item-type starter rpl path attr desc descp desc1 desc2 link snumber fnc item-tag initial-number footnotes footref-seen @@ -1072,73 +1072,73 @@ lang=\"%s\" xml:lang=\"%s\"> (push "<ul>\n<li>" thetoc) (setq lines (mapcar '(lambda (line) - (if (and (string-match org-todo-line-regexp line) - (not (get-text-property 0 'org-protected line))) - ;; This is a headline - (progn - (setq have-headings t) - (setq level (- (match-end 1) (match-beginning 1) - level-offset) - level (org-tr-level level) - txt (save-match-data - (org-html-expand - (org-export-cleanup-toc-line - (match-string 3 line)))) - todo - (or (and org-export-mark-todo-in-toc - (match-beginning 2) - (not (member (match-string 2 line) - org-done-keywords))) + (if (and (string-match org-todo-line-regexp line) + (not (get-text-property 0 'org-protected line))) + ;; This is a headline + (progn + (setq have-headings t) + (setq level (- (match-end 1) (match-beginning 1) + level-offset) + level (org-tr-level level) + txt (save-match-data + (org-html-expand + (org-export-cleanup-toc-line + (match-string 3 line)))) + todo + (or (and org-export-mark-todo-in-toc + (match-beginning 2) + (not (member (match-string 2 line) + org-done-keywords))) ; TODO, not DONE - (and org-export-mark-todo-in-toc - (= level umax-toc) - (org-search-todo-below - line lines level)))) - (if (string-match - (org-re "[ \t]+:\\([[:alnum:]_@#%:]+\\):[ \t]*$") txt) - (setq txt (replace-match "   <span class=\"tag\"> \\1</span>" t nil txt))) - (if (string-match quote-re0 txt) - (setq txt (replace-match "" t t txt))) - (setq snumber (org-section-number level)) - (if org-export-with-section-numbers - (setq txt (concat snumber " " txt))) - (if (<= level (max umax umax-toc)) - (setq head-count (+ head-count 1))) - (if (<= level umax-toc) - (progn - (if (> level org-last-level) - (progn - (setq cnt (- level org-last-level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "\n<ul>\n<li>" thetoc)) - (push "\n" thetoc))) - (if (< level org-last-level) - (progn - (setq cnt (- org-last-level level)) - (while (>= (setq cnt (1- cnt)) 0) - (push "</li>\n</ul>" thetoc)) - (push "\n" thetoc))) - ;; Check for targets - (while (string-match org-any-target-regexp line) - (setq line (replace-match - (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") - t t line))) - (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) - (setq txt (replace-match "" t t txt))) - (setq href - (replace-regexp-in-string - "\\." "_" (format "sec-%s" snumber))) - (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) - (push - (format - (if todo - "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" - "</li>\n<li><a href=\"#%s\">%s</a>") - href txt) thetoc) + (and org-export-mark-todo-in-toc + (= level umax-toc) + (org-search-todo-below + line lines level)))) + (if (string-match + (org-re "[ \t]+:\\([[:alnum:]_@:]+\\):[ \t]*$") txt) + (setq txt (replace-match "   <span class=\"tag\"> \\1</span>" t nil txt))) + (if (string-match quote-re0 txt) + (setq txt (replace-match "" t t txt))) + (setq snumber (org-section-number level)) + (if org-export-with-section-numbers + (setq txt (concat snumber " " txt))) + (if (<= level (max umax umax-toc)) + (setq head-count (+ head-count 1))) + (if (<= level umax-toc) + (progn + (if (> level org-last-level) + (progn + (setq cnt (- level org-last-level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "\n<ul>\n<li>" thetoc)) + (push "\n" thetoc))) + (if (< level org-last-level) + (progn + (setq cnt (- org-last-level level)) + (while (>= (setq cnt (1- cnt)) 0) + (push "</li>\n</ul>" thetoc)) + (push "\n" thetoc))) + ;; Check for targets + (while (string-match org-any-target-regexp line) + (setq line (replace-match + (concat "@<span class=\"target\">" (match-string 1 line) "@</span> ") + t t line))) + (while (string-match "<\\(<\\)+\\|>\\(>\\)+" txt) + (setq txt (replace-match "" t t txt))) + (setq href + (replace-regexp-in-string + "\\." "_" (format "sec-%s" snumber))) + (setq href (or (cdr (assoc href org-export-preferred-target-alist)) href)) + (push + (format + (if todo + "</li>\n<li><a href=\"#%s\"><span class=\"todo\">%s</span></a>" + "</li>\n<li><a href=\"#%s\">%s</a>") + href txt) thetoc) - (setq org-last-level level)) - ))) - line) + (setq org-last-level level)) + ))) + line) lines)) (while (> org-last-level (1- org-min-level)) (setq org-last-level (1- org-last-level)) @@ -1300,79 +1300,79 @@ lang=\"%s\" xml:lang=\"%s\"> desc2 (if (match-end 2) (concat type ":" path) path) descp (and desc1 (not (equal desc1 desc2))) desc (or desc1 desc2)) - ;; Make an image out of the description if that is so wanted + ;; Make an image out of the description if that is so wanted (when (and descp (org-file-image-p - desc org-export-html-inline-image-extensions)) - (save-match-data - (if (string-match "^file:" desc) - (setq desc (substring desc (match-end 0))))) - (setq desc (org-add-props + desc org-export-html-inline-image-extensions)) + (save-match-data + (if (string-match "^file:" desc) + (setq desc (substring desc (match-end 0))))) + (setq desc (org-add-props (concat "<img src=\"" desc "\"/>") '(org-protected t)))) (cond ((equal type "internal") - (let - ((frag-0 - (if (= (string-to-char path) ?#) - (substring path 1) - path))) - (setq rpl + (let + ((frag-0 + (if (= (string-to-char path) ?#) + (substring path 1) + path))) + (setq rpl (org-html-make-link - opt-plist - "" - "" - (org-solidify-link-text - (save-match-data (org-link-unescape frag-0)) - nil) - desc attr nil)))) + opt-plist + "" + "" + (org-solidify-link-text + (save-match-data (org-link-unescape frag-0)) + nil) + desc attr nil)))) ((and (equal type "id") (setq id-file (org-id-find-id-file path))) ;; This is an id: link to another file (if it was the same file, ;; it would have become an internal link...) (save-match-data (setq id-file (file-relative-name - id-file - (file-name-directory org-current-export-file))) + id-file + (file-name-directory org-current-export-file))) (setq rpl - (org-html-make-link opt-plist - "file" id-file - (concat (if (org-uuidgen-p path) "ID-") path) - desc - attr - nil)))) + (org-html-make-link opt-plist + "file" id-file + (concat (if (org-uuidgen-p path) "ID-") path) + desc + attr + nil)))) ((member type '("http" "https")) - ;; standard URL, can inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - (org-html-should-inline-p path descp)))) + ;; standard URL, can inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + (org-html-should-inline-p path descp)))) ((member type '("ftp" "mailto" "news")) - ;; standard URL, can't inline as image - (setq rpl - (org-html-make-link opt-plist - type path nil - desc - attr - nil))) + ;; standard URL, can't inline as image + (setq rpl + (org-html-make-link opt-plist + type path nil + desc + attr + nil))) ((string= type "coderef") - (let* - ((coderef-str (format "coderef-%s" path)) - (attr-1 - (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" + (let* + ((coderef-str (format "coderef-%s" path)) + (attr-1 + (format "class=\"coderef\" onmouseover=\"CodeHighlightOn(this, '%s');\" onmouseout=\"CodeHighlightOff(this, '%s');\"" coderef-str coderef-str))) - (setq rpl + (setq rpl (org-html-make-link opt-plist - type "" coderef-str - (format - (org-export-get-coderef-format - path - (and descp desc)) - (cdr (assoc path org-export-code-refs))) - attr-1 - nil)))) + type "" coderef-str + (format + (org-export-get-coderef-format + path + (and descp desc)) + (cdr (assoc path org-export-code-refs))) + attr-1 + nil)))) ((functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) ;; The link protocol has a function for format the link @@ -1381,55 +1381,55 @@ lang=\"%s\" xml:lang=\"%s\"> (funcall fnc (org-link-unescape path) desc1 'html)))) ((string= type "file") - ;; FILE link - (save-match-data - (let* - ((components - (if - (string-match "::\\(.*\\)" path) - (list - (replace-match "" t nil path) - (match-string 1 path)) - (list path nil))) + ;; FILE link + (save-match-data + (let* + ((components + (if + (string-match "::\\(.*\\)" path) + (list + (replace-match "" t nil path) + (match-string 1 path)) + (list path nil))) - ;;The proper path, without a fragment - (path-1 - (first components)) + ;;The proper path, without a fragment + (path-1 + (first components)) - ;;The raw fragment - (fragment-0 - (second components)) + ;;The raw fragment + (fragment-0 + (second components)) - ;;Check the fragment. If it can't be used as - ;;target fragment we'll pass nil instead. - (fragment-1 - (if - (and fragment-0 - (not (string-match "^[0-9]*$" fragment-0)) - (not (string-match "^\\*" fragment-0)) - (not (string-match "^/.*/$" fragment-0))) - (org-solidify-link-text - (org-link-unescape fragment-0)) - nil)) - (desc-2 - ;;Description minus "file:" and ".org" - (if (string-match "^file:" desc) - (let - ((desc-1 (replace-match "" t t desc))) - (if (string-match "\\.org$" desc-1) - (replace-match "" t t desc-1) - desc-1)) - desc))) + ;;Check the fragment. If it can't be used as + ;;target fragment we'll pass nil instead. + (fragment-1 + (if + (and fragment-0 + (not (string-match "^[0-9]*$" fragment-0)) + (not (string-match "^\\*" fragment-0)) + (not (string-match "^/.*/$" fragment-0))) + (org-solidify-link-text + (org-link-unescape fragment-0)) + nil)) + (desc-2 + ;;Description minus "file:" and ".org" + (if (string-match "^file:" desc) + (let + ((desc-1 (replace-match "" t t desc))) + (if (string-match "\\.org$" desc-1) + (replace-match "" t t desc-1) + desc-1)) + desc))) - (setq rpl - (if + (setq rpl + (if (and - (functionp link-validate) - (not (funcall link-validate path-1 current-dir))) + (functionp link-validate) + (not (funcall link-validate path-1 current-dir))) desc - (org-html-make-link opt-plist - "file" path-1 fragment-1 desc-2 attr - (org-html-should-inline-p path-1 descp))))))) + (org-html-make-link opt-plist + "file" path-1 fragment-1 desc-2 attr + (org-html-should-inline-p path-1 descp))))))) (t ;; just publish the path, as default @@ -1563,12 +1563,10 @@ lang=\"%s\" xml:lang=\"%s\"> (setq ind (if org-empty-line-terminates-plain-lists 0 (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) (while (and in-local-list (or (and (= ind (car local-list-indent)) (not starter)) (< ind (car local-list-indent)))) - (setq didclose t) (org-close-li (car local-list-type)) (insert (format "</%sl>\n" (car local-list-type))) (pop local-list-type) (pop local-list-indent) @@ -1597,17 +1595,14 @@ lang=\"%s\" xml:lang=\"%s\"> (insert (cond ((equal (car local-list-type) "d") (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) - (t "<li>\n")))) - (didclose - ;; we did close a list, normal text follows: need <p> - (org-open-par))) + (t "<li>\n"))))) (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) (setq line (replace-match (if (equal (match-string 1 line) "X") "<b>[X]</b>" "<b>[<span style=\"visibility:hidden;\">X</span>]</b>") - t t line)))) + t t line)))) ;; Horizontal line (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) From fe42a5e83ec543b8673535574e896c5b5b24f326 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 13:48:56 +0200 Subject: [PATCH 118/348] Export supports any list ender. Export to ascii has been fixed. * org-exp.el (org-export-mark-list-ending): Differentiate between export backends, and replace `org-list-end-re' by a blank line upon exporting. --- lisp/org-exp.el | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index bfa3b464e..0ed06d19d 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1633,14 +1633,25 @@ These special cookies will later be interpreted by the backend." "Mark list endings with special cookies. These special cookies will later be interpreted by the backend. `org-list-end-re' is replaced by a blank line in the process." - ;; Backends using `org-list-parse-list' do not need this. - (unless (eq backend 'latex) - (goto-char (point-min)) - (while (org-search-forward-unenclosed (org-item-re) nil 'move) - (goto-char (org-list-bottom-point)) - (when (looking-at (org-list-end-re)) - (replace-match "\n")) - (insert "ORG-LIST-END\n")))) + (let ((process-buffer + (lambda (end-list-marker) + (goto-char (point-min)) + (while (org-search-forward-unenclosed (org-item-re) nil t) + (goto-char (org-list-bottom-point)) + (when (looking-at (org-list-end-re)) + (replace-match "\n")) + (insert end-list-marker))))) + ;; We need to divide backends into 3 categories. + (cond + ;; 1. Backends using `org-list-parse-list' do not need markers. + ((memq backend '(latex)) + nil) + ;; 2. Line-processing backends need to be told where lists end. + ((memq backend '(html docbook)) + (funcall process-buffer "ORG-LIST-END\n")) + ;; 3. Others backends do not need to know this: clean list enders. + (t + (funcall process-buffer "\n"))))) (defun org-export-attach-captions-and-attributes (backend target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. From a63ecfa89b12a713e358e492665267d47532a13e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 14:40:39 +0200 Subject: [PATCH 119/348] Better handling of non-blank-lines types of list enders. * org-exp.el (org-export-mark-list-ending): fix number of blank lines inserted after a list. * org-list.el (org-list-parse-list): fix case when `org-list-end-re' would have an indentation greater than current list. --- lisp/org-exp.el | 2 +- lisp/org-list.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 0ed06d19d..2665f9641 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1651,7 +1651,7 @@ These special cookies will later be interpreted by the backend. (funcall process-buffer "ORG-LIST-END\n")) ;; 3. Others backends do not need to know this: clean list enders. (t - (funcall process-buffer "\n"))))) + (funcall process-buffer ""))))) (defun org-export-attach-captions-and-attributes (backend target-alist) "Move #+CAPTION, #+ATTR_BACKEND, and #+LABEL text into text properties. diff --git a/lisp/org-list.el b/lisp/org-list.el index bb6015c2f..67c26ec80 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1319,7 +1319,7 @@ sublevels as a list of strings." (let* ((indent1 (org-get-indentation)) (nextitem (or (org-get-next-item (point) end) end)) (item (org-trim (buffer-substring (point) (org-end-of-item-text-before-children)))) - (nextindent (org-get-indentation)) + (nextindent (if (= (point) end) 0 (org-get-indentation))) (item (if (string-match "^\\[\\([xX ]\\)\\]" item) (replace-match (if (equal (match-string 1 item) " ") "[CBOFF]" From 07eb3308c1aa32d3a7ce69e84f33eb953a99542e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 15:08:14 +0200 Subject: [PATCH 120/348] Docbook exporter now handles new list definition. * org-docbook.el (org-export-as-docbook): Properly close any open list when seeing ORG-LIST-END. Removed any reference to now unneeded DIDCLOSE variable. --- lisp/org-docbook.el | 67 ++++++++++++--------------------------------- 1 file changed, 18 insertions(+), 49 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 926db24bd..61c639f4b 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -552,7 +552,7 @@ publishing directory." (nth 2 (assoc "=" org-export-docbook-emphasis-alist))) table-open type table-buffer table-orig-buffer - ind item-type starter didclose + ind item-type starter rpl path attr caption label desc descp desc1 desc2 link fnc item-tag initial-number footref-seen footnote-list @@ -671,7 +671,21 @@ publishing directory." (org-export-docbook-open-para)) (throw 'nextline nil)) - (org-export-docbook-close-lists-maybe line) + ;; List ender: close every open list. + (when (equal "ORG-LIST-END" line) + (while local-list-type + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type)) + ;; We did close a list, normal text follows: need <para> + (org-export-docbook-open-para) + (setq local-list-indent nil + in-local-list nil) + (throw 'nextline nil)) ;; Protected HTML (when (get-text-property 0 'org-protected line) @@ -963,18 +977,6 @@ publishing directory." txt (match-string 2 line)) (if (string-match quote-re0 txt) (setq txt (replace-match "" t t txt))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) (org-export-docbook-level-start level txt) ;; QUOTES (when (string-match quote-re line) @@ -1004,6 +1006,7 @@ publishing directory." (org-export-docbook-close-para-maybe) (insert (org-export-docbook-finalize-table (org-format-table-html table-buffer table-orig-buffer))))) + (t ;; Normal lines (when (string-match @@ -1034,12 +1037,10 @@ publishing directory." (setq ind (if org-empty-line-terminates-plain-lists 0 (1+ (or (car local-list-indent) 1))))) - (setq didclose nil) (while (and in-local-list (or (and (= ind (car local-list-indent)) (not starter)) (< ind (car local-list-indent)))) - (setq didclose t) (let ((listtype (car local-list-type))) (org-export-docbook-close-li listtype) (insert (cond @@ -1089,9 +1090,6 @@ publishing directory." "???")))))) ;; For DocBook, we need to open a para right after tag ;; <listitem>. - (org-export-docbook-open-para)) - (didclose - ;; We did close a list, normal text follows: need <para> (org-export-docbook-open-para))) ;; Checkboxes. (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line) @@ -1134,18 +1132,7 @@ publishing directory." (when inquote (insert "]]></programlisting>\n") (org-export-docbook-open-para)) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) + ;; Close all open sections. (org-export-docbook-level-start 1 nil) @@ -1212,24 +1199,6 @@ publishing directory." (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -(defun org-export-docbook-close-lists-maybe (line) - (let ((ind (or (get-text-property 0 'original-indentation line))) -; (and (string-match "\\S-" line) -; (org-get-indentation line)))) - didclose) - (when ind - (while (and in-local-list - (<= ind (car local-list-indent))) - (setq didclose t) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) - (and didclose (org-export-docbook-open-para))))) (defun org-export-docbook-level-start (level title) "Insert a new level in DocBook export. From 27cfeefc3bb0357ef29b23a75c4c8b41d64dafd3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 15:11:35 +0200 Subject: [PATCH 121/348] Code cleanup. * org-html.el (org-export-as-html): Code cleanup. --- lisp/org-html.el | 55 ++++++++++-------------------------------------- 1 file changed, 11 insertions(+), 44 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 382b09f96..da0af3e97 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1181,7 +1181,16 @@ lang=\"%s\" xml:lang=\"%s\"> (org-open-par)) (throw 'nextline nil)) - ;; (org-export-html-close-lists-maybe line) + ;; Explicit list closure + (when (equal "ORG-LIST-END" line) + (while local-list-indent + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) + (pop local-list-indent)) + (setq in-local-list nil) + (org-open-par) + (throw 'nextline nil)) ;; Protected HTML (when (get-text-property 0 'org-protected line) @@ -1505,17 +1514,6 @@ lang=\"%s\" xml:lang=\"%s\"> (insert "<pre>") (setq inquote t))) - ;; Explicit list closure - ((equal "ORG-LIST-END" line) - (while local-list-indent - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) - (pop local-list-indent)) - (setq in-local-list nil) - (org-open-par) - (throw 'nextline nil)) - ((and org-export-with-tables (string-match "^\\([ \t]*\\)\\(|\\|\\+-+\\+\\)" line)) (when (not table-open) @@ -1657,14 +1655,7 @@ lang=\"%s\" xml:lang=\"%s\"> (when inquote (insert "</pre>\n") (org-open-par)) - ;; (when in-local-list - ;; ;; Close any local lists before inserting a new header line - ;; (while local-list-type - ;; (org-close-li (car local-list-type)) - ;; (insert (format "</%sl>\n" (car local-list-type))) - ;; (pop local-list-type)) - ;; (setq local-list-indent nil - ;; in-local-list nil)) + (org-html-level-start 1 nil umax (and org-export-with-toc (<= level umax)) head-count) @@ -1745,8 +1736,6 @@ lang=\"%s\" xml:lang=\"%s\"> (while (re-search-forward "<li>[ \r\n\t]*</li>\n?" nil t) (replace-match "")) (goto-char (point-min)) - ;; (while (re-search-forward "</ul>\\s-*<ul>\n?" nil t) - ;; (replace-match "")) ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end n) @@ -2267,28 +2256,6 @@ If there are links in the string, don't modify these." (defvar in-local-list) (defvar local-list-indent) (defvar local-list-type) -;; (defun org-export-html-close-lists-maybe (line) -;; "Close local lists based on the original indentation of the line." -;; (let* ((rawhtml (and in-local-list -;; (get-text-property 0 'org-protected line) -;; (not (get-text-property 0 'org-example line)))) -;; ;; rawhtml means: This was between #+begin_html..#+end_html -;; ;; originally, thus it excludes stuff that was a source code example -;; ;; Actually, this code seems wrong, I don't know why it works, but -;; ;; it seems to work.... So keep it like this for now. -;; (ind (if rawhtml -;; (org-get-indentation line) -;; (get-text-property 0 'original-indentation line))) -;; didclose) -;; (when ind -;; (while (and in-local-list -;; (<= ind (car local-list-indent))) -;; (setq didclose t) -;; (org-close-li (car local-list-type)) -;; (insert (format "</%sl>\n" (car local-list-type))) -;; (pop local-list-type) (pop local-list-indent) -;; (setq in-local-list local-list-indent)) -;; (and didclose (org-open-par))))) (defvar body-only) ; dynamically scoped into this. (defun org-html-level-start (level title umax with-toc head-count) From 37733b77a47c517d97c8fe6ece07eee1279349a8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 13 Jul 2010 15:52:11 +0200 Subject: [PATCH 122/348] List ending is now customizable. * org-list.el (org-list-end-regexp): New customizable variable to define what string should end lists. * org-list.el (org-list-end-re): Function is now aware of `org-list-end-regexp'. --- lisp/org-list.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 67c26ec80..f9b90a2ff 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -151,11 +151,19 @@ spaces instead of one after the bullet in each item of he list." (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. -Otherwise it will take two blank lines to end them." +Otherwise, look for `org-list-end-regexp'." :group 'org-plain-lists :type 'boolean) +(defcustom org-list-end-regexp "^[ \t]*\n\\([ \t]*\n\\)+" + "Regexp matching the end of all plain list levels. +It must start with \"^\" and end with \"\\n\". It defaults to 2 +or more blank lines. `org-empty-line-terminates-plain-lists' has +precedence over it." + :group 'org-plain-lists + :type 'string) + (defcustom org-auto-renumber-ordered-lists t "Non-nil means automatically renumber ordered plain lists. Renumbering happens when the sequence have been changed with @@ -220,8 +228,8 @@ list, obtained by prompting the user." "Return the regex corresponding to the end of a list. It depends on `org-empty-line-terminates-plain-lists'." (if org-empty-line-terminates-plain-lists - "^\\([ \t]*\n\\)+" - "^[ \t]*\n\\([ \t]*\n\\)+")) + "^[ \t]*\n" + org-list-end-regexp)) (defun org-item-re (&optional general) "Return the correct regular expression for plain lists. From 0c4770e66144d86792061dc4f35cf02d2084eff0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 09:08:39 +0200 Subject: [PATCH 123/348] Refactoring. * org-list.el (org-insert-item): Simplify count of blank lines to insert. --- lisp/org-list.el | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index f9b90a2ff..d8f5e81df 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -631,25 +631,25 @@ block, or item is invisible." (timer-p (and description-p (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$" description-p))) ;; Guess number of blank lines used to separate items. - (blank-lines-nb (let* ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry))) - (limit (save-excursion (org-end-of-item-list))) - (next-item-p (org-get-next-item (point) limit))) + (blank-lines-nb (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry)))) (cond - ;; cases where there should be no blank line. - ((or (not insert-blank-p) - org-empty-line-terminates-plain-lists) 0) - ;; If there's a next item, count blank - ;; lines between current and next item. - (next-item-p (and (goto-char next-item-p) - (org-back-over-empty-lines))) - ;; if we're not on the first item, there - ;; is one above. Count blank lines between. - ((not (org-first-list-item-p)) (org-back-over-empty-lines)) - ;; Only one item list: can't guess. - ;; Follow `org-blank-before-new-entry' - ((eq insert-blank-p 'auto) 0) - (t 1)))) + ((or + org-empty-line-terminates-plain-lists + (not insert-blank-p)) + 0) + ((eq insert-blank-p t) 1) + ;; plain-list-item is 'auto. Count blank + ;; lines separating items in list. + (t + (save-excursion + (if (progn + (org-end-of-item-list) + (skip-chars-backward " \r\t\n") + (org-search-backward-unenclosed + "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) + (1+ (org-back-over-empty-lines)) + 0)))))) (insert-fun (lambda (&optional string-after-bullet) ;; insert bullet above item in order to avoid ;; bothering with possible blank lines ending From 197ed8b273c32f4715fd21a93bf3db767b845ad8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 09:28:40 +0200 Subject: [PATCH 124/348] Remove useless checks for `org-empty-line-terminates-plain-lists'. * org-docbook.el (org-export-as-docbook): When we find an empty line, we do not need to check for `org-empty-line-terminates-plain-lists' because we would have found end-list marker before. * org-html.el (org-export-as-html): Same. --- lisp/org-docbook.el | 4 +--- lisp/org-html.el | 4 +--- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 61c639f4b..ab2dfd6d9 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1034,9 +1034,7 @@ publishing directory." (when (and (not (equal item-type "d")) (not (string-match "[^ \t]" line))) ;; Empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) + (setq ind (1+ (or (car local-list-indent) 1)))) (while (and in-local-list (or (and (= ind (car local-list-indent)) (not starter)) diff --git a/lisp/org-html.el b/lisp/org-html.el index da0af3e97..60b4b9664 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1558,9 +1558,7 @@ lang=\"%s\" xml:lang=\"%s\"> (when (and (not (equal item-type "d")) (not (string-match "[^ \t]" line))) ;; empty line. Pretend indentation is large. - (setq ind (if org-empty-line-terminates-plain-lists - 0 - (1+ (or (car local-list-indent) 1))))) + (setq ind (1+ (or (car local-list-indent) 1)))) (while (and in-local-list (or (and (= ind (car local-list-indent)) (not starter)) From b2433f9eb61e97f401caad06caf5eb37d5a14304 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 09:31:12 +0200 Subject: [PATCH 125/348] Changed default for end-list regexp. * lisp/org-list.el (org-list-end-regexp): By default, list ending is exactly 2 blank lines. --- lisp/org-list.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index d8f5e81df..f6907ba18 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -156,10 +156,10 @@ Otherwise, look for `org-list-end-regexp'." :group 'org-plain-lists :type 'boolean) -(defcustom org-list-end-regexp "^[ \t]*\n\\([ \t]*\n\\)+" +(defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n" "Regexp matching the end of all plain list levels. It must start with \"^\" and end with \"\\n\". It defaults to 2 -or more blank lines. `org-empty-line-terminates-plain-lists' has +blank lines. `org-empty-line-terminates-plain-lists' has precedence over it." :group 'org-plain-lists :type 'string) From 968fa927c47afd69eb9b2f37f0fc7de998022978 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 11:11:10 +0200 Subject: [PATCH 126/348] Fix for org-list-send-list. * org-list.el (org-in-item-p): Do not widen before checking if we are in item. * org-list.el (org-list-send-list): We cannot count on `org-list-top-point' and `org-list-bottom-point' before buffer is narrowed. Find bounds of list otherwise. --- lisp/org-list.el | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index f6907ba18..3a00c2c4e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -335,21 +335,19 @@ Internal use only. Prefer `org-get-next-item' and (defun org-in-item-p () "Is the cursor inside a plain list ?" - (save-restriction - (save-excursion - (widen) - ;; we move to eol so that the current line can be matched by - ;; `org-item-re'. - (let* ((limit (or (save-excursion (outline-previous-heading)) (point-min))) - (actual-pos (goto-char (point-at-eol))) - (last-item-start (save-excursion - (org-search-backward-unenclosed (org-item-re) limit))) - (list-ender (org-list-terminator-between last-item-start actual-pos))) - ;; We are in a list when we are on an item line or we can find - ;; an item before and there is no valid list ender between us - ;; and the item found. - (and last-item-start - (not list-ender)))))) + (save-excursion + ;; we move to eol so that the current line can be matched by + ;; `org-item-re'. + (let* ((limit (or (save-excursion (outline-previous-heading)) (point-min))) + (actual-pos (goto-char (point-at-eol))) + (last-item-start (save-excursion + (org-search-backward-unenclosed (org-item-re) limit))) + (list-ender (org-list-terminator-between last-item-start actual-pos))) + ;; We are in a list when we are on an item line or we can find + ;; an item before and there is no valid list ender between us + ;; and the item found. + (and last-item-start + (not list-ender))))) (defun org-first-list-item-p () "Is this heading the first item in a plain list?" @@ -1395,19 +1393,22 @@ this list." (catch 'exit (unless (org-at-item-p) (error "Not at a list")) (save-excursion - (goto-char (org-list-top-point)) - (beginning-of-line 0) + (re-search-backward "#\\+ORGLST" nil t) (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") (if maybe (throw 'exit nil) (error "Don't know how to transform this list")))) (let* ((name (match-string 1)) (transform (intern (match-string 2))) - (top-point (org-list-top-point)) (bottom-point (save-excursion - (goto-char (org-list-bottom-point)) - (re-search-backward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" top-point t))) + (re-search-forward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) + (match-beginning 0))) + (top-point + (progn + (re-search-backward "#\\+ORGLST" nil t) + (re-search-forward (org-item-re) bottom-point t) + (match-beginning 0))) (list (save-restriction (narrow-to-region top-point bottom-point) (org-list-parse-list))) From 168a8b60072a0b5edc73fb49cc740d7f586ddeb7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 14:07:56 +0200 Subject: [PATCH 127/348] Do not prevent list items from being inside LaTeX blocks. * org-list.el (org-search-backward-unenclosed): Do not prevent list items from being inside LaTeX blocks. * org-list.el (org-search-forward-unenclosed): Do not prevent list items from being inside LaTeX blocks. --- lisp/org-list.el | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 3a00c2c4e..7bc86da6e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -276,10 +276,8 @@ valid or not, then makes sure the last one is valid." ((not (re-search-backward regexp bound (or noerror t) count)) nil) ;; match is not enclosed: return point. ((not (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z0-9_]+\\)}" - '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))))) + (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))) (point)) (t ;; else: we start again, searching one more occurrence away. @@ -297,10 +295,8 @@ valid or not, then makes sure the last one is valid." ((not (re-search-forward regexp bound (or noerror t) count)) nil) ;; match is not enclosed: return point. ((not (save-match-data - (or (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z0-9_]+\\)}" - '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))))) + (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))) (point)) ;; else: we start again, searching one more occurrence away. (t From 47cd0c193de0f10c32230df726e8255c25f647b4 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 15:40:12 +0200 Subject: [PATCH 128/348] Make parsing of lists more powerful during export. * org-list.el (org-search-backward-unenclosed): Do not stop in protected places. * org-list.el (org-search-forward-unenclosed): Do not stop in protected places. * org-latex.el (org-export-latex-lists): Use the fact that org-search-forward do not stop anymore at protected places. --- lisp/org-latex.el | 25 ++++++++++++------------- lisp/org-list.el | 47 +++++++++++++++++++++++++++-------------------- 2 files changed, 39 insertions(+), 33 deletions(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 838cc68ef..b7b4f39b8 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2239,19 +2239,18 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (let (res) (goto-char (point-min)) (while (org-search-forward-unenclosed (org-item-re) nil t) - (org-if-unprotected - (beginning-of-line) - (setq res (org-list-to-latex (org-list-parse-list t) - org-export-latex-list-parameters)) - (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" - res) - (setq res (replace-match - (concat (format "\\setcounter{enumi}{%d}" - (1- (string-to-number - (match-string 2 res)))) - "\n" - (match-string 1 res)) - t t res)))) + (beginning-of-line) + (setq res (org-list-to-latex (org-list-parse-list t) + org-export-latex-list-parameters)) + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" + res) + (setq res (replace-match + (concat (format "\\setcounter{enumi}{%d}" + (1- (string-to-number + (match-string 2 res)))) + "\n" + (match-string 1 res)) + t t res))) (insert res "\n")))) (defconst org-latex-entities diff --git a/lisp/org-list.el b/lisp/org-list.el index 7bc86da6e..158f4f179 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -266,26 +266,31 @@ the end of the nearest terminator from max." (match-beginning 0))))) (defun org-search-backward-unenclosed (regexp &optional bound noerror count) - "Like `re-search-backward' but don't stop inside blocks or throw errors. + "Like `re-search-backward' but don't stop inside blocks or at protected places. +This function does not throw errors. -Optional fourth argument COUNT searches for that many occurrences, -valid or not, then makes sure the last one is valid." +Optional fourth argument COUNT searches for that many +occurrences, valid or not, then makes sure the last one is +valid." (let ((origin (point))) (cond ;; nothing found: return nil ((not (re-search-backward regexp bound (or noerror t) count)) nil) - ;; match is not enclosed: return point. - ((not (save-match-data - (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))) - (point)) - (t - ;; else: we start again, searching one more occurrence away. + ;; match is enclosed or protected: start again, searching one + ;; more occurrence away. + ((or (save-match-data + (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) + (get-text-property (match-beginning 0) 'org-protected)) (goto-char origin) - (org-search-backward-unenclosed regexp bound noerror (1+ (or count 1))))))) + (org-search-backward-unenclosed regexp bound noerror (1+ (or count 1)))) + ;; else return point. + (t + (point))))) (defun org-search-forward-unenclosed (regexp &optional bound noerror count) - "Like `re-search-forward' but don't stop inside blocks or throw errors. + "Like `re-search-forward' but don't stop inside blocks or at protected places. +This function does not throw errors. Optional fourth argument COUNT searches for that many occurrences, valid or not, then makes sure the last one is valid." @@ -293,15 +298,17 @@ valid or not, then makes sure the last one is valid." (cond ;; nothing found: return nil ((not (re-search-forward regexp bound (or noerror t) count)) nil) - ;; match is not enclosed: return point. - ((not (save-match-data - (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))) - (point)) - ;; else: we start again, searching one more occurrence away. - (t + ;; match is enclosed or protected: start again, searching one + ;; more occurrence away. + ((or (save-match-data + (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) + (get-text-property (match-beginning 0) 'org-protected)) (goto-char origin) - (org-search-forward-unenclosed regexp bound noerror (1+ (or count 1))))))) + (org-search-forward-unenclosed regexp bound noerror (1+ (or count 1)))) + ;; else return point. + (t + (point))))) (defun org-get-item-same-level-internal (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. From 292b52f59627ed6e6d702228fac7207519e3dcc7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 15:41:46 +0200 Subject: [PATCH 129/348] Insert item even in LaTeX environments. * org-list.el (org-insert-item): Remove restriction on latex blocks. --- lisp/org-list.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 158f4f179..a90671b5c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -618,9 +618,7 @@ block, or item is invisible." (unless (or (not (org-in-item-p)) (org-invisible-p) (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" - '(concat "^[ \t]*#\\+end_" (match-string 1))) - (org-in-regexps-block-p "^[ \t]*\\\\begin{\\([a-zA-Z]\\)}" - '(concat "^[ \t]*\\\\end{" (match-string 1) "}"))) + '(concat "^[ \t]*#\\+end_" (match-string 1)))) (let* ((pos (point)) (before-p (and (org-at-item-p) (<= (point) (match-end 0)))) From 2b8aa4c406da584ae8723cea40cd27f7970f3428 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 16:31:01 +0200 Subject: [PATCH 130/348] Position items with relative timer at the right place. * org-timer.el (org-timer-item): Insert description list item at the right column. * org-list.el (org-insert-item): Insert the right number of blank lines before a relative timer. --- lisp/org-list.el | 8 ++++++-- lisp/org-timer.el | 13 +++++-------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a90671b5c..c0cb073cb 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -664,8 +664,12 @@ block, or item is invisible." (unless before-p (org-move-item-down))))) (goto-char pos) (cond - ;; if we're adding a timer, delegate to `org-timer-item'. - (timer-p (org-timer-item) t) + ;; if we're adding a timer, delegate to `org-timer-item' after + ;; inserting a coherent number of blank lines. + (timer-p + (newline (1+ blank-lines-nb)) + (org-timer-item) + t) (before-p (funcall insert-fun) ;; Renumber in this case, as we're not moving down. diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 2e70fdf39..94319e73f 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -195,14 +195,11 @@ that was not started at the correct moment." (defun org-timer-item (&optional arg) "Insert a description-type item with the current timer value." (interactive "P") - (let ((ind 0)) - (save-excursion - (skip-chars-backward " \n\t") - (condition-case nil - (progn - (org-beginning-of-item) - (setq ind (org-get-indentation))) - (error nil))) + (let ((ind (save-excursion + (if (not (org-in-item-p)) + (org-indent-line-function) + (org-beginning-of-item) + (org-get-indentation))))) (or (bolp) (newline)) (org-indent-line-to ind) (insert "- ") From 2e4e05b3d6b3a8ba441e079371d8959ec57e67f3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 16:37:24 +0200 Subject: [PATCH 131/348] Minor refactoring. * lisp/org-list.el: Minor refactoring. --- lisp/org-list.el | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c0cb073cb..4603f45b7 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -319,11 +319,11 @@ Internal use only. Prefer `org-get-next-item' and `org-get-previous-item' for cleaner code." (save-excursion (when pos (goto-char pos)) - (let* ((begin (point)) - (ind (progn - (org-beginning-of-item) - (org-get-indentation))) - (start (point-at-bol))) + (let ((begin (point)) + (ind (progn + (org-beginning-of-item) + (org-get-indentation))) + (start (point-at-bol))) ;; we don't want to match the current line. (funcall pre-move) ;; we skip any sublist on the way @@ -668,8 +668,7 @@ block, or item is invisible." ;; inserting a coherent number of blank lines. (timer-p (newline (1+ blank-lines-nb)) - (org-timer-item) - t) + (org-timer-item) t) (before-p (funcall insert-fun) ;; Renumber in this case, as we're not moving down. From 2dd3b8a2a8e31c8c4a6e4b26708d436d1e79d8fa Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 21:31:50 +0200 Subject: [PATCH 132/348] Better support for timer lists. Trying to insert a new item with point in a special block now move before block. * org-list.el (org-insert-item): Move before any special block in a list prior to add a new item. * org-timer.el (org-timer-item): When in a timer list, insert a new timer item like `org-insert-item'. If in another list, send an error. Otherwise, start a new timer list. --- lisp/org-list.el | 158 ++++++++++++++++++++++++---------------------- lisp/org-timer.el | 71 ++++++++++++++++++--- 2 files changed, 145 insertions(+), 84 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 4603f45b7..56da14147 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -613,82 +613,90 @@ so this really moves item trees." If cursor is before first character after bullet of the item, the new item will be created before the current one. Return t when -things worked, nil when we are not in an item, or we are inside a -block, or item is invisible." +things worked, nil when we are not in an item, or item is +invisible." (unless (or (not (org-in-item-p)) - (org-invisible-p) - (org-in-regexps-block-p "^[ \t]*#\\+begin_\\([a-zA-Z]\\)" - '(concat "^[ \t]*#\\+end_" (match-string 1)))) - (let* ((pos (point)) - (before-p (and (org-at-item-p) - (<= (point) (match-end 0)))) - (item-start (org-beginning-of-item)) - (bullet-init (and (looking-at (org-item-re)) - (match-string 0))) - (description-p (and (looking-at "[ \t]*\\(.*?\\) ::") - (match-string 1))) - (timer-p (and description-p - (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$" description-p))) - ;; Guess number of blank lines used to separate items. - (blank-lines-nb (let ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) - (cond - ((or - org-empty-line-terminates-plain-lists - (not insert-blank-p)) - 0) - ((eq insert-blank-p t) 1) - ;; plain-list-item is 'auto. Count blank - ;; lines separating items in list. - (t - (save-excursion - (if (progn - (org-end-of-item-list) - (skip-chars-backward " \r\t\n") - (org-search-backward-unenclosed - "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) - (1+ (org-back-over-empty-lines)) - 0)))))) - (insert-fun (lambda (&optional string-after-bullet) - ;; insert bullet above item in order to avoid - ;; bothering with possible blank lines ending - ;; last item - (org-beginning-of-item) - (insert (concat bullet-init - (when checkbox "[ ] ") - (when (and description-p (not timer-p)) - (concat (read-string "Term: ") " :: ")))) - (save-excursion - (insert (concat string-after-bullet - (make-string (1+ blank-lines-nb) ?\n)))) - (unless before-p (org-move-item-down))))) - (goto-char pos) - (cond - ;; if we're adding a timer, delegate to `org-timer-item' after - ;; inserting a coherent number of blank lines. - (timer-p - (newline (1+ blank-lines-nb)) - (org-timer-item) t) - (before-p - (funcall insert-fun) - ;; Renumber in this case, as we're not moving down. - (org-maybe-renumber-ordered-list) t) - ;; if we can't split item, just insert bullet at the end of - ;; item. - ((not (org-get-alist-option org-M-RET-may-split-line 'item)) - (funcall insert-fun) t) - ;; else, insert a new bullet along with everything from point - ;; down to last non-blank line of item - (t - (delete-horizontal-space) - ;; get pos again in case previous command changed line. - (let* ((pos (point)) - (end-before-blank (org-end-of-item-before-blank)) - (after-bullet (when (< pos end-before-blank) - (prog1 - (buffer-substring pos end-before-blank) - (delete-region pos end-before-blank))))) - (funcall insert-fun after-bullet) t)))))) + (org-invisible-p)) + ;; Timer list: delegate to `org-timer-item'. + (if (save-excursion + (org-beginning-of-item) + (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::")) + (progn + (org-timer-item) t) + ;; else check if we're in a special block. If so, move before it + ;; prior to add a new item. + (when (org-in-regexps-block-p + "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) + ;; in case we're on the #+begin line + (end-of-line) + (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)" nil t) + (end-of-line 0)) + (let ((pos (point)) + (before-p (and (org-at-item-p) + (<= (point) (match-end 0)))) + (item-start (org-beginning-of-item)) + (bullet-init (and (looking-at (org-item-re)) + (match-string 0))) + (description-p (and (looking-at "[ \t]*\\(.*?\\) ::") + (match-string 1))) + ;; Guess number of blank lines used to separate items. + (blank-lines-nb + (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry)))) + (cond + ((or + org-empty-line-terminates-plain-lists + (not insert-blank-p)) + 0) + ((eq insert-blank-p t) 1) + ;; plain-list-item is 'auto. Count blank + ;; lines separating items in list. + (t + (save-excursion + (if (progn + (org-end-of-item-list) + (skip-chars-backward " \r\t\n") + (org-search-backward-unenclosed + "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) + (1+ (org-back-over-empty-lines)) + 0)))))) + (insert-fun + (lambda (&optional string-after-bullet) + ;; insert bullet above item in order to avoid + ;; bothering with possible blank lines ending + ;; last item + (org-beginning-of-item) + (insert (concat bullet-init + (when checkbox "[ ] ") + (when description-p + (concat (read-string "Term: ") " :: ")))) + (save-excursion + (insert (concat string-after-bullet + (make-string (1+ blank-lines-nb) ?\n)))) + (unless before-p (org-move-item-down))))) + (goto-char pos) + (cond + (before-p + (funcall insert-fun) + ;; Renumber in this case, as we're not moving down. + (org-maybe-renumber-ordered-list) t) + ;; if we can't split item, just insert bullet at the end of + ;; item. + ((not (org-get-alist-option org-M-RET-may-split-line 'item)) + (funcall insert-fun) t) + ;; else, insert a new bullet along with everything from point + ;; down to last non-blank line of item + (t + (delete-horizontal-space) + ;; get pos again in case previous command changed line. + (let* ((pos (point)) + (end-before-blank (org-end-of-item-before-blank)) + (after-bullet (when (< pos end-before-blank) + (prog1 + (buffer-substring pos end-before-blank) + (delete-region pos end-before-blank))))) + (funcall insert-fun after-bullet) t))))))) ;;; Indentation diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 94319e73f..3b3ced2e1 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -195,16 +195,69 @@ that was not started at the correct moment." (defun org-timer-item (&optional arg) "Insert a description-type item with the current timer value." (interactive "P") - (let ((ind (save-excursion - (if (not (org-in-item-p)) - (org-indent-line-function) - (org-beginning-of-item) - (org-get-indentation))))) - (or (bolp) (newline)) - (org-indent-line-to ind) - (insert "- ") + (cond + ;; If we are in a timer list, insert item like `org-insert-item'. + ((and (org-in-item-p) + (save-excursion + (org-beginning-of-item) + (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::"))) + (let ((pos (point)) + (before-p (and (org-at-item-p) + (<= (point) (match-end 0)))) + (item-start (org-beginning-of-item)) + (bullet-init (and (looking-at (org-item-re)) + (match-string 0))) + (blank-lines-nb + (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry)))) + (cond + ((or org-empty-line-terminates-plain-lists + (not insert-blank-p)) + 0) + ((eq insert-blank-p t) 1) + (t + (save-excursion + (if (progn + (org-end-of-item-list) + (skip-chars-backward " \r\t\n") + (org-search-backward-unenclosed + "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) + (1+ (org-back-over-empty-lines)) + 0)))))) + (insert-fun + (lambda (&optional string-after-bullet) + (org-beginning-of-item) + (insert bullet-init) + (org-timer (if arg '(4))) + (insert ":: ") + (save-excursion + (insert (concat string-after-bullet + (make-string (1+ blank-lines-nb) ?\n)))) + (unless before-p (org-move-item-down))))) + (goto-char pos) + (cond + (before-p (funcall insert-fun)) + ((not (org-get-alist-option org-M-RET-may-split-line 'item)) + (funcall insert-fun)) + (t + (delete-horizontal-space) + (let* ((pos (point)) + (end-before-blank (org-end-of-item-before-blank)) + (after-bullet (when (< pos end-before-blank) + (prog1 + (buffer-substring pos end-before-blank) + (delete-region pos end-before-blank))))) + (funcall insert-fun after-bullet) t))))) + ;; We are still are in a list, of a wrong type: throw an error. + ((org-in-item-p) + (error "This is not a timer list")) + ;; Else, go to beginning of line, and insert the timer + (t + (beginning-of-line) + (org-indent-line-function) + (insert "- ") (org-timer (if arg '(4))) - (insert ":: "))) + (insert ":: ")))) (defun org-timer-fix-incomplete (hms) "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." From 430279f2cfb54b0636c620d3734fb30d5159e60c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 21:39:21 +0200 Subject: [PATCH 133/348] Added information on timer lists. --- doc/org.texi | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/doc/org.texi b/doc/org.texi index 4ce32ce47..ca7eab60a 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -5851,7 +5851,8 @@ restarted. @kindex C-c C-x - @item C-c C-x - Insert a description list item with the current relative time. With a prefix -argument, first reset the timer to 0. +argument, first reset the timer to 0. This will not work if the cursor is +already in a list of a different type. @kindex M-@key{RET} @item M-@key{RET} Once the timer list is started, you can also use @kbd{M-@key{RET}} to insert From 7a17a37580eeec86b9916336ef9d0326414979d8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 14 Jul 2010 21:49:15 +0200 Subject: [PATCH 134/348] Reverting info changes. --- doc/org.texi | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index ca7eab60a..4ce32ce47 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -5851,8 +5851,7 @@ restarted. @kindex C-c C-x - @item C-c C-x - Insert a description list item with the current relative time. With a prefix -argument, first reset the timer to 0. This will not work if the cursor is -already in a list of a different type. +argument, first reset the timer to 0. @kindex M-@key{RET} @item M-@key{RET} Once the timer list is started, you can also use @kbd{M-@key{RET}} to insert From 1f41236014a4f25c70689defd6cd82583cc9e1d7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 15 Jul 2010 12:18:25 +0200 Subject: [PATCH 135/348] Cycle lists properly. * org-list.el (org-list-bottom-point): Be sure to check real ORG-OUTLINE-REGEXP and not outline-regexp, that might be modified. * org.el (org-cycle-internal-local): cycle up to end of subtree or end of item if we are in a list. --- lisp/org-list.el | 5 ++++- lisp/org.el | 17 +++++++++-------- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 56da14147..efbfbc8d6 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -421,7 +421,10 @@ A checkbox is blocked if all of the following conditions are fulfilled: (save-excursion (and (org-in-item-p) (let ((pos (org-beginning-of-item)) - (bound (or (and (outline-next-heading) + (bound (or (and (let ((outline-regexp org-outline-regexp)) + ;; we need set the default regexp + ;; because folding change its value. + (outline-next-heading)) (skip-chars-backward " \t\r\n") (1+ (point-at-eol))) (point-max)))) diff --git a/lisp/org.el b/lisp/org.el index f66677570..041a85b29 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5900,12 +5900,13 @@ in special contexts. (outline-next-heading) (setq has-children (and (org-at-heading-p t) (> (funcall outline-level) level)))) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - ) - (setq eos (if (eobp) (point) (1- (point))))) + ;; if we're in a list, org-end-of-subtree is in fact org-end-of-item. + (if (org-at-item-p) + (setq eos (1- (org-end-of-item))) + (org-end-of-subtree t) + (unless (eobp) + (skip-chars-forward " \t\n")) + (setq eos (if (eobp) (point) (1- (point)))))) ;; Find out what to do next and set `this-command' (cond ((= eos eoh) @@ -5939,14 +5940,14 @@ in special contexts. ;; We just showed the children, or no children are there, ;; now show everything. (run-hook-with-args 'org-pre-cycle-hook 'subtree) - (org-show-subtree) + (outline-flag-region eoh eos nil) (message (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) (setq org-cycle-subtree-status 'subtree) (run-hook-with-args 'org-cycle-hook 'subtree)) (t ;; Default action: hide the subtree. (run-hook-with-args 'org-pre-cycle-hook 'folded) - (hide-subtree) + (outline-flag-region eoh eos t) (message "FOLDED") (setq org-cycle-subtree-status 'folded) (run-hook-with-args 'org-cycle-hook 'folded))))) From 472579fb96dd7e14e6f137fafb2ed8a1ed19497e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 15 Jul 2010 16:57:37 +0200 Subject: [PATCH 136/348] Minor refactoring. --- lisp/org-list.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index efbfbc8d6..404ab50c5 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -624,8 +624,7 @@ invisible." (if (save-excursion (org-beginning-of-item) (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::")) - (progn - (org-timer-item) t) + (progn (org-timer-item) t) ;; else check if we're in a special block. If so, move before it ;; prior to add a new item. (when (org-in-regexps-block-p From 8eece59f9e635a397f3c1338fb9b65abd3d6e935 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 15 Jul 2010 18:28:01 +0200 Subject: [PATCH 137/348] Refactoring and increased protection on item insertion. * org-list.el (org-insert-item-internal): New function to handle positionning and contents of an item being inserted at a specific pos. It is not possible anymore to split a term in a description list or a checkbox when inserting a new item. * org-list.el (org-insert-item): Refactored by using the new `org-insert-item-internal' function. * org-timer.el (org-timer-item): Refactored by using the new `org-insert-item-internal' function. --- lisp/org-list.el | 170 ++++++++++++++++++++++++++-------------------- lisp/org-timer.el | 50 +------------- 2 files changed, 99 insertions(+), 121 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 404ab50c5..d7a598d46 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -334,6 +334,95 @@ Internal use only. Prefer `org-get-next-item' and (= (org-get-indentation) ind)) (point-at-bol))))) +(defun org-insert-item-internal (pos &optional checkbox after-bullet) + "Insert a new item in a list. + +If POS is before first character after bullet of the item, the +new item will be created before the current one. + +Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET +after the bullet. Cursor will be after this text once the +function end." + (goto-char pos) + ;; Check if we're in a special block. If so, move before it prior to + ;; add a new item. + (when (org-in-regexps-block-p + "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" + '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) + ;; in case we're on the #+begin line + (end-of-line) + (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) + (end-of-line 0)) + (let* ((true-pos (point)) + (item-start (org-beginning-of-item)) + (bullet-init (and (looking-at (org-item-re)) + (match-string 0))) + (before-p (progn + ;; In a descriptive list, text starts after the double colon + (or (looking-at ".*::[ \t]+") + ;; if at a checkbox, text starts after it. + (org-at-item-checkbox-p) + ;; otherwise, text starts after bullet. + (org-at-item-p)) + (< true-pos (match-end 0)))) + ;; Guess number of blank lines used to separate items. + (blank-lines-nb + (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry)))) + (cond + ((or + org-empty-line-terminates-plain-lists + (not insert-blank-p)) + 0) + ((eq insert-blank-p t) 1) + ;; plain-list-item is 'auto. Count blank + ;; lines separating items in list. + (t + (save-excursion + (if (progn + (org-end-of-item-list) + (skip-chars-backward " \r\t\n") + (org-search-backward-unenclosed + "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) + (1+ (org-back-over-empty-lines)) + 0)))))) + (insert-fun + (lambda (&optional text) + ;; insert bullet above item in order to avoid + ;; bothering with possible blank lines ending + ;; last item + (org-beginning-of-item) + (insert (concat bullet-init + (when checkbox "[ ] ") + after-bullet)) + (save-excursion + (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) + (unless before-p (org-move-item-down)) + (when checkbox (org-update-checkbox-count-maybe))))) + (goto-char true-pos) + (cond + (before-p + (funcall insert-fun) + ;; we're not moving down, but we still need a potential + ;; renumbering. + (org-maybe-renumber-ordered-list) t) + ;; if we can't split item, just insert bullet at the end of + ;; item. + ((not (org-get-alist-option org-M-RET-may-split-line 'item)) + (funcall insert-fun) t) + ;; else, insert a new bullet along with everything from point + ;; down to last non-blank line of item + (t + (delete-horizontal-space) + ;; get pos again in case previous command changed line. + (let* ((pos (point)) + (end-before-blank (org-end-of-item-before-blank)) + (after-text (when (< pos end-before-blank) + (prog1 + (buffer-substring pos end-before-blank) + (delete-region pos end-before-blank))))) + (funcall insert-fun after-text) t))))) + ;;; Predicates (defun org-in-item-p () @@ -625,80 +714,13 @@ invisible." (org-beginning-of-item) (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::")) (progn (org-timer-item) t) - ;; else check if we're in a special block. If so, move before it - ;; prior to add a new item. - (when (org-in-regexps-block-p - "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) - ;; in case we're on the #+begin line - (end-of-line) - (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)" nil t) - (end-of-line 0)) - (let ((pos (point)) - (before-p (and (org-at-item-p) - (<= (point) (match-end 0)))) - (item-start (org-beginning-of-item)) - (bullet-init (and (looking-at (org-item-re)) - (match-string 0))) - (description-p (and (looking-at "[ \t]*\\(.*?\\) ::") - (match-string 1))) - ;; Guess number of blank lines used to separate items. - (blank-lines-nb - (let ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) - (cond - ((or - org-empty-line-terminates-plain-lists - (not insert-blank-p)) - 0) - ((eq insert-blank-p t) 1) - ;; plain-list-item is 'auto. Count blank - ;; lines separating items in list. - (t - (save-excursion - (if (progn - (org-end-of-item-list) - (skip-chars-backward " \r\t\n") - (org-search-backward-unenclosed - "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) - (1+ (org-back-over-empty-lines)) - 0)))))) - (insert-fun - (lambda (&optional string-after-bullet) - ;; insert bullet above item in order to avoid - ;; bothering with possible blank lines ending - ;; last item - (org-beginning-of-item) - (insert (concat bullet-init - (when checkbox "[ ] ") - (when description-p - (concat (read-string "Term: ") " :: ")))) - (save-excursion - (insert (concat string-after-bullet - (make-string (1+ blank-lines-nb) ?\n)))) - (unless before-p (org-move-item-down))))) - (goto-char pos) - (cond - (before-p - (funcall insert-fun) - ;; Renumber in this case, as we're not moving down. - (org-maybe-renumber-ordered-list) t) - ;; if we can't split item, just insert bullet at the end of - ;; item. - ((not (org-get-alist-option org-M-RET-may-split-line 'item)) - (funcall insert-fun) t) - ;; else, insert a new bullet along with everything from point - ;; down to last non-blank line of item - (t - (delete-horizontal-space) - ;; get pos again in case previous command changed line. - (let* ((pos (point)) - (end-before-blank (org-end-of-item-before-blank)) - (after-bullet (when (< pos end-before-blank) - (prog1 - (buffer-substring pos end-before-blank) - (delete-region pos end-before-blank))))) - (funcall insert-fun after-bullet) t))))))) + ;; if we're in a description list, ask for the new term. + (let ((desc-text (when (save-excursion + (and (org-beginning-of-item) + (looking-at "[ \t]*\\(.*?\\) ::") + (match-string 1))) + (concat (read-string "Term: ") " :: ")))) + (org-insert-item-internal (point) checkbox desc-text))))) ;;; Indentation diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 3b3ced2e1..d51140634 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -201,53 +201,9 @@ that was not started at the correct moment." (save-excursion (org-beginning-of-item) (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::"))) - (let ((pos (point)) - (before-p (and (org-at-item-p) - (<= (point) (match-end 0)))) - (item-start (org-beginning-of-item)) - (bullet-init (and (looking-at (org-item-re)) - (match-string 0))) - (blank-lines-nb - (let ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) - (cond - ((or org-empty-line-terminates-plain-lists - (not insert-blank-p)) - 0) - ((eq insert-blank-p t) 1) - (t - (save-excursion - (if (progn - (org-end-of-item-list) - (skip-chars-backward " \r\t\n") - (org-search-backward-unenclosed - "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) - (1+ (org-back-over-empty-lines)) - 0)))))) - (insert-fun - (lambda (&optional string-after-bullet) - (org-beginning-of-item) - (insert bullet-init) - (org-timer (if arg '(4))) - (insert ":: ") - (save-excursion - (insert (concat string-after-bullet - (make-string (1+ blank-lines-nb) ?\n)))) - (unless before-p (org-move-item-down))))) - (goto-char pos) - (cond - (before-p (funcall insert-fun)) - ((not (org-get-alist-option org-M-RET-may-split-line 'item)) - (funcall insert-fun)) - (t - (delete-horizontal-space) - (let* ((pos (point)) - (end-before-blank (org-end-of-item-before-blank)) - (after-bullet (when (< pos end-before-blank) - (prog1 - (buffer-substring pos end-before-blank) - (delete-region pos end-before-blank))))) - (funcall insert-fun after-bullet) t))))) + (org-insert-item-internal (point)) + (org-timer (if arg '(4))) + (insert ":: ")) ;; We are still are in a list, of a wrong type: throw an error. ((org-in-item-p) (error "This is not a timer list")) From 53c4b53e8f8f9955ea1acea118fa355deffa64c2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 16 Jul 2010 11:20:05 +0200 Subject: [PATCH 138/348] Less latency in org-timer-item. * org-timer.el (org-timer-item): Refactoring. Compute timer string before inserting it in the buffer * org-timer.el (org-timer): added an optional argument to return timer string instead of inserting it. --- lisp/org-timer.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index d51140634..0e296820a 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -145,18 +145,23 @@ With prefix arg STOP, stop it entirely." (org-timer-set-mode-line 'off)) ;;;###autoload -(defun org-timer (&optional restart) +(defun org-timer (&optional restart no-insert-p) "Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with a \\[universal-argument] prefix, force restarting the timer. When used with a double prefix argument \ \\[universal-argument] \\universal-argument], change all the timer string in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment." +that was not started at the correct moment. + +If NO-INSERT-P is non-nil, return the string instead of inserting +it in the buffer." (interactive "P") - (if (equal restart '(4)) (org-timer-start)) - (or org-timer-start-time (org-timer-start)) - (insert (org-timer-value-string))) + (when (or (equal restart '(4)) (not org-timer-start-time)) + (org-timer-start)) + (if no-insert-p + (org-timer-value-string) + (insert (org-timer-value-string)))) (defun org-timer-value-string () (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds))))) @@ -196,23 +201,21 @@ that was not started at the correct moment." "Insert a description-type item with the current timer value." (interactive "P") (cond - ;; If we are in a timer list, insert item like `org-insert-item'. + ;; In a timer list, insert with `org-insert-item-internal'. ((and (org-in-item-p) (save-excursion (org-beginning-of-item) (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::"))) - (org-insert-item-internal (point)) - (org-timer (if arg '(4))) - (insert ":: ")) - ;; We are still are in a list, of a wrong type: throw an error. + (org-insert-item-internal (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) + ;; In a list of another type, don't break anything: throw an error. ((org-in-item-p) (error "This is not a timer list")) - ;; Else, go to beginning of line, and insert the timer + ;; Else, insert the timer correctly indented at bol. (t (beginning-of-line) (org-indent-line-function) (insert "- ") - (org-timer (if arg '(4))) + (org-timer (when arg '(4))) (insert ":: ")))) (defun org-timer-fix-incomplete (hms) From deb6b0c5045ee25a906593f3e95be9d11cf788bc Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 16 Jul 2010 11:43:40 +0200 Subject: [PATCH 139/348] Some comments changes. --- lisp/org-list.el | 45 +++++++++++++++++++++------------------------ 1 file changed, 21 insertions(+), 24 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index d7a598d46..a90025c0a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -326,7 +326,7 @@ Internal use only. Prefer `org-get-next-item' and (start (point-at-bol))) ;; we don't want to match the current line. (funcall pre-move) - ;; we skip any sublist on the way + ;; Skip any sublist on the way (while (and (funcall search-fun (org-item-re) limit) (> (org-get-indentation) ind)) (funcall pre-move)) @@ -344,8 +344,7 @@ Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET after the bullet. Cursor will be after this text once the function end." (goto-char pos) - ;; Check if we're in a special block. If so, move before it prior to - ;; add a new item. + ;; Point in a special block: move before it prior to add a new item. (when (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) @@ -358,11 +357,11 @@ function end." (bullet-init (and (looking-at (org-item-re)) (match-string 0))) (before-p (progn - ;; In a descriptive list, text starts after the double colon + ;; Descriptive list: text starts after colons. (or (looking-at ".*::[ \t]+") - ;; if at a checkbox, text starts after it. + ;; At a checkbox: text starts after it. (org-at-item-checkbox-p) - ;; otherwise, text starts after bullet. + ;; Otherwise, text starts after bullet. (org-at-item-p)) (< true-pos (match-end 0)))) ;; Guess number of blank lines used to separate items. @@ -375,8 +374,8 @@ function end." (not insert-blank-p)) 0) ((eq insert-blank-p t) 1) - ;; plain-list-item is 'auto. Count blank - ;; lines separating items in list. + ;; plain-list-item is 'auto. Count blank lines separating + ;; items in current list. (t (save-excursion (if (progn @@ -388,9 +387,8 @@ function end." 0)))))) (insert-fun (lambda (&optional text) - ;; insert bullet above item in order to avoid - ;; bothering with possible blank lines ending - ;; last item + ;; insert bullet above item in order to avoid bothering + ;; with possible blank lines ending last item. (org-beginning-of-item) (insert (concat bullet-init (when checkbox "[ ] ") @@ -403,18 +401,17 @@ function end." (cond (before-p (funcall insert-fun) - ;; we're not moving down, but we still need a potential - ;; renumbering. + ;; Not taking advantage of renumbering while moving down. Need + ;; to call it directly. (org-maybe-renumber-ordered-list) t) - ;; if we can't split item, just insert bullet at the end of - ;; item. + ;; Can't split item: insert bullet at the end of item. ((not (org-get-alist-option org-M-RET-may-split-line 'item)) (funcall insert-fun) t) ;; else, insert a new bullet along with everything from point - ;; down to last non-blank line of item + ;; down to last non-blank line of item. (t (delete-horizontal-space) - ;; get pos again in case previous command changed line. + ;; Get pos again in case previous command modified line. (let* ((pos (point)) (end-before-blank (org-end-of-item-before-blank)) (after-text (when (< pos end-before-blank) @@ -428,7 +425,7 @@ function end." (defun org-in-item-p () "Is the cursor inside a plain list ?" (save-excursion - ;; we move to eol so that the current line can be matched by + ;; Move to eol so that current line can be matched by ;; `org-item-re'. (let* ((limit (or (save-excursion (outline-previous-heading)) (point-min))) (actual-pos (goto-char (point-at-eol))) @@ -511,14 +508,14 @@ A checkbox is blocked if all of the following conditions are fulfilled: (and (org-in-item-p) (let ((pos (org-beginning-of-item)) (bound (or (and (let ((outline-regexp org-outline-regexp)) - ;; we need set the default regexp - ;; because folding change its value. + ;; Use default regexp because folding + ;; changes OUTLINE-REGEXP. (outline-next-heading)) (skip-chars-backward " \t\r\n") (1+ (point-at-eol))) (point-max)))) ;; The list ending is either first point matching - ;; org-list-end-re, point at first white-line before next + ;; `org-list-end-re', point at first white-line before next ;; heading, or eob. (or (org-list-terminator-between pos bound t) bound))))) @@ -911,7 +908,7 @@ Also, fix the indentation." (org-beginning-of-item-list) (looking-at "[ \t]*\\(\\S-+\\)") (concat (or force-bullet (match-string 1)) " " - ;; do we need to concat another white space ? + ;; Do we need to concat another white space ? (when (and org-list-two-spaces-after-bullet-regexp (string-match org-list-two-spaces-after-bullet-regexp bullet)) " ")))) @@ -923,11 +920,11 @@ Also, fix the indentation." (match-string 0)))) (unless (equal bullet old) (replace-match bullet) - ;; when bullet lengths are differents, move the whole + ;; When bullet lengths are differents, move the whole ;; sublist accordingly (org-shift-item-indentation (- (length bullet) (length old)))))))) (org-apply-on-list replace-bullet nil bullet) - ;; fix item numbers if necessary + ;; Fix item numbers if necessary (when (string-match "[0-9]" bullet) (org-renumber-ordered-list))))) (defun org-renumber-ordered-list (&optional arg) From 7cf8ab06de87734562870629f641f05585c648f8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 17 Jul 2010 10:05:05 +0200 Subject: [PATCH 140/348] Fix inserting item with point before first char of item's body. * lisp/org-list.el (org-insert-item-internal): fixes the problem when point was before the first char of the item's body. --- lisp/org-list.el | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a90025c0a..80e1a0ba8 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -353,9 +353,9 @@ function end." (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) (end-of-line 0)) (let* ((true-pos (point)) - (item-start (org-beginning-of-item)) - (bullet-init (and (looking-at (org-item-re)) - (match-string 0))) + (bullet (and (org-beginning-of-item) + (looking-at (org-item-re)) + (match-string 0))) (before-p (progn ;; Descriptive list: text starts after colons. (or (looking-at ".*::[ \t]+") @@ -363,7 +363,7 @@ function end." (org-at-item-checkbox-p) ;; Otherwise, text starts after bullet. (org-at-item-p)) - (< true-pos (match-end 0)))) + (<= true-pos (match-end 0)))) ;; Guess number of blank lines used to separate items. (blank-lines-nb (let ((insert-blank-p @@ -390,9 +390,10 @@ function end." ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. (org-beginning-of-item) - (insert (concat bullet-init + (insert (concat bullet (when checkbox "[ ] ") after-bullet)) + ;; Stay between after-bullet and before text. (save-excursion (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) (unless before-p (org-move-item-down)) From 802a3d1b3f7c0ebcd77e12b4beec792b11d1e033 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 17 Jul 2010 11:27:58 +0200 Subject: [PATCH 141/348] Refactoring. * org-list.el (org-search-unenclosed-internal): new function to handle both `org-search-forward-unenclosed' and `org-search-backward-unenclosed'. * org-list.el (org-search-backward-unenclosed): Can send errors now. Removed useless usage of COUNT. * org-list.el (org-search-forward-unenclosed): Can send errors now. Removed useless usage of COUNT. * org-list.el (org-update-checkbox-count): Use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' instead of `re-search-forward' and `re-search-backward'. * org-list.el (org-sort-list): Use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' instead of `re-search-forward' and `re-search-backward'. * org-list.el (org-list-make-subtree): Use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' instead of `re-search-forward' and `re-search-backward'. --- lisp/org-list.el | 78 ++++++++++++++++++------------------------------ 1 file changed, 29 insertions(+), 49 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 80e1a0ba8..695027f4e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -259,23 +259,18 @@ the end of the nearest terminator from max." #'org-search-backward-unenclosed)) (list-end-p (progn (goto-char start) - (funcall search-fun (org-list-end-re) end)))) + (funcall search-fun (org-list-end-re) end t)))) ;; Is there a valid list terminator somewhere ? (and list-end-p ;; we want to be on the first line of the list ender (match-beginning 0))))) -(defun org-search-backward-unenclosed (regexp &optional bound noerror count) - "Like `re-search-backward' but don't stop inside blocks or at protected places. -This function does not throw errors. - -Optional fourth argument COUNT searches for that many -occurrences, valid or not, then makes sure the last one is -valid." +(defun org-search-unenclosed-internal (search-fun regexp bound noerror count) + "Search for REGEXP with SEARCH-FUN but don't stop inside blocks or at protected places." (let ((origin (point))) (cond ;; nothing found: return nil - ((not (re-search-backward regexp bound (or noerror t) count)) nil) + ((not (funcall search-fun regexp bound noerror count)) nil) ;; match is enclosed or protected: start again, searching one ;; more occurrence away. ((or (save-match-data @@ -283,32 +278,17 @@ valid." '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) (get-text-property (match-beginning 0) 'org-protected)) (goto-char origin) - (org-search-backward-unenclosed regexp bound noerror (1+ (or count 1)))) + (org-search-unenclosed-internal search-fun regexp bound noerror (1+ count))) ;; else return point. - (t - (point))))) + (t (point))))) -(defun org-search-forward-unenclosed (regexp &optional bound noerror count) - "Like `re-search-forward' but don't stop inside blocks or at protected places. -This function does not throw errors. +(defun org-search-backward-unenclosed (regexp &optional bound noerror) + "Like `re-search-backward' but don't stop inside blocks or at protected places." + (org-search-unenclosed-internal #'re-search-backward regexp bound noerror 1)) -Optional fourth argument COUNT searches for that many occurrences, -valid or not, then makes sure the last one is valid." - (let ((origin (point))) - (cond - ;; nothing found: return nil - ((not (re-search-forward regexp bound (or noerror t) count)) nil) - ;; match is enclosed or protected: start again, searching one - ;; more occurrence away. - ((or (save-match-data - (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) - (get-text-property (match-beginning 0) 'org-protected)) - (goto-char origin) - (org-search-forward-unenclosed regexp bound noerror (1+ (or count 1)))) - ;; else return point. - (t - (point))))) +(defun org-search-forward-unenclosed (regexp &optional bound noerror) + "Like `re-search-forward' but don't stop inside blocks or at protected places." + (org-search-unenclosed-internal #'re-search-forward regexp bound noerror 1)) (defun org-get-item-same-level-internal (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. @@ -327,7 +307,7 @@ Internal use only. Prefer `org-get-next-item' and ;; we don't want to match the current line. (funcall pre-move) ;; Skip any sublist on the way - (while (and (funcall search-fun (org-item-re) limit) + (while (and (funcall search-fun (org-item-re) limit t) (> (org-get-indentation) ind)) (funcall pre-move)) (when (and (/= (point-at-bol) start) ; Have we moved ? @@ -431,7 +411,7 @@ function end." (let* ((limit (or (save-excursion (outline-previous-heading)) (point-min))) (actual-pos (goto-char (point-at-eol))) (last-item-start (save-excursion - (org-search-backward-unenclosed (org-item-re) limit))) + (org-search-backward-unenclosed (org-item-re) limit t))) (list-ender (org-list-terminator-between last-item-start actual-pos))) ;; We are in a list when we are on an item line or we can find ;; an item before and there is no valid list ender between us @@ -484,9 +464,8 @@ A checkbox is blocked if all of the following conditions are fulfilled: (condition-case nil (org-back-to-heading t) (error (throw 'exit nil))) (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) - (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) - (org-current-line) - nil)))))) + (when (org-search-forward-unenclosed "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) + (org-current-line))))))) ;;; Navigate @@ -500,7 +479,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;; Otherwise, go back to the heading above or bob. (goto-char (or (org-list-terminator-between bound pos) bound)) ;; From there, search down our list. - (org-search-forward-unenclosed (org-item-re) pos) + (org-search-forward-unenclosed (org-item-re) pos t) (point-at-bol))))) (defun org-list-bottom-point () @@ -528,7 +507,7 @@ If the cursor is not in an item, throw an error. Return point." (if (org-at-item-p) (progn (beginning-of-line 1) (point)) - (org-search-backward-unenclosed (org-item-re)) + (org-search-backward-unenclosed (org-item-re) nil t) (goto-char (point-at-bol))) (error "Not in an item"))) @@ -550,7 +529,7 @@ Assumes that the cursor is in the first line of an item." (let ((limit (org-list-bottom-point))) (end-of-line) (goto-char - (if (org-search-forward-unenclosed (org-item-re) limit) + (if (org-search-forward-unenclosed (org-item-re) limit t) (point-at-bol) limit)))) @@ -1060,7 +1039,7 @@ text below the heading." (setq first-present (org-at-item-checkbox-p) first-status (save-excursion - (and (re-search-forward "[ \t]\\(\\[[ X]\\]\\)" end t) + (and (org-search-forward-unenclosed "[ \t]\\(\\[[ X]\\]\\)" end t) (equal (match-string 1) "[X]")))) (while (< (point) end) (if toggle-presence @@ -1140,7 +1119,7 @@ the whole buffer." (setq beg (point) end (point-max))) (goto-char end) ;; find each statistics cookie - (while (and (re-search-backward re-find beg t) + (while (and (org-search-backward-unenclosed re-find beg t) (not (save-match-data (and (org-on-heading-p) (string-match "\\<todo\\>" @@ -1164,7 +1143,7 @@ the whole buffer." ;; find first checkbox for this cookie and gather ;; statistics from all that are at this indentation level (goto-char startsearch) - (if (re-search-forward re-box lim t) + (if (org-search-forward-unenclosed re-box lim t) (progn (org-beginning-of-item) (setq curr-ind (org-get-indentation)) @@ -1174,7 +1153,7 @@ the whole buffer." (<= curr-ind next-ind) (= curr-ind next-ind))) (save-excursion (end-of-line) (setq eline (point))) - (if (re-search-forward re-box eline t) + (if (org-search-forward-unenclosed re-box eline t) (if (member (match-string 2) '("[ ]" "[-]")) (setq c-off (1+ c-off)) (setq c-on (1+ c-on)))) @@ -1199,7 +1178,7 @@ the whole buffer." (when (org-at-item-p) (org-beginning-of-item) (when (and (> (+ c-on c-off) 0) - (re-search-forward re-box (point-at-eol) t)) + (org-search-forward-unenclosed re-box (point-at-eol) t)) (setq beg-cookie (match-beginning 2) end-cookie (match-end 2)) (delete-region beg-cookie end-cookie) @@ -1320,9 +1299,10 @@ optional argument WITH-CASE, the sorting considers case as well." ((= dcst ?a) (buffer-substring (match-end 0) (point-at-eol))) ((= dcst ?t) - (if (or (re-search-forward org-ts-regexp (point-at-eol) t) - (re-search-forward org-ts-regexp-both - (point-at-eol) t)) + (if (or (org-search-forward-unenclosed org-ts-regexp + (point-at-eol) t) + (org-search-forward-unenclosed org-ts-regexp-both + (point-at-eol) t)) (org-time-string-to-seconds (match-string 0)) (org-float-time now))) ((= dcst ?f) @@ -1387,7 +1367,7 @@ sublevels as a list of strings." (save-excursion (if (ignore-errors (org-back-to-heading)) - (progn (re-search-forward org-complex-heading-regexp nil t) + (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t) (setq nstars (length (match-string 1)))) (setq nstars 0))) (org-list-make-subtrees list (1+ nstars)))) From 0229bcc05429d1a36ead914a1f6c5ab33b1c54d9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 17 Jul 2010 13:56:11 +0200 Subject: [PATCH 142/348] Sort also timer lists. * org-list.el (org-sort-list): add the possibility to sort timer lists with the ?t or ?T options. --- lisp/org-list.el | 74 ++++++++++++++++++++++++++---------------------- 1 file changed, 40 insertions(+), 34 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 695027f4e..e5701a8e4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1236,21 +1236,21 @@ beginning of the item." (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) "Sort plain list items. The cursor may be at any item of the list that should be sorted. -Sublists are not sorted. +Sublists are not sorted. Checkboxes, if any, are ignored. Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. -The command prompts for the sorting type unless it has been given to the -function through the SORTING-TYPE argument, which needs to be a character, -\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?r ?R ?f ?F). Here is the -precise meaning of each character: +The command prompts for the sorting type unless it has been given +to the function through the SORTING-TYPE argument, which needs to +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise +meaning of each character: -n Numerically, by converting the beginning of the entry/item to a number. -a Alphabetically, ignoring the TODO keyword and the priority, if any. -t By date/time, either the first active time stamp in the entry, or, if - none exist, by the first inactive one. - In items, only the first line will be checked. +n Numerically, by converting the beginning of the item to a number. +a Alphabetically. +t By date/time, either the first active time stamp in the entry, if + any, or by the first inactive one. In a timer list, sorts the timers. + Only the first line of item is checked. Capital letters will reverse the sort order. @@ -1283,36 +1283,42 @@ optional argument WITH-CASE, the sorting considers case as well." (sort-func (cond ((= dcst ?a) 'string<) ((= dcst ?f) compare-func) - ((member dcst '(?p ?t ?s ?d ?c)) '<) + ((= dcst ?t) '<) (t nil))) (begin-record (lambda () (skip-chars-forward " \r\t\n") (beginning-of-line))) (end-record (lambda () (goto-char (org-end-of-item-before-blank)))) - (value-to-sort (lambda nil - (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") - (cond - ((= dcst ?n) - (string-to-number (buffer-substring (match-end 0) - (point-at-eol)))) - ((= dcst ?a) - (buffer-substring (match-end 0) (point-at-eol))) - ((= dcst ?t) - (if (or (org-search-forward-unenclosed org-ts-regexp - (point-at-eol) t) - (org-search-forward-unenclosed org-ts-regexp-both - (point-at-eol) t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now))) - ((= dcst ?f) - (if getkey-func - (let ((value (funcall getkey-func))) - (if (stringp value) - (funcall case-func value) - value)) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))))) + (value-to-sort + (lambda () + (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") + (cond + ((= dcst ?n) + (string-to-number (buffer-substring (match-end 0) + (point-at-eol)))) + ((= dcst ?a) + (buffer-substring (match-end 0) (point-at-eol))) + ((= dcst ?t) + (cond + ;; If it is a timer list, convert timer to seconds + ((and (goto-char (match-end 0)) + (looking-at "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::")) + (org-timer-hms-to-secs (match-string 1))) + ((or (org-search-forward-unenclosed org-ts-regexp + (point-at-eol) t) + (org-search-forward-unenclosed org-ts-regexp-both + (point-at-eol) t)) + (org-time-string-to-seconds (match-string 0))) + (t (org-float-time now)))) + ((= dcst ?f) + (if getkey-func + (let ((value (funcall getkey-func))) + (if (stringp value) + (funcall case-func value) + value)) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type))))))) (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func) (org-maybe-renumber-ordered-list) (run-hooks 'org-after-sorting-entries-or-items-hook) From 3dfc889cce8b07f7f745b72ea135654995057506 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 17 Jul 2010 15:17:38 +0200 Subject: [PATCH 143/348] Refactoring. --- lisp/org-list.el | 19 +++++++++++++------ lisp/org-timer.el | 7 +++---- 2 files changed, 16 insertions(+), 10 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index e5701a8e4..8b7ab68b4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -438,6 +438,16 @@ function end." (not (member (char-after) '(?\ ?\t))) (< (point) (match-end 0)))) +(defun org-at-item-timer-p () + "Is point at a line starting a plain list item with a timer? +This skips checkboxes, if any." + (and (or (org-at-item-checkbox-p) + (org-at-item-p)) + (save-excursion + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (looking-at "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")))) + (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" (and (org-at-item-p) @@ -686,10 +696,8 @@ things worked, nil when we are not in an item, or item is invisible." (unless (or (not (org-in-item-p)) (org-invisible-p)) - ;; Timer list: delegate to `org-timer-item'. - (if (save-excursion - (org-beginning-of-item) - (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::")) + (if (org-at-item-timer-p) + ;; Timer list: delegate to `org-timer-item'. (progn (org-timer-item) t) ;; if we're in a description list, ask for the new term. (let ((desc-text (when (save-excursion @@ -1302,8 +1310,7 @@ optional argument WITH-CASE, the sorting considers case as well." ((= dcst ?t) (cond ;; If it is a timer list, convert timer to seconds - ((and (goto-char (match-end 0)) - (looking-at "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::")) + ((org-at-item-timer-p) (org-timer-hms-to-secs (match-string 1))) ((or (org-search-forward-unenclosed org-ts-regexp (point-at-eol) t) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 0e296820a..d859f7a5d 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -203,10 +203,9 @@ it in the buffer." (cond ;; In a timer list, insert with `org-insert-item-internal'. ((and (org-in-item-p) - (save-excursion - (org-beginning-of-item) - (looking-at "[ \t]*[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+ ::"))) - (org-insert-item-internal (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) + (org-at-item-timer-p)) + (org-insert-item-internal + (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) ;; In a list of another type, don't break anything: throw an error. ((org-in-item-p) (error "This is not a timer list")) From 905ad49e9a5d852fe660edad3ad3ee4bd437ddc4 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 17 Jul 2010 23:00:22 +0200 Subject: [PATCH 144/348] Fixed some corner-case when inserting item. --- lisp/org-list.el | 30 +++++++++++++++++++----------- lisp/org-timer.el | 2 +- 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8b7ab68b4..feffb65d3 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -143,7 +143,7 @@ When nil, no bullet will have two spaces after them. When a string, it will be used as a regular expression. When the bullet type of a list is changed, the new bullet type will be matched against this regexp. If it matches, there will be two -spaces instead of one after the bullet in each item of he list." +spaces instead of one after the bullet in each item of the list." :group 'org-plain-lists :type '(choice (const :tag "never" nil) @@ -167,8 +167,8 @@ precedence over it." (defcustom org-auto-renumber-ordered-lists t "Non-nil means automatically renumber ordered plain lists. Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands, -use \\[org-ctrl-c-ctrl-c] to trigger renumbering." +\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing +commands, use \\[org-ctrl-c-ctrl-c] to trigger renumbering." :group 'org-plain-lists :type 'boolean) @@ -366,7 +366,7 @@ function end." (1+ (org-back-over-empty-lines)) 0)))))) (insert-fun - (lambda (&optional text) + (lambda (text) ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. (org-beginning-of-item) @@ -381,13 +381,13 @@ function end." (goto-char true-pos) (cond (before-p - (funcall insert-fun) + (funcall insert-fun nil) ;; Not taking advantage of renumbering while moving down. Need ;; to call it directly. (org-maybe-renumber-ordered-list) t) ;; Can't split item: insert bullet at the end of item. ((not (org-get-alist-option org-M-RET-may-split-line 'item)) - (funcall insert-fun) t) + (funcall insert-fun nil) t) ;; else, insert a new bullet along with everything from point ;; down to last non-blank line of item. (t @@ -395,10 +395,16 @@ function end." ;; Get pos again in case previous command modified line. (let* ((pos (point)) (end-before-blank (org-end-of-item-before-blank)) - (after-text (when (< pos end-before-blank) - (prog1 - (buffer-substring pos end-before-blank) - (delete-region pos end-before-blank))))) + (after-text + (when (< pos end-before-blank) + (prog1 + (buffer-substring pos end-before-blank) + (delete-region pos end-before-blank) + ;; delete any blank line at and before point. + (beginning-of-line) + (while (looking-at "^[ \t]*$") + (delete-region (point-at-bol) (1+ (point-at-eol))) + (backward-char)))))) (funcall insert-fun after-text) t))))) ;;; Predicates @@ -696,7 +702,9 @@ things worked, nil when we are not in an item, or item is invisible." (unless (or (not (org-in-item-p)) (org-invisible-p)) - (if (org-at-item-timer-p) + (if (save-excursion + (org-beginning-of-item) + (org-at-item-timer-p)) ;; Timer list: delegate to `org-timer-item'. (progn (org-timer-item) t) ;; if we're in a description list, ask for the new term. diff --git a/lisp/org-timer.el b/lisp/org-timer.el index d859f7a5d..6b519baac 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -203,7 +203,7 @@ it in the buffer." (cond ;; In a timer list, insert with `org-insert-item-internal'. ((and (org-in-item-p) - (org-at-item-timer-p)) + (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) (org-insert-item-internal (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) ;; In a list of another type, don't break anything: throw an error. From c3bbbc09261396cc23fb357dddb0b2352d31977c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 18 Jul 2010 11:04:15 +0200 Subject: [PATCH 145/348] Blank lines number is guessed locally when inserting item. * org-list.el (org-insert-item-internal): guessing of blank lines number is made by looking at neighbours items, if any. --- lisp/org-list.el | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index feffb65d3..b0eca8c5a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -322,7 +322,7 @@ new item will be created before the current one. Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET after the bullet. Cursor will be after this text once the -function end." +function ends." (goto-char pos) ;; Point in a special block: move before it prior to add a new item. (when (org-in-regexps-block-p @@ -355,16 +355,17 @@ function end." 0) ((eq insert-blank-p t) 1) ;; plain-list-item is 'auto. Count blank lines separating - ;; items in current list. + ;; neighbours items in list. (t - (save-excursion - (if (progn - (org-end-of-item-list) - (skip-chars-backward " \r\t\n") - (org-search-backward-unenclosed - "^[ \t]*$" (save-excursion (org-beginning-of-item-list)) t)) - (1+ (org-back-over-empty-lines)) - 0)))))) + (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((not (org-first-list-item-p)) (org-back-over-empty-lines)) + ;; no luck: item is alone. Use default value. + (t 1))))))) (insert-fun (lambda (text) ;; insert bullet above item in order to avoid bothering @@ -404,7 +405,7 @@ function end." (beginning-of-line) (while (looking-at "^[ \t]*$") (delete-region (point-at-bol) (1+ (point-at-eol))) - (backward-char)))))) + (beginning-of-line 0)))))) (funcall insert-fun after-text) t))))) ;;; Predicates From 2b5b8cf8a28021fde245ca354894c392c05debd4 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 09:16:13 +0200 Subject: [PATCH 146/348] Refactoring. --- lisp/org-list.el | 26 ++++++++++++-------------- 1 file changed, 12 insertions(+), 14 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b0eca8c5a..bd25ebf7f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -415,7 +415,7 @@ function ends." (save-excursion ;; Move to eol so that current line can be matched by ;; `org-item-re'. - (let* ((limit (or (save-excursion (outline-previous-heading)) (point-min))) + (let* ((limit (save-excursion (outline-previous-heading))) (actual-pos (goto-char (point-at-eol))) (last-item-start (save-excursion (org-search-backward-unenclosed (org-item-re) limit t))) @@ -520,13 +520,12 @@ A checkbox is blocked if all of the following conditions are fulfilled: "Go to the beginning of the current hand-formatted item. If the cursor is not in an item, throw an error. Return point." (interactive) - (if (org-in-item-p) - (if (org-at-item-p) - (progn (beginning-of-line 1) - (point)) - (org-search-backward-unenclosed (org-item-re) nil t) - (goto-char (point-at-bol))) - (error "Not in an item"))) + (if (not (org-in-item-p)) + (error "Not in an item") + ;; Possibly match the current line. + (end-of-line) + (org-search-backward-unenclosed (org-item-re) nil t) + (goto-char (point-at-bol)))) (defun org-end-of-item () "Go to the end of the current hand-formatted item. @@ -805,7 +804,7 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (/= (point-at-bol) (org-list-top-point))) (error "Cannot outdent beyond top level item")) (while (< (point) end) - (beginning-of-line 1) + (beginning-of-line) (skip-chars-forward " \t") (setq ind1 (current-column)) (delete-region (point-at-bol) (point)) (or (eolp) (org-indent-to-column (+ ind1 delta))) @@ -875,11 +874,11 @@ Assumes cursor in item line." (progn (org-outdent-item 1) (if (equal org-tab-ind-state (org-get-indentation)) (org-outdent-item 1)) - (end-of-line 1)) + (end-of-line)) (error (progn (while (< (org-get-indentation) org-tab-ind-state) - (progn (org-indent-item 1) (end-of-line 1))) + (progn (org-indent-item 1) (end-of-line))) (setq this-command 'org-cycle)))) (setq org-tab-ind-state (org-get-indentation)) (org-indent-item 1)) @@ -1169,7 +1168,7 @@ the whole buffer." (if recursive (<= curr-ind next-ind) (= curr-ind next-ind))) - (save-excursion (end-of-line) (setq eline (point))) + (setq eline (point-at-eol)) (if (org-search-forward-unenclosed re-box eline t) (if (member (match-string 2) '("[ ]" "[-]")) (setq c-off (1+ c-off)) @@ -1463,8 +1462,7 @@ this list." (setq beg (point)) (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) (error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)) + (delete-region beg (point-at-bol)) (goto-char beg) (insert txt "\n"))) (message "List converted and installed at receiver location")))) From 8a215f56ebdf283f6ff0361f116aef7bb313c294 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 10:50:15 +0200 Subject: [PATCH 147/348] No checkboxes for description items. --- lisp/org-list.el | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index bd25ebf7f..b27ce09eb 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -446,10 +446,8 @@ function ends." (< (point) (match-end 0)))) (defun org-at-item-timer-p () - "Is point at a line starting a plain list item with a timer? -This skips checkboxes, if any." - (and (or (org-at-item-checkbox-p) - (org-at-item-p)) + "Is point at a line starting a plain list item with a timer?" + (and (org-at-item-p) (save-excursion (goto-char (match-end 0)) (skip-chars-forward " \t") @@ -713,7 +711,7 @@ invisible." (looking-at "[ \t]*\\(.*?\\) ::") (match-string 1))) (concat (read-string "Term: ") " :: ")))) - (org-insert-item-internal (point) checkbox desc-text))))) + (org-insert-item-internal (point) (and checkbox (not desc-text)) desc-text))))) ;;; Indentation From d830b4b3ee306e6c3c7af2209ccf1c68bf65fe83 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 11:21:22 +0200 Subject: [PATCH 148/348] Refactoring --- lisp/org-list.el | 35 +++++++++++++++++++---------------- 1 file changed, 19 insertions(+), 16 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b27ce09eb..d1de4e95a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -290,6 +290,14 @@ the end of the nearest terminator from max." "Like `re-search-forward' but don't stop inside blocks or at protected places." (org-search-unenclosed-internal #'re-search-forward regexp bound noerror 1)) +(defun org-list-at-regexp-after-bullet-p (regexp) + "Is point at a list item with REGEXP after bullet?" + (and (org-at-item-p) + (save-excursion + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (looking-at regexp)))) + (defun org-get-item-same-level-internal (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. Search items using function SEARCH-FUN, from POS to LIMIT. It @@ -337,8 +345,8 @@ function ends." (looking-at (org-item-re)) (match-string 0))) (before-p (progn - ;; Descriptive list: text starts after colons. - (or (looking-at ".*::[ \t]+") + ;; Description item: text starts after colons. + (or (org-at-description-p) ;; At a checkbox: text starts after it. (org-at-item-checkbox-p) ;; Otherwise, text starts after bullet. @@ -447,19 +455,15 @@ function ends." (defun org-at-item-timer-p () "Is point at a line starting a plain list item with a timer?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")))) + (org-list-at-regexp-after-bullet-p "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) + +(defun org-at-description-p () + "Is point at a description list item?" + (org-list-at-regexp-after-bullet-p "\\(\\S-+\\)[ \t]+::[ \t]+")) (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (looking-at "\\[[- X]\\]")))) + (org-list-at-regexp-after-bullet-p "\\[[- X]\\]")) (defun org-checkbox-blocked-p () "Is the current checkbox blocked from for being checked now? @@ -708,8 +712,7 @@ invisible." ;; if we're in a description list, ask for the new term. (let ((desc-text (when (save-excursion (and (org-beginning-of-item) - (looking-at "[ \t]*\\(.*?\\) ::") - (match-string 1))) + (org-at-description-p))) (concat (read-string "Term: ") " :: ")))) (org-insert-item-internal (point) (and checkbox (not desc-text)) desc-text))))) @@ -1352,7 +1355,7 @@ sublevels as a list of strings." (cond ((looking-at-p "^[ \t]*[0-9]") (setq itemsep "[0-9]+\\(?:\\.\\|)\\)" ltype 'ordered)) - ((looking-at-p "^.*::") + ((org-at-description-p) (setq itemsep "[-+*]" ltype 'descriptive)) (t (setq itemsep "[-+*]" ltype 'unordered)))) (let* ((indent1 (org-get-indentation)) @@ -1523,7 +1526,7 @@ Valid parameters PARAMS are (while (setq sublist (pop list)) (cond ((symbolp sublist) nil) ((stringp sublist) - (when (string-match "^\\(.*\\) ::" sublist) + (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist) (setq term (org-trim (format (concat dtstart "%s" dtend) (match-string 1 sublist)))) (setq sublist (concat ddstart From abb490c57208fca1a1f5cda903c61f975df81f7f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 11:33:20 +0200 Subject: [PATCH 149/348] Internal functions stay with org-list- prefix. --- lisp/org-list.el | 21 +++++++++++---------- lisp/org-timer.el | 4 ++-- 2 files changed, 13 insertions(+), 12 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index d1de4e95a..1e8f98157 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -265,7 +265,7 @@ the end of the nearest terminator from max." ;; we want to be on the first line of the list ender (match-beginning 0))))) -(defun org-search-unenclosed-internal (search-fun regexp bound noerror count) +(defun org-list-search-unenclosed-generic (search-fun regexp bound noerror count) "Search for REGEXP with SEARCH-FUN but don't stop inside blocks or at protected places." (let ((origin (point))) (cond @@ -278,17 +278,17 @@ the end of the nearest terminator from max." '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) (get-text-property (match-beginning 0) 'org-protected)) (goto-char origin) - (org-search-unenclosed-internal search-fun regexp bound noerror (1+ count))) + (org-list-search-unenclosed-generic search-fun regexp bound noerror (1+ count))) ;; else return point. (t (point))))) (defun org-search-backward-unenclosed (regexp &optional bound noerror) "Like `re-search-backward' but don't stop inside blocks or at protected places." - (org-search-unenclosed-internal #'re-search-backward regexp bound noerror 1)) + (org-list-search-unenclosed-generic #'re-search-backward regexp bound noerror 1)) (defun org-search-forward-unenclosed (regexp &optional bound noerror) "Like `re-search-forward' but don't stop inside blocks or at protected places." - (org-search-unenclosed-internal #'re-search-forward regexp bound noerror 1)) + (org-list-search-unenclosed-generic #'re-search-forward regexp bound noerror 1)) (defun org-list-at-regexp-after-bullet-p (regexp) "Is point at a list item with REGEXP after bullet?" @@ -298,7 +298,7 @@ the end of the nearest terminator from max." (skip-chars-forward " \t") (looking-at regexp)))) -(defun org-get-item-same-level-internal (search-fun pos limit pre-move) +(defun org-list-get-item-same-level (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. Search items using function SEARCH-FUN, from POS to LIMIT. It uses PRE-MOVE before searches. Return nil if no item was found. @@ -322,8 +322,8 @@ Internal use only. Prefer `org-get-next-item' and (= (org-get-indentation) ind)) (point-at-bol))))) -(defun org-insert-item-internal (pos &optional checkbox after-bullet) - "Insert a new item in a list. +(defun org-list-insert-item-generic (pos &optional checkbox after-bullet) + "Insert a new list item at POS. If POS is before first character after bullet of the item, the new item will be created before the current one. @@ -563,7 +563,7 @@ Point returned is at eol." "Get the point of the next item at the same level as POS. Stop searching at LIMIT. Return nil if no item is found. This function does not move point." - (org-get-item-same-level-internal + (org-list-get-item-same-level #'org-search-forward-unenclosed pos limit @@ -573,7 +573,7 @@ Point returned is at eol." "Get the point of the previous item at the same level as POS. Stop searching at LIMIT. Return nil if no item is found. This function does not move point." - (org-get-item-same-level-internal + (org-list-get-item-same-level #'org-search-backward-unenclosed pos limit @@ -714,7 +714,8 @@ invisible." (and (org-beginning-of-item) (org-at-description-p))) (concat (read-string "Term: ") " :: ")))) - (org-insert-item-internal (point) (and checkbox (not desc-text)) desc-text))))) + (org-list-insert-item-generic + (point) (and checkbox (not desc-text)) desc-text))))) ;;; Indentation diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 6b519baac..33c4c0bb0 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -201,10 +201,10 @@ it in the buffer." "Insert a description-type item with the current timer value." (interactive "P") (cond - ;; In a timer list, insert with `org-insert-item-internal'. + ;; In a timer list, insert with `org-list-insert-item-generic'. ((and (org-in-item-p) (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) - (org-insert-item-internal + (org-list-insert-item-generic (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) ;; In a list of another type, don't break anything: throw an error. ((org-in-item-p) From 97f857c9b7bb8e44f622be0676e2ffed4ac55d97 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 11:43:33 +0200 Subject: [PATCH 150/348] Minor refactoring. --- lisp/org-list.el | 10 ++-------- 1 file changed, 2 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 1e8f98157..efaa7b99d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -564,20 +564,14 @@ Point returned is at eol." Stop searching at LIMIT. Return nil if no item is found. This function does not move point." (org-list-get-item-same-level - #'org-search-forward-unenclosed - pos - limit - #'end-of-line)) + #'org-search-forward-unenclosed pos limit #'end-of-line)) (defun org-get-previous-item (pos limit) "Get the point of the previous item at the same level as POS. Stop searching at LIMIT. Return nil if no item is found. This function does not move point." (org-list-get-item-same-level - #'org-search-backward-unenclosed - pos - limit - #'beginning-of-line)) + #'org-search-backward-unenclosed pos limit #'beginning-of-line)) (defun org-next-item () "Move to the beginning of the next item. From 8597bb25ee4baecf99d355ab382a2021c8877278 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 12:38:14 +0200 Subject: [PATCH 151/348] Description item regexp was too strict. --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index efaa7b99d..7b2adb820 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -459,7 +459,7 @@ function ends." (defun org-at-description-p () "Is point at a description list item?" - (org-list-at-regexp-after-bullet-p "\\(\\S-+\\)[ \t]+::[ \t]+")) + (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" From 85868125c240b4fe6095c767fdd6cf51dccfdd34 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 12:39:06 +0200 Subject: [PATCH 152/348] Fix cycling indentation. --- lisp/org-list.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 7b2adb820..6345e772d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -731,16 +731,14 @@ invisible." (unless (org-bound-and-true-p org-suppress-item-indentation) (save-excursion (let ((beg (point-at-bol)) - (end (progn (org-end-of-item) (point))) - i) - (goto-char end) + (end (org-end-of-item))) (beginning-of-line 0) (while (> (point) beg) (when (looking-at "[ \t]*\\S-") ;; this is not an empty line - (setq i (org-get-indentation)) - (if (and (> i 0) (> (setq i (+ i delta)) 0)) - (indent-line-to i))) + (let ((i (org-get-indentation))) + (when (and (> i 0) (> (+ i delta) 0)) + (indent-line-to (+ i delta))))) (beginning-of-line 0)))))) @@ -795,10 +793,12 @@ If NO-SUBTREE is set, only indent the item itself, not its children." delta (if (> arg 0) (if ind-down (- ind-down ind) 2) (if ind-up (- ind-up ind) -2))) - (if (and (< (+ delta ind) origin-ind) - ;; verify we're not at the top level item - (/= (point-at-bol) (org-list-top-point))) - (error "Cannot outdent beyond top level item")) + (cond + ((< (+ delta ind) 0) (error "Cannot outdent beyond margin")) + ((and (< (+ delta ind) origin-ind) + ;; verify we're not at the top level item + (/= (point-at-bol) (org-list-top-point))) + (error "Cannot outdent beyond top level item"))) (while (< (point) end) (beginning-of-line) (skip-chars-forward " \t") (setq ind1 (current-column)) From d22d58acf13e0e8e2b82727308b859f1b94e399e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 17:02:58 +0200 Subject: [PATCH 153/348] Allow cycling indentation at creation of description and checkboxed items. * org-list.el (org-at-item-checkbox-p): add whitespaces at the end of the regexp. * org-list.el (org-checkbox-blocked-p): use new checkbox regexp. * org-list.el (org-cycle-item-indentation): allow cycling description items and checkbox items. * org-list.el (org-toggle-checkbox): use new checkbox regexp. * org-list.el (org-reset-checkbox-state-subtree): use new checkbox regexp. --- lisp/org-list.el | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6345e772d..7dd8a94b4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -463,7 +463,7 @@ function ends." (defun org-at-item-checkbox-p () "Is point at a line starting a plain-list item with a checklet?" - (org-list-at-regexp-after-bullet-p "\\[[- X]\\]")) + (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) (defun org-checkbox-blocked-p () "Is the current checkbox blocked from for being checked now? @@ -476,7 +476,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: (save-match-data (save-excursion (unless (org-at-item-checkbox-p) (throw 'exit nil)) - (when (equal (match-string 0) "[X]") + (when (equal (match-string 1) "[X]") ;; the box is already checked! (throw 'exit nil)) (let ((end (point-at-bol))) @@ -863,7 +863,8 @@ Assumes cursor in item line." (org-adapt-indentation nil)) (cond ((and (looking-at "[ \t]*$") - (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+")) + (or (org-at-description-p) (org-at-item-checkbox-p) (org-at-item-p)) + (<= (point) (match-end 0))) (setq this-command 'org-cycle-item-indentation) (if (eq last-command 'org-cycle-item-indentation) (condition-case nil @@ -1026,7 +1027,7 @@ text below the heading." (save-excursion (if (equal toggle-presence '(4)) (progn - (replace-match "") + (replace-match "" nil nil nil 1) (goto-char (match-beginning 0)) (just-one-space)) (when (setq blocked (org-checkbox-blocked-p)) @@ -1034,9 +1035,9 @@ text below the heading." blocked)) (replace-match (cond ((equal toggle-presence '(16)) "[-]") - ((member (match-string 0) '("[ ]" "[-]")) "[X]") + ((member (match-string 1) '("[ ]" "[-]")) "[X]") (t "[ ]")) - t t))) + t t nil 1))) (throw 'exit t)) ((org-at-item-p) ;; add a checkbox @@ -1052,7 +1053,7 @@ text below the heading." first-status (save-excursion (and (org-search-forward-unenclosed "[ \t]\\(\\[[ X]\\]\\)" end t) - (equal (match-string 1) "[X]")))) + (equal (match-string 0) "[X]")))) (while (< (point) end) (if toggle-presence (cond @@ -1067,9 +1068,9 @@ text below the heading." (goto-char (match-end 0)) (insert "[ ] ")))) (when (org-at-item-checkbox-p) - (setq status (equal (match-string 0) "[X]")) + (setq status (equal (match-string 1) "[X]")) (replace-match - (if first-status "[ ]" "[X]") t t))) + (if first-status "[ ]" "[X]") t t nil 1))) (beginning-of-line 2))))) (org-update-checkbox-count-maybe)) @@ -1084,7 +1085,7 @@ text below the heading." (let ((end (point-max))) (while (< (point) end) (when (org-at-item-checkbox-p) - (replace-match "[ ]" t t)) + (replace-match "[ ]" t t nil 1)) (beginning-of-line 2)))) (org-update-checkbox-count-maybe))) From 9e3b3d023d01309ad8732d6306bdb2ecfd64e90d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 19:16:37 +0200 Subject: [PATCH 154/348] List follows indentation of its top item. * org-list.el (org-indent-item-tree): moving indentation of top list item will make the whole list move. * org-list.el (org-apply-on-list): function is less sensitive to changes of indentation. Before this patch, cycling indentation of top list item would just break list. Now, it does something useful. --- lisp/org-list.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 7dd8a94b4..b04c072c8 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -781,9 +781,10 @@ If NO-SUBTREE is set, only indent the item itself, not its children." end org-last-indent-end-marker) (org-beginning-of-item) (setq beg (move-marker org-last-indent-begin-marker (point))) - (if no-subtree - (org-end-of-item-text-before-children) - (org-end-of-item)) + (cond + ((= (point-at-bol) (org-list-top-point)) (goto-char (org-list-bottom-point))) + (no-subtree (org-end-of-item-text-before-children)) + (t (org-end-of-item))) (setq end (move-marker org-last-indent-end-marker (or end (point))))) (goto-char beg) (setq ind-bul (org-item-indent-positions) @@ -1234,14 +1235,14 @@ will return the number of items in the current list. Sublists of the list are skipped. Cursor is always at the beginning of the item." (save-excursion - (let ((move-down-action + (let ((end (copy-marker (org-end-of-item-list))) + (next-p (make-marker)) + (move-down-action (lambda (pos value &rest args) (goto-char pos) - (let ((return-value (apply function value args)) - ;; we need to recompute each time end of list in case - ;; function modified list. - (next-p (org-get-next-item pos (org-end-of-item-list)))) - (if next-p + (set-marker next-p (org-get-next-item pos end)) + (let ((return-value (apply function value args))) + (if (marker-position next-p) (apply move-down-action next-p return-value args) return-value))))) (apply move-down-action (org-beginning-of-item-list) init-value args)))) From fb7183c619d6af216bb6d0983d61930b61790122 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 19:26:51 +0200 Subject: [PATCH 155/348] Forgot a `save-excursion' in `org-apply-on-list'. --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b04c072c8..29ec67e69 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1235,7 +1235,7 @@ will return the number of items in the current list. Sublists of the list are skipped. Cursor is always at the beginning of the item." (save-excursion - (let ((end (copy-marker (org-end-of-item-list))) + (let ((end (copy-marker (save-excursion (org-end-of-item-list)))) (next-p (make-marker)) (move-down-action (lambda (pos value &rest args) From a42f8066d4ebdbb48713df7b8ad21c8a6f4669ee Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 19 Jul 2010 21:07:05 +0200 Subject: [PATCH 156/348] Can't insert new item after `org-list-bottom-point' anymore. --- lisp/org-list.el | 3 ++- lisp/org-timer.el | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 29ec67e69..614d2741b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -697,7 +697,8 @@ new item will be created before the current one. Return t when things worked, nil when we are not in an item, or item is invisible." (unless (or (not (org-in-item-p)) - (org-invisible-p)) + (org-invisible-p) + (< (org-list-bottom-point) (point))) (if (save-excursion (org-beginning-of-item) (org-at-item-timer-p)) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 33c4c0bb0..e6b4402ab 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -203,7 +203,8 @@ it in the buffer." (cond ;; In a timer list, insert with `org-list-insert-item-generic'. ((and (org-in-item-p) - (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) + (save-excursion (org-beginning-of-item) (org-at-item-timer-p)) + (>= (org-list-bottom-point) (point))) (org-list-insert-item-generic (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) ;; In a list of another type, don't break anything: throw an error. From 8241e9b652404cadaba82780ea8dd94d329fd7e5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 01:20:56 +0200 Subject: [PATCH 157/348] Refactoring. --- lisp/org-list.el | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 614d2741b..6e74e1304 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1350,12 +1350,9 @@ sublevels as a list of strings." (while (org-search-forward-unenclosed (org-item-re) end t) (save-excursion (beginning-of-line) - (cond ((looking-at-p "^[ \t]*[0-9]") - (setq itemsep "[0-9]+\\(?:\\.\\|)\\)" - ltype 'ordered)) - ((org-at-description-p) - (setq itemsep "[-+*]" ltype 'descriptive)) - (t (setq itemsep "[-+*]" ltype 'unordered)))) + (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered) + ((org-at-description-p) 'descriptive) + (t 'unordered)))) (let* ((indent1 (org-get-indentation)) (nextitem (or (org-get-next-item (point) end) end)) (item (org-trim (buffer-substring (point) (org-end-of-item-text-before-children)))) From 42f82d1bad20dcf00304c146e2e15bebad5fe4f9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 11:06:35 +0200 Subject: [PATCH 158/348] Descriptions items shouldn't be numbered. * org-list.el (org-cycle-list-bullet): prevent description items from being numbered. String argument is also recognized now, as long as it is a valid bullet. --- lisp/org-list.el | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6e74e1304..53bc86b88 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -975,36 +975,40 @@ doing the renumbering." (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: +This cycle the entire list level through nnthe sequence: - `-' -> `+' -> `*' -> `1.' -> `1)' + `-' -> `+' -> `*' -> `1.' -> `1)' -If WHICH is a string, use that as the new bullet. If WHICH is an integer, -0 means `-', 1 means `+' etc." +If WHICH is a valid string, use that as the new bullet. If WHICH +is an integer, 0 means `-', 1 means `+' etc." (interactive "P") (org-preserve-lc - (let* ((current (progn - (org-beginning-of-item-list) - (org-at-item-p) - (match-string 0))) - (prevp (eq which 'previous)) + (let* ((bullet (progn (org-beginning-of-item-list) + (org-get-bullet))) + (current (cond + ((string-match "\\." bullet) "1.") + ((string-match ")" bullet) "1)") + (t bullet))) + ;; Description items cannot be numbered + (bullet-list (if (org-at-description-p) + '("-" "+" "*") + '("-" "+" "*" "1." "1)"))) + ;; *-bullets are not allowed at column 0 + (bullet-list (if (looking-at "\\S-") + (remove "*" bullet-list) + bullet-list)) + (item-pos (member current bullet-list)) (new (cond ((and (numberp which) - (nth (1- which) '("-" "+" "*" "1." "1)")))) - ((string-match "-" current) (if prevp "1)" "+")) - ((string-match "\\+" current) - (if prevp "-" (if (looking-at "\\S-") "1." "*"))) - ((string-match "\\*" current) (if prevp "+" "1.")) - ((string-match "\\." current) - (if prevp (if (looking-at "\\S-") "+" "*") "1)")) - ((string-match ")" current) (if prevp "1." "-")) - (t (error "This should not happen")))) + (nth (mod which (length bullet-list)) bullet-list))) + ((member which bullet-list) which) + ((and item-pos (cdr item-pos)) (cadr item-pos)) + (t "-"))) (old (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)") (match-string 2)))) (replace-match (concat "\\1" new)) (org-shift-item-indentation (- (length new) (length old))) - (org-fix-bullet-type) - (org-maybe-renumber-ordered-list)))) + (org-fix-bullet-type)))) ;;; Checkboxes From eebd8eb022d1760a392e911fd4c50c366a8b783d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 11:47:54 +0200 Subject: [PATCH 159/348] Fixed bug in `org-in-item-p' with point at an heading just beyond list. * org-list.el (org-in-item-p): Handle case when point is at an heading. * org-list.el (org-list-make-subtree): Add protection when used outside of list * org-list.el (org-insert-item): Removed useless hack now `org-in-item-p' is fixed. * org-timer.el (org-timer-item): Removed useless hack now `org-in-item-p' is fixed. --- lisp/org-list.el | 28 +++++++++++++++------------- lisp/org-timer.el | 3 +-- 2 files changed, 16 insertions(+), 15 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 53bc86b88..f533f58b2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -420,7 +420,8 @@ function ends." (defun org-in-item-p () "Is the cursor inside a plain list ?" - (save-excursion + (unless (org-at-heading-p) + (save-excursion ;; Move to eol so that current line can be matched by ;; `org-item-re'. (let* ((limit (save-excursion (outline-previous-heading))) @@ -432,7 +433,7 @@ function ends." ;; an item before and there is no valid list ender between us ;; and the item found. (and last-item-start - (not list-ender))))) + (not list-ender)))))) (defun org-first-list-item-p () "Is this heading the first item in a plain list?" @@ -697,8 +698,7 @@ new item will be created before the current one. Return t when things worked, nil when we are not in an item, or item is invisible." (unless (or (not (org-in-item-p)) - (org-invisible-p) - (< (org-list-bottom-point) (point))) + (org-invisible-p)) (if (save-excursion (org-beginning-of-item) (org-at-item-timer-p)) @@ -1383,15 +1383,17 @@ sublevels as a list of strings." (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) - (goto-char (org-list-top-point)) - (let ((list (org-list-parse-list t)) nstars) - (save-excursion - (if (ignore-errors - (org-back-to-heading)) - (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t) - (setq nstars (length (match-string 1)))) - (setq nstars 0))) - (org-list-make-subtrees list (1+ nstars)))) + (if (not (org-in-item-p)) + (error "Not in a list.") + (goto-char (org-list-top-point)) + (let ((list (org-list-parse-list t)) nstars) + (save-excursion + (if (ignore-errors + (org-back-to-heading)) + (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t) + (setq nstars (length (match-string 1)))) + (setq nstars 0))) + (org-list-make-subtrees list (1+ nstars))))) (defun org-list-make-subtrees (list level) "Convert LIST into subtrees starting at LEVEL." diff --git a/lisp/org-timer.el b/lisp/org-timer.el index e6b4402ab..33c4c0bb0 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -203,8 +203,7 @@ it in the buffer." (cond ;; In a timer list, insert with `org-list-insert-item-generic'. ((and (org-in-item-p) - (save-excursion (org-beginning-of-item) (org-at-item-timer-p)) - (>= (org-list-bottom-point) (point))) + (save-excursion (org-beginning-of-item) (org-at-item-timer-p))) (org-list-insert-item-generic (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) ;; In a list of another type, don't break anything: throw an error. From 3a084384f4f83e32cb4d16d67ee0b98624248535 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 12:01:10 +0200 Subject: [PATCH 160/348] Refactoring. --- lisp/org-list.el | 21 +++++++-------------- 1 file changed, 7 insertions(+), 14 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index f533f58b2..c0c7767d8 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -989,26 +989,19 @@ is an integer, 0 means `-', 1 means `+' etc." ((string-match "\\." bullet) "1.") ((string-match ")" bullet) "1)") (t bullet))) - ;; Description items cannot be numbered - (bullet-list (if (org-at-description-p) - '("-" "+" "*") - '("-" "+" "*" "1." "1)"))) - ;; *-bullets are not allowed at column 0 - (bullet-list (if (looking-at "\\S-") - (remove "*" bullet-list) - bullet-list)) + (bullet-list (append '("-" "+" ) + ;; *-bullets are not allowed at column 0 + (unless (looking-at "\\S-") '("*")) + ;; Description items cannot be numbered + (unless (org-at-description-p) '("1." "1)")))) (item-pos (member current bullet-list)) (new (cond ((and (numberp which) (nth (mod which (length bullet-list)) bullet-list))) ((member which bullet-list) which) ((and item-pos (cdr item-pos)) (cadr item-pos)) - (t "-"))) - (old (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)") - (match-string 2)))) - (replace-match (concat "\\1" new)) - (org-shift-item-indentation (- (length new) (length old))) - (org-fix-bullet-type)))) + (t "-")))) + (org-fix-bullet-type new)))) ;;; Checkboxes From 0bac5c248bccbb2179c6ae2704ef85b3387ac477 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 12:36:01 +0200 Subject: [PATCH 161/348] Forgot to handle 'previous argument in `org-cycle-list-bullet'. * org-list.el (org-cycle-list-bullet): Put back support for 'previous argument. --- lisp/org-list.el | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c0c7767d8..7abc4150d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -975,12 +975,13 @@ doing the renumbering." (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through nnthe sequence: +This cycle the entire list level through the sequence: `-' -> `+' -> `*' -> `1.' -> `1)' If WHICH is a valid string, use that as the new bullet. If WHICH -is an integer, 0 means `-', 1 means `+' etc." +is an integer, 0 means `-', 1 means `+' etc. If WHICH is +'previous, cycle backwards." (interactive "P") (org-preserve-lc (let* ((bullet (progn (org-beginning-of-item-list) @@ -994,13 +995,13 @@ is an integer, 0 means `-', 1 means `+' etc." (unless (looking-at "\\S-") '("*")) ;; Description items cannot be numbered (unless (org-at-description-p) '("1." "1)")))) - (item-pos (member current bullet-list)) + (len (length bullet-list)) + (item-pos (or (and (numberp which) which) + (- len (length (member current bullet-list))))) (new (cond - ((and (numberp which) - (nth (mod which (length bullet-list)) bullet-list))) ((member which bullet-list) which) - ((and item-pos (cdr item-pos)) (cadr item-pos)) - (t "-")))) + ((eq 'previous which) (nth (mod (1- item-pos) len) bullet-list)) + (t (nth (mod (1+ item-pos) len) bullet-list))))) (org-fix-bullet-type new)))) ;;; Checkboxes From 5b9857da7cb1b4c1d8c816ea2c026280e3577a88 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 12:49:35 +0200 Subject: [PATCH 162/348] Minor fix. --- lisp/org-list.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 7abc4150d..ed956c292 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -996,10 +996,10 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ;; Description items cannot be numbered (unless (org-at-description-p) '("1." "1)")))) (len (length bullet-list)) - (item-pos (or (and (numberp which) which) - (- len (length (member current bullet-list))))) + (item-pos (- len (length (member current bullet-list)))) (new (cond ((member which bullet-list) which) + ((numberp which) (nth (mod which len) bullet-list)) ((eq 'previous which) (nth (mod (1- item-pos) len) bullet-list)) (t (nth (mod (1+ item-pos) len) bullet-list))))) (org-fix-bullet-type new)))) From 3d3e307c31f78f587130fcef9c236ba013b3cb67 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 15:58:48 +0200 Subject: [PATCH 163/348] Fix list folding. Refactoring. --- lisp/org-list.el | 129 ++++++++++++++++++++--------------------------- 1 file changed, 55 insertions(+), 74 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index ed956c292..1ec46c7ae 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -271,12 +271,12 @@ the end of the nearest terminator from max." (cond ;; nothing found: return nil ((not (funcall search-fun regexp bound noerror count)) nil) - ;; match is enclosed or protected: start again, searching one - ;; more occurrence away. ((or (save-match-data (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) (get-text-property (match-beginning 0) 'org-protected)) + ;; match is enclosed or protected: start again, searching one + ;; occurrence away. (goto-char origin) (org-list-search-unenclosed-generic search-fun regexp bound noerror (1+ count))) ;; else return point. @@ -301,23 +301,18 @@ the end of the nearest terminator from max." (defun org-list-get-item-same-level (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. Search items using function SEARCH-FUN, from POS to LIMIT. It -uses PRE-MOVE before searches. Return nil if no item was found. - -Internal use only. Prefer `org-get-next-item' and -`org-get-previous-item' for cleaner code." +uses PRE-MOVE before search. Return nil if no item was found." (save-excursion - (when pos (goto-char pos)) - (let ((begin (point)) - (ind (progn + (goto-char pos) + (let ((ind (progn (org-beginning-of-item) (org-get-indentation))) (start (point-at-bol))) - ;; we don't want to match the current line. + ;; We don't want to match the current line. (funcall pre-move) ;; Skip any sublist on the way (while (and (funcall search-fun (org-item-re) limit t) - (> (org-get-indentation) ind)) - (funcall pre-move)) + (> (org-get-indentation) ind))) (when (and (/= (point-at-bol) start) ; Have we moved ? (= (org-get-indentation) ind)) (point-at-bol))))) @@ -357,31 +352,26 @@ function ends." (let ((insert-blank-p (cdr (assq 'plain-list-item org-blank-before-new-entry)))) (cond - ((or - org-empty-line-terminates-plain-lists - (not insert-blank-p)) - 0) + ((or org-empty-line-terminates-plain-lists + (not insert-blank-p)) 0) ((eq insert-blank-p t) 1) ;; plain-list-item is 'auto. Count blank lines separating ;; neighbours items in list. - (t - (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (cond - ;; Is there a next item? - (next-p (goto-char next-p) - (org-back-over-empty-lines)) - ;; Is there a previous item? - ((not (org-first-list-item-p)) (org-back-over-empty-lines)) - ;; no luck: item is alone. Use default value. - (t 1))))))) + (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((not (org-first-list-item-p)) (org-back-over-empty-lines)) + ;; no luck: item is alone. Use default value. + (t 1))))))) (insert-fun (lambda (text) ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. (org-beginning-of-item) - (insert (concat bullet - (when checkbox "[ ] ") - after-bullet)) + (insert (concat bullet (when checkbox "[ ] ") after-bullet)) ;; Stay between after-bullet and before text. (save-excursion (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) @@ -389,11 +379,10 @@ function ends." (when checkbox (org-update-checkbox-count-maybe))))) (goto-char true-pos) (cond - (before-p - (funcall insert-fun nil) - ;; Not taking advantage of renumbering while moving down. Need - ;; to call it directly. - (org-maybe-renumber-ordered-list) t) + (before-p (funcall insert-fun nil) + ;; Not taking advantage of renumbering while moving + ;; down. Need to call it directly. + (org-maybe-renumber-ordered-list) t) ;; Can't split item: insert bullet at the end of item. ((not (org-get-alist-option org-M-RET-may-split-line 'item)) (funcall insert-fun nil) t) @@ -420,20 +409,19 @@ function ends." (defun org-in-item-p () "Is the cursor inside a plain list ?" - (unless (org-at-heading-p) + (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) (save-excursion - ;; Move to eol so that current line can be matched by - ;; `org-item-re'. - (let* ((limit (save-excursion (outline-previous-heading))) - (actual-pos (goto-char (point-at-eol))) - (last-item-start (save-excursion - (org-search-backward-unenclosed (org-item-re) limit t))) - (list-ender (org-list-terminator-between last-item-start actual-pos))) - ;; We are in a list when we are on an item line or we can find - ;; an item before and there is no valid list ender between us - ;; and the item found. - (and last-item-start - (not list-ender)))))) + (let* ((limit (save-excursion (outline-previous-heading))) + ;; Move to eol so current line can be matched by `org-item-re'. + (actual-pos (goto-char (point-at-eol))) + (last-item-start (save-excursion + (org-search-backward-unenclosed (org-item-re) limit t))) + (list-ender (org-list-terminator-between last-item-start actual-pos))) + ;; We are in a list when we are on an item line or when we can + ;; find an item before point and there is no valid list ender + ;; between it and the point. + (and last-item-start + (not list-ender)))))) (defun org-first-list-item-p () "Is this heading the first item in a plain list?" @@ -604,9 +592,7 @@ Return point." (let ((prev-p (org-get-previous-item pos bound))) ;; recurse until no more item of the same level ;; can be found. - (if prev-p - (funcall move-up prev-p bound) - pos))))) + (if prev-p (funcall move-up prev-p bound) pos))))) ;; Go to the last item found and at bol in case we didn't move (goto-char (funcall move-up (point) limit)) (goto-char (point-at-bol)))) @@ -623,9 +609,7 @@ Return point." (let ((next-p (org-get-next-item pos bound))) ;; recurse until no more item of the same level ;; can be found. - (if next-p - (funcall get-last-item next-p bound) - pos))))) + (if next-p (funcall get-last-item next-p bound) pos))))) ;; Move to the last item of every list or sublist encountered, and ;; down to bol of a higher-level item, or limit. (while (and (/= (point) limit) @@ -886,11 +870,8 @@ Assumes cursor in item line." ;;; Bullets (defun org-get-bullet () - (save-excursion - (goto-char (point-at-bol)) - (and (looking-at - "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)") - (or (match-string 2) (match-string 4))))) + (and (org-at-item-p) + (org-trim (match-string 1)))) (defun org-fix-bullet-type (&optional force-bullet) "Make sure all items in this list have the same bullet as the first item. @@ -898,23 +879,22 @@ Also, fix the indentation." (interactive) (unless (org-at-item-p) (error "This is not a list")) (org-preserve-lc - (let* ((bullet + (let* ((ini-bul (progn (org-beginning-of-item-list) (org-get-bullet))) + (bullet (progn - (org-beginning-of-item-list) - (looking-at "[ \t]*\\(\\S-+\\)") - (concat (or force-bullet (match-string 1)) " " - ;; Do we need to concat another white space ? - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - " ")))) + (concat + (or force-bullet ini-bul) " " + ;; Do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp ini-bul)) + " ")))) (replace-bullet (lambda (result bullet) (let* ((old (progn - (skip-chars-forward " \t") - (looking-at "\\S-+ *") - (match-string 0)))) + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (match-string 1)))) (unless (equal bullet old) - (replace-match bullet) + (replace-match bullet nil nil nil 1) ;; When bullet lengths are differents, move the whole ;; sublist accordingly (org-shift-item-indentation (- (length bullet) (length old)))))))) @@ -996,12 +976,13 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ;; Description items cannot be numbered (unless (org-at-description-p) '("1." "1)")))) (len (length bullet-list)) - (item-pos (- len (length (member current bullet-list)))) + (item-index (- len (length (member current bullet-list)))) + (get-value (lambda (index) (nth (mod index len) bullet-list))) (new (cond ((member which bullet-list) which) - ((numberp which) (nth (mod which len) bullet-list)) - ((eq 'previous which) (nth (mod (1- item-pos) len) bullet-list)) - (t (nth (mod (1+ item-pos) len) bullet-list))))) + ((numberp which) (funcall get-value which)) + ((eq 'previous which) (funcall get-value (1- item-index))) + (t (funcall get-value (1+ item-index)))))) (org-fix-bullet-type new)))) ;;; Checkboxes From ff6c147ac67c4fa361ddb833abf22bf264a2e531 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 20 Jul 2010 21:13:37 +0200 Subject: [PATCH 164/348] Defined `org-item-beginning-re'. Org capture should recognize new lists. * org-capture.el (org-capture-place-item): use `org-search-forward-unenclosed' and `org-search-backward-unenclosed' and new variable `org-item-beginning-re'. * org-list.el (org-item-beginning-re): regexp matching beginning of an item. --- lisp/org-capture.el | 4 ++-- lisp/org-exp.el | 2 +- lisp/org-latex.el | 2 +- lisp/org-list.el | 29 ++++++++++++++++------------- 4 files changed, 20 insertions(+), 17 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 21480d835..2e2a34fa1 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -744,14 +744,14 @@ already gone." (if (org-capture-get :prepend) (progn (goto-char beg) - (if (re-search-forward (concat "^" (org-item-re)) end t) + (if (org-search-forward-unenclosed org-item-beginning-re end t) (progn (goto-char (match-beginning 0)) (setq ind (org-get-indentation))) (goto-char end) (setq ind 0))) (goto-char end) - (if (re-search-backward (concat "^" (org-item-re)) beg t) + (if (org-search-backward-unenclosed org-item-beginning-re beg t) (progn (setq ind (org-get-indentation)) (org-end-of-item)) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 2665f9641..2151b7a7e 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1636,7 +1636,7 @@ These special cookies will later be interpreted by the backend. (let ((process-buffer (lambda (end-list-marker) (goto-char (point-min)) - (while (org-search-forward-unenclosed (org-item-re) nil t) + (while (org-search-forward-unenclosed org-item-beginning-re nil t) (goto-char (org-list-bottom-point)) (when (looking-at (org-list-end-re)) (replace-match "\n")) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index b7b4f39b8..bdabcdc22 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2238,7 +2238,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." "Convert plain text lists in current buffer into LaTeX lists." (let (res) (goto-char (point-min)) - (while (org-search-forward-unenclosed (org-item-re) nil t) + (while (org-search-forward-unenclosed org-item-beginning-re nil t) (beginning-of-line) (setq res (org-list-to-latex (org-list-parse-list t) org-export-latex-list-parameters)) diff --git a/lisp/org-list.el b/lisp/org-list.el index 1ec46c7ae..444d8e19e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -244,6 +244,9 @@ of `org-plain-list-ordered-item-terminator'." "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) +(defconst org-item-beginning-re (concat "^" (org-item-re)) + "Regexp matching the beginning of a plain list item.") + (defun org-list-terminator-between (min max &optional firstp) "Find the position of a list ender between MIN and MAX, or nil. This function looks for `org-list-end-re' not matching a block. @@ -311,7 +314,7 @@ uses PRE-MOVE before search. Return nil if no item was found." ;; We don't want to match the current line. (funcall pre-move) ;; Skip any sublist on the way - (while (and (funcall search-fun (org-item-re) limit t) + (while (and (funcall search-fun org-item-beginning-re limit t) (> (org-get-indentation) ind))) (when (and (/= (point-at-bol) start) ; Have we moved ? (= (org-get-indentation) ind)) @@ -337,7 +340,7 @@ function ends." (end-of-line 0)) (let* ((true-pos (point)) (bullet (and (org-beginning-of-item) - (looking-at (org-item-re)) + (looking-at org-item-beginning-re) (match-string 0))) (before-p (progn ;; Description item: text starts after colons. @@ -415,7 +418,7 @@ function ends." ;; Move to eol so current line can be matched by `org-item-re'. (actual-pos (goto-char (point-at-eol))) (last-item-start (save-excursion - (org-search-backward-unenclosed (org-item-re) limit t))) + (org-search-backward-unenclosed org-item-beginning-re limit t))) (list-ender (org-list-terminator-between last-item-start actual-pos))) ;; We are in a list when we are on an item line or when we can ;; find an item before point and there is no valid list ender @@ -434,7 +437,7 @@ function ends." "Is point in a line starting a hand-formatted item?" (save-excursion (goto-char (point-at-bol)) - (looking-at (org-item-re)))) + (looking-at org-item-beginning-re))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -487,7 +490,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;; Otherwise, go back to the heading above or bob. (goto-char (or (org-list-terminator-between bound pos) bound)) ;; From there, search down our list. - (org-search-forward-unenclosed (org-item-re) pos t) + (org-search-forward-unenclosed org-item-beginning-re pos t) (point-at-bol))))) (defun org-list-bottom-point () @@ -515,7 +518,7 @@ If the cursor is not in an item, throw an error. Return point." (error "Not in an item") ;; Possibly match the current line. (end-of-line) - (org-search-backward-unenclosed (org-item-re) nil t) + (org-search-backward-unenclosed org-item-beginning-re nil t) (goto-char (point-at-bol)))) (defun org-end-of-item () @@ -536,7 +539,7 @@ Assumes that the cursor is in the first line of an item." (let ((limit (org-list-bottom-point))) (end-of-line) (goto-char - (if (org-search-forward-unenclosed (org-item-re) limit t) + (if (org-search-forward-unenclosed org-item-beginning-re limit t) (point-at-bol) limit)))) @@ -616,7 +619,7 @@ Return point." (>= (org-get-indentation) ind)) (goto-char (funcall get-last-item (point) limit)) (end-of-line) - (when (org-search-forward-unenclosed (org-item-re) limit 'move) + (when (org-search-forward-unenclosed org-item-beginning-re limit 'move) (beginning-of-line))) (point))) @@ -824,7 +827,7 @@ Assumes cursor in item line." (cond ((and (ignore-errors (progn (org-previous-item) t)) (or (end-of-line) t) - (org-search-forward-unenclosed (org-item-re) bolpos t)) + (org-search-forward-unenclosed org-item-beginning-re bolpos t)) (setq ind-down (org-get-indentation) bullet-down (org-get-bullet))) ((and (goto-char pos) @@ -924,7 +927,7 @@ with something like \"1.\" or \"2)\". Start to count at ARG or 1." (renumber-item (lambda (counter off fmt) (let* ((new (format fmt (+ counter off))) (old (progn - (looking-at (org-item-re)) + (looking-at org-item-beginning-re) (match-string 2))) (begin (match-beginning 2)) (end (match-end 2))) @@ -1156,7 +1159,7 @@ the whole buffer." ;; with proper limit. (goto-char (or (org-get-next-item (point) lim) lim)) (end-of-line) - (when (org-search-forward-unenclosed (org-item-re) lim t) + (when (org-search-forward-unenclosed org-item-beginning-re lim t) (beginning-of-line))) (setq next-ind (org-get-indentation))))) (goto-char continue-from) @@ -1326,7 +1329,7 @@ sublevels as a list of strings." (let* ((start (goto-char (org-list-top-point))) (end (org-list-bottom-point)) output itemsep ltype) - (while (org-search-forward-unenclosed (org-item-re) end t) + (while (org-search-forward-unenclosed org-item-beginning-re end t) (save-excursion (beginning-of-line) (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered) @@ -1419,7 +1422,7 @@ this list." (top-point (progn (re-search-backward "#\\+ORGLST" nil t) - (re-search-forward (org-item-re) bottom-point t) + (re-search-forward org-item-beginning-re bottom-point t) (match-beginning 0))) (list (save-restriction (narrow-to-region top-point bottom-point) From 2c3157e34e9f9e63afe3f62b423bdbdf4c8859ca Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 21 Jul 2010 11:18:31 +0200 Subject: [PATCH 165/348] Better guessing of blank lines when inserting an item. * org-list.el (org-list-insert-item-generic): When local search doesn't help, search the list globally for blank lines. Moreover, don't bother with new lists, and add 1 blank line. --- lisp/org-list.el | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 444d8e19e..39f9021b0 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -355,9 +355,17 @@ function ends." (let ((insert-blank-p (cdr (assq 'plain-list-item org-blank-before-new-entry)))) (cond + ;; Trivial cases where there should be none. ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0) - ((eq insert-blank-p t) 1) + ;; When `org-blank-before-new-entry' says so, or item is + ;; alone in the whole list, it is 1. + ((or (eq insert-blank-p t) + (save-excursion + (goto-char (org-list-top-point)) + (end-of-line) + (not (org-search-forward-unenclosed + org-item-beginning-re (org-list-bottom-point) t)))) 1) ;; plain-list-item is 'auto. Count blank lines separating ;; neighbours items in list. (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) @@ -367,8 +375,13 @@ function ends." (org-back-over-empty-lines)) ;; Is there a previous item? ((not (org-first-list-item-p)) (org-back-over-empty-lines)) - ;; no luck: item is alone. Use default value. - (t 1))))))) + ;; Local search failed: search globally. + ((and (goto-char (org-list-bottom-point)) + (beginning-of-line 0) + (org-search-backward-unenclosed "^[ \t]*$" (org-list-top-point) t)) + (1+ (org-back-over-empty-lines))) + ;; No blank line found in the whole list. + (t 0))))))) (insert-fun (lambda (text) ;; insert bullet above item in order to avoid bothering From 4c9eb76846f56d9dc5d8fcea35cc78ff632fa97e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 21 Jul 2010 11:26:44 +0200 Subject: [PATCH 166/348] Do not indent the first item in a sublist. * org-list.el (org-indent-item-tree): It shouldn't be possible to indent the first item of a sublist (though outdent is possible) as it would break list's structure. --- lisp/org-list.el | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 39f9021b0..44e229b6a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -772,7 +772,7 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (let ((origin-ind (save-excursion (goto-char (org-list-top-point)) (org-get-indentation))) - beg end ind ind1 ind-bul delta ind-down ind-up firstp) + beg end ind ind1 ind-pos bullet delta ind-down ind-up firstp) (setq firstp (org-first-list-item-p)) (save-excursion (setq end (and (org-region-active-p) (region-end))) @@ -783,24 +783,36 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (org-beginning-of-item) (setq beg (move-marker org-last-indent-begin-marker (point))) (cond + ;; Top-item: reindent all down to end of list. ((= (point-at-bol) (org-list-top-point)) (goto-char (org-list-bottom-point))) + ;; No-subtree: reindent down to next children, if any. (no-subtree (org-end-of-item-text-before-children)) + ;; Else: reindent down to next item. (t (org-end-of-item))) (setq end (move-marker org-last-indent-end-marker (or end (point))))) (goto-char beg) - (setq ind-bul (org-item-indent-positions) - ind (caar ind-bul) - ind-down (car (nth 2 ind-bul)) - ind-up (car (nth 1 ind-bul)) + (setq ind-pos (org-item-indent-positions) + bullet (cdr (car ind-pos)) + ind (caar ind-pos) + ind-down (car (nth 2 ind-pos)) + ind-up (car (nth 1 ind-pos)) delta (if (> arg 0) (if ind-down (- ind-down ind) 2) (if ind-up (- ind-up ind) -2))) (cond + ;; Going to a negative column is nonsensical. ((< (+ delta ind) 0) (error "Cannot outdent beyond margin")) + ;; Do not indent before top-item, unless point is at top-item. ((and (< (+ delta ind) origin-ind) - ;; verify we're not at the top level item (/= (point-at-bol) (org-list-top-point))) - (error "Cannot outdent beyond top level item"))) + (error "Cannot outdent beyond top level item")) + ((and firstp (> delta 0) (/= (point-at-bol) (org-list-top-point))) + (error "Cannot indent the beginning of a sublist")) + ;; If *-list is going to column 0, prevent mixing items and + ;; headings by changing bullet to "-". + ((and (= (+ delta ind) 0) (equal bullet "*")) + (org-fix-bullet-type "-"))) + ;; Proceed to reindentation. (while (< (point) end) (beginning-of-line) (skip-chars-forward " \t") (setq ind1 (current-column)) @@ -810,8 +822,7 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (org-fix-bullet-type (and (> arg 0) (not firstp) - (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet)))) - (org-maybe-renumber-ordered-list-safe) + (cdr (assoc bullet org-list-demote-modify-bullet)))) (save-excursion (beginning-of-line 0) (ignore-errors (org-beginning-of-item)) From aed0cb3b9e6fe4d1ffd2f1cae51a998c7376eeb5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 21 Jul 2010 11:40:06 +0200 Subject: [PATCH 167/348] `org-maybe-renumber-ordered-list' do not call `org-fix-bullet-type'. * org-list.el (org-maybe-renumber-ordered-list): Removed call for `org-fix-bullet-type' to prevent infinite loop, and some checks already done in `org-renumber-ordered-list'. * org-list.el (org-fix-bullet-type): Remove a check and call directly `org-maybe-renumber-ordered-list' --- lisp/org-list.el | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 44e229b6a..52875b430 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -926,8 +926,7 @@ Also, fix the indentation." ;; sublist accordingly (org-shift-item-indentation (- (length bullet) (length old)))))))) (org-apply-on-list replace-bullet nil bullet) - ;; Fix item numbers if necessary - (when (string-match "[0-9]" bullet) (org-renumber-ordered-list))))) + (org-maybe-renumber-ordered-list)))) (defun org-renumber-ordered-list (&optional arg) "Renumber an ordered plain list. @@ -969,11 +968,8 @@ with something like \"1.\" or \"2)\". Start to count at ARG or 1." This tests the user option `org-auto-renumber-ordered-lists' before doing the renumbering." (interactive) - (when (and org-auto-renumber-ordered-lists - (org-at-item-p)) - (if (match-beginning 3) - (org-renumber-ordered-list 1) - (org-fix-bullet-type)))) + (when org-auto-renumber-ordered-lists + (org-renumber-ordered-list))) (defun org-maybe-renumber-ordered-list-safe () (ignore-errors From 19372845f9e60eebd21101253e75f257d137725c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 21 Jul 2010 12:14:52 +0200 Subject: [PATCH 168/348] Melt `org-maybe-renumber-ordered-list-safe' into `org-maybe-renumber-ordered-list'. --- lisp/org-list.el | 11 +++-------- 1 file changed, 3 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 52875b430..076fa0224 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -826,7 +826,7 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (save-excursion (beginning-of-line 0) (ignore-errors (org-beginning-of-item)) - (org-maybe-renumber-ordered-list-safe)))) + (org-maybe-renumber-ordered-list)))) (defun org-item-indent-positions () "Return indentation for plain list items. @@ -966,15 +966,10 @@ with something like \"1.\" or \"2)\". Start to count at ARG or 1." (defun org-maybe-renumber-ordered-list () "Renumber the ordered list at point if setup allows it. This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering." +doing the renumbering. Do not throw error on failure." (interactive) (when org-auto-renumber-ordered-lists - (org-renumber-ordered-list))) - -(defun org-maybe-renumber-ordered-list-safe () - (ignore-errors - (save-excursion - (org-maybe-renumber-ordered-list)))) + (ignore-errors (org-renumber-ordered-list)))) (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. From 0a14598575faa9609d7a26b3e5909a73a3582b25 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 21 Jul 2010 18:43:47 +0200 Subject: [PATCH 169/348] Added a rule for indentation and improved reordering. * org-list.el (org-indent-item-tree): If indent rule is activated, it should be impossible to outdent an item having children without moving its subtree. Improved reordering of lists modified by cycling indentation. --- lisp/org-list.el | 42 +++++++++++++++++++++++++++++------------- 1 file changed, 29 insertions(+), 13 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 076fa0224..48f025309 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -802,16 +802,26 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (cond ;; Going to a negative column is nonsensical. ((< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - ;; Do not indent before top-item, unless point is at top-item. - ((and (< (+ delta ind) origin-ind) - (/= (point-at-bol) (org-list-top-point))) - (error "Cannot outdent beyond top level item")) - ((and firstp (> delta 0) (/= (point-at-bol) (org-list-top-point))) - (error "Cannot indent the beginning of a sublist")) - ;; If *-list is going to column 0, prevent mixing items and - ;; headings by changing bullet to "-". - ((and (= (+ delta ind) 0) (equal bullet "*")) - (org-fix-bullet-type "-"))) + ;; Apply indent rules if activated. + ((cdr (assq 'indent org-list-automatic-rules)) + (cond + ;; If at top-point move the whole list. Moreover, if *-list + ;; is going to column 0, change bullet to "-". + ((= (point-at-bol) (org-list-top-point)) + (when (and (= (+ delta ind) 0) (equal bullet "*")) (org-fix-bullet-type "-")) + (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) + ;; Do not indent before top-item. + ((< (+ delta ind) origin-ind) + (error "Cannot outdent beyond top level item")) + ;; Do not indent the first item of a list. + ((and firstp (> delta 0)) + (error "Cannot indent the beginning of a sublist")) + ;; Do not outdent item that has children without moving subtree. + ((and (/= (save-excursion (org-end-of-item-text-before-children)) + (save-excursion (org-end-of-item))) + (< delta 0) + no-subtree) + (error "Cannot outdent an item having children without moving subtree"))))) ;; Proceed to reindentation. (while (< (point) end) (beginning-of-line) @@ -821,11 +831,17 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (beginning-of-line 2))) (org-fix-bullet-type (and (> arg 0) - (not firstp) (cdr (assoc bullet org-list-demote-modify-bullet)))) + ;; Reorder lists that might have changed (save-excursion (beginning-of-line 0) (ignore-errors (org-beginning-of-item)) + (org-maybe-renumber-ordered-list)) + (save-excursion + (org-end-of-item-text-before-children) + (org-maybe-renumber-ordered-list)) + (save-excursion + (org-end-of-item-list) (org-maybe-renumber-ordered-list)))) (defun org-item-indent-positions () @@ -882,8 +898,8 @@ Assumes cursor in item line." (if (eq last-command 'org-cycle-item-indentation) (condition-case nil (progn (org-outdent-item 1) - (if (equal org-tab-ind-state (org-get-indentation)) - (org-outdent-item 1)) + (when (equal org-tab-ind-state (org-get-indentation)) + (org-outdent-item 1)) (end-of-line)) (error (progn From 330c27e4ecec96ea4e3aee9d9e30cabc0489254d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 21 Jul 2010 23:05:03 +0200 Subject: [PATCH 170/348] Fix cycling problems. * org-list.el (org-cycle-item-indentation): cycling should play nicely with indent rule in `org-list-automatic-rules'. --- lisp/org-list.el | 46 ++++++++++++++++++++++++++++------------------ 1 file changed, 28 insertions(+), 18 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 48f025309..c95b84561 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -764,7 +764,8 @@ If NO-SUBTREE is set, only outdent the item itself, not its children." (defun org-indent-item-tree (arg &optional no-subtree) "Indent a local list item including its children. -If NO-SUBTREE is set, only indent the item itself, not its children." +If NO-SUBTREE is set, only indent the item itself, not its +children. Return t if sucessful." (interactive "p") (and (org-region-active-p) (org-cursor-to-region-beginning)) (unless (org-at-item-p) @@ -776,6 +777,7 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (setq firstp (org-first-list-item-p)) (save-excursion (setq end (and (org-region-active-p) (region-end))) + ;; If moving a subtree, don't drain other items on the way. (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) (memq this-command '(org-shiftmetaright org-shiftmetaleft))) (setq beg org-last-indent-begin-marker @@ -842,7 +844,8 @@ If NO-SUBTREE is set, only indent the item itself, not its children." (org-maybe-renumber-ordered-list)) (save-excursion (org-end-of-item-list) - (org-maybe-renumber-ordered-list)))) + (org-maybe-renumber-ordered-list)) + t)) (defun org-item-indent-positions () "Return indentation for plain list items. @@ -887,28 +890,35 @@ Assumes cursor in item line." (cons ind-down bullet-down)))) (defvar org-tab-ind-state) ; defined in org.el + (defun org-cycle-item-indentation () (let ((org-suppress-item-indentation t) (org-adapt-indentation nil)) - (cond - ((and (looking-at "[ \t]*$") - (or (org-at-description-p) (org-at-item-checkbox-p) (org-at-item-p)) - (<= (point) (match-end 0))) + (when (and (looking-at "[ \t]*$") + (org-looking-back (concat org-item-beginning-re "[ \t]*"))) (setq this-command 'org-cycle-item-indentation) + ;; When in the middle of the cycle, try to outdent first. If it + ;; fails, and point is still at initial position, indent. Else, + ;; go back to original position. (if (eq last-command 'org-cycle-item-indentation) - (condition-case nil - (progn (org-outdent-item 1) - (when (equal org-tab-ind-state (org-get-indentation)) - (org-outdent-item 1)) - (end-of-line)) - (error - (progn - (while (< (org-get-indentation) org-tab-ind-state) - (progn (org-indent-item 1) (end-of-line))) - (setq this-command 'org-cycle)))) + (cond + ((ignore-errors (org-indent-item -1))) + ((and (= (org-get-indentation) org-tab-ind-state) + (ignore-errors (org-indent-item 1)))) + (t (back-to-indentation) + (org-indent-to-column org-tab-ind-state) + (end-of-line) + (org-maybe-renumber-ordered-list) + ;; Break cycle + (setq this-command 'identity))) + ;; If a cycle has just started, try to indent first. If it + ;; fails, try to outdent. (setq org-tab-ind-state (org-get-indentation)) - (org-indent-item 1)) - t)))) + (cond + ((ignore-errors (org-indent-item 1))) + ((ignore-errors (org-indent-item -1))) + (t (error "Cannot move item")))))) + t) ;;; Bullets From a13ee91cbe27b0950e8ae596b6601c1645a1b3ea Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 22 Jul 2010 09:29:10 +0200 Subject: [PATCH 171/348] Rules preserving integrity of a list now apply when moving subtree. * org-list.el (org-indent-item-tree): when outdenting a subtree, the last item shouldn't have a children. --- lisp/org-list.el | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c95b84561..7ef7fb045 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -807,23 +807,26 @@ children. Return t if sucessful." ;; Apply indent rules if activated. ((cdr (assq 'indent org-list-automatic-rules)) (cond - ;; If at top-point move the whole list. Moreover, if *-list - ;; is going to column 0, change bullet to "-". + ;; 1. If at top-point move the whole list. Moreover, if + ;; *-list is going to column 0, change bullet to "-". ((= (point-at-bol) (org-list-top-point)) (when (and (= (+ delta ind) 0) (equal bullet "*")) (org-fix-bullet-type "-")) (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) - ;; Do not indent before top-item. + ;; 2. Do not indent before top-item. ((< (+ delta ind) origin-ind) (error "Cannot outdent beyond top level item")) - ;; Do not indent the first item of a list. + ;; 3. Do not indent the first item of a list. ((and firstp (> delta 0)) (error "Cannot indent the beginning of a sublist")) - ;; Do not outdent item that has children without moving subtree. - ((and (/= (save-excursion (org-end-of-item-text-before-children)) - (save-excursion (org-end-of-item))) - (< delta 0) - no-subtree) - (error "Cannot outdent an item having children without moving subtree"))))) + ;; 4. Do not outdent item that has children without moving. + ;; In the case of a subtree, make sure the check applies to + ;; its last item. + ((and (save-excursion + (goto-char (1- end)) + (/= (save-excursion (org-end-of-item-text-before-children)) + (save-excursion (org-end-of-item)))) + (< delta 0)) + (error "Cannot outdent an item having children"))))) ;; Proceed to reindentation. (while (< (point) end) (beginning-of-line) From c4d0151b28f2d13a82025ccfe98df5b06c63b9ce Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 22 Jul 2010 09:47:11 +0200 Subject: [PATCH 172/348] Return value of `org-cycle-item-indentation' was broken. * org-list.el (org-cycle-item-indentation): Do return t if and only if cycling is possible and succeded. --- lisp/org-list.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 7ef7fb045..17f51910f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -920,8 +920,8 @@ Assumes cursor in item line." (cond ((ignore-errors (org-indent-item 1))) ((ignore-errors (org-indent-item -1))) - (t (error "Cannot move item")))))) - t) + (t (error "Cannot move item")))) + t))) ;;; Bullets From ca106beabbe25167cc20797113ecb5a07e999df8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 22 Jul 2010 11:45:49 +0200 Subject: [PATCH 173/348] New function `org-item-has-children-p'. --- lisp/org-list.el | 16 +++++++++++----- lisp/org.el | 4 +++- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 17f51910f..2412d43f5 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -470,6 +470,15 @@ function ends." "Is point at a line starting a plain-list item with a checklet?" (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) +(defun org-item-has-children-p () + "Does the current item have subitems?" + (save-excursion + (org-beginning-of-item) + (let ((ind (org-get-indentation))) + (org-end-of-item-text-before-children) + (and (org-at-item-p) + (> (org-get-indentation) ind))))) + (defun org-checkbox-blocked-p () "Is the current checkbox blocked from for being checked now? A checkbox is blocked if all of the following conditions are fulfilled: @@ -821,11 +830,8 @@ children. Return t if sucessful." ;; 4. Do not outdent item that has children without moving. ;; In the case of a subtree, make sure the check applies to ;; its last item. - ((and (save-excursion - (goto-char (1- end)) - (/= (save-excursion (org-end-of-item-text-before-children)) - (save-excursion (org-end-of-item)))) - (< delta 0)) + ((and (< delta 0) + (save-excursion (goto-char (1- end)) (org-item-has-children-p))) (error "Cannot outdent an item having children"))))) ;; Proceed to reindentation. (while (< (point) end) diff --git a/lisp/org.el b/lisp/org.el index 041a85b29..8103c667f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5902,7 +5902,9 @@ in special contexts. (> (funcall outline-level) level)))) ;; if we're in a list, org-end-of-subtree is in fact org-end-of-item. (if (org-at-item-p) - (setq eos (1- (org-end-of-item))) + (setq eos (if (and (org-end-of-item) (bolp)) + (1- (point)) + (point))) (org-end-of-subtree t) (unless (eobp) (skip-chars-forward " \t\n")) From 91488c75d54b443dc1ffc34fcd504dce51781afa Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 23 Jul 2010 20:36:42 +0200 Subject: [PATCH 174/348] Added variable `org-list-automatic-rules'. --- lisp/org-list.el | 103 ++++++++++++++++++++++++++++++----------------- 1 file changed, 67 insertions(+), 36 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2412d43f5..b413e1b6d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -152,7 +152,6 @@ spaces instead of one after the bullet in each item of the list." (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. Otherwise, look for `org-list-end-regexp'." - :group 'org-plain-lists :type 'boolean) @@ -164,21 +163,46 @@ precedence over it." :group 'org-plain-lists :type 'string) -(defcustom org-auto-renumber-ordered-lists t - "Non-nil means automatically renumber ordered plain lists. -Renumbering happens when the sequence have been changed with -\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing -commands, use \\[org-ctrl-c-ctrl-c] to trigger renumbering." - :group 'org-plain-lists - :type 'boolean) +(defcustom org-list-automatic-rules '((bullet . t) + (checkbox . t) + (indent . t) + (insert . t) + (renumber . t)) + "Non-nil means apply set of rules when acting on lists. -(defcustom org-provide-checkbox-statistics t - "Non-nil means update checkbox statistics after insert and toggle. -When this is set, checkbox statistics is updated each time you -either insert a new checkbox with \\[org-insert-todo-heading] or -toggle a checkbox with \\[org-ctrl-c-ctrl-c]." - :group 'org-plain-lists - :type 'boolean) +By default, automatic actions are taken when using +\\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return], +\\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright], +\\[org-shiftmetaleft], \\[org-ctrl-c-minus] or +\\[org-insert-todo-heading]. You can disable individually these +rules by setting sets to nil. Valid sets are: + +bullet when non-nil, cycling bullet do not allow lists at + column 0 to have * as a bullet and descriptions lists + to be numbered. +checkbox when non-nil, checkbox statistics is updated each time + you either insert a new checkbox or toggle a checkbox. +indent when non-nil indenting or outdenting list top-item will + move the whole list, indenting the first item of a + sub-list will be forbidden and outdenting a list whose + bullet is * to column 0 will change that bullet to -. +insert when non-nil, trying to insert an item inside a block + will insert it right before the block instead of + throwing an error. +renumber when non-nil, renumber ordered plain lists whenever it + is modified. You can always use \\[org-ctrl-c-ctrl-c] + to trigger renumbering." + :group 'org-plain-lists + :type '(alist :tag "Sets of rules" + :key-type + (choice + (const :tag "Bullet" bullet) + (const :tag "Checkbox" checkbox) + (const :tag "Indent" indent) + (const :tag "Insert" insert) + (const :tag "Renumber" renumber)) + :value-type + (boolean :tag "Activate" :value t))) (defcustom org-hierarchical-checkbox-statistics t "Non-nil means checkbox statistics counts only the state of direct children. @@ -330,14 +354,17 @@ Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET after the bullet. Cursor will be after this text once the function ends." (goto-char pos) - ;; Point in a special block: move before it prior to add a new item. + ;; Is point in a special block? (when (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) - ;; in case we're on the #+begin line - (end-of-line) - (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) - (end-of-line 0)) + (if (not (cdr (assq 'insert org-list-automatic-rules))) + ;; Rule in `org-list-automatic-rules' disallows insertion. + (error "Cannot insert item inside a block.") + ;; Else, move before it prior to add a new item. + (end-of-line) + (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) + (end-of-line 0))) (let* ((true-pos (point)) (bullet (and (org-beginning-of-item) (looking-at org-item-beginning-re) @@ -793,14 +820,12 @@ children. Return t if sucessful." end org-last-indent-end-marker) (org-beginning-of-item) (setq beg (move-marker org-last-indent-begin-marker (point))) - (cond - ;; Top-item: reindent all down to end of list. - ((= (point-at-bol) (org-list-top-point)) (goto-char (org-list-bottom-point))) - ;; No-subtree: reindent down to next children, if any. - (no-subtree (org-end-of-item-text-before-children)) - ;; Else: reindent down to next item. - (t (org-end-of-item))) + ;; Determine end point of indentation + (if no-subtree + (org-end-of-item-text-before-children) + (org-end-of-item)) (setq end (move-marker org-last-indent-end-marker (or end (point))))) + ;; Get some information (goto-char beg) (setq ind-pos (org-item-indent-positions) bullet (cdr (car ind-pos)) @@ -810,8 +835,8 @@ children. Return t if sucessful." delta (if (> arg 0) (if ind-down (- ind-down ind) 2) (if ind-up (- ind-up ind) -2))) + ;; Make some checks before indenting. (cond - ;; Going to a negative column is nonsensical. ((< (+ delta ind) 0) (error "Cannot outdent beyond margin")) ;; Apply indent rules if activated. ((cdr (assq 'indent org-list-automatic-rules)) @@ -1000,10 +1025,11 @@ with something like \"1.\" or \"2)\". Start to count at ARG or 1." (defun org-maybe-renumber-ordered-list () "Renumber the ordered list at point if setup allows it. -This tests the user option `org-auto-renumber-ordered-lists' before -doing the renumbering. Do not throw error on failure." +This tests the if 'renumber rule is set in +`org-list-automatic-rules' before doing the renumbering. +Do not throw error on failure." (interactive) - (when org-auto-renumber-ordered-lists + (when (cdr (assq 'renumber org-list-automatic-rules)) (ignore-errors (org-renumber-ordered-list)))) (defun org-cycle-list-bullet (&optional which) @@ -1023,11 +1049,14 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ((string-match "\\." bullet) "1.") ((string-match ")" bullet) "1)") (t bullet))) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) (bullet-list (append '("-" "+" ) ;; *-bullets are not allowed at column 0 - (unless (looking-at "\\S-") '("*")) + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) ;; Description items cannot be numbered - (unless (org-at-description-p) '("1." "1)")))) + (unless (and bullet-rule-p + (org-at-description-p)) '("1." "1)")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) (get-value (lambda (index) (nth (mod index len) bullet-list))) @@ -1125,12 +1154,14 @@ text below the heading." (defvar org-checkbox-statistics-hook nil "Hook that is run whenever Org thinks checkbox statistics should be updated. -This hook runs even if `org-provide-checkbox-statistics' is nil, to it can -be used to implement alternative ways of collecting statistics information.") +This hook runs even if 'checkbox rules in +`org-list-automatic-rules' do not apply, so it can be used to +implement alternative ways of collecting statistics +information.") (defun org-update-checkbox-count-maybe () "Update checkbox statistics unless turned off by user." - (when org-provide-checkbox-statistics + (when (cdr (assq 'checkbox org-list-automatic-rules)) (org-update-checkbox-count)) (run-hooks 'org-checkbox-statistics-hook)) From 1bfe98bdf6490cc9026fb71f853e5727c38dc7d9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 25 Jul 2010 11:27:28 +0200 Subject: [PATCH 175/348] Minor refactoring. --- lisp/org-list.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b413e1b6d..bad8cd617 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -439,8 +439,7 @@ function ends." (after-text (when (< pos end-before-blank) (prog1 - (buffer-substring pos end-before-blank) - (delete-region pos end-before-blank) + (delete-and-extract-region pos end-before-blank) ;; delete any blank line at and before point. (beginning-of-line) (while (looking-at "^[ \t]*$") From 25de94f3cc04026f52e5446230a154ee97a3adbc Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 25 Jul 2010 11:29:38 +0200 Subject: [PATCH 176/348] Take `org-plain-list-ordered-item-terminator' into consideration when cycling bullets. * org-list.el (org-cycle-list-bullet): Check `org-plain-list-ordered-item-terminator' before allowing 1. or 1) as valid bullets when cycling. --- lisp/org-list.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index bad8cd617..b38702306 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1055,7 +1055,11 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (looking-at "\\S-")) '("*")) ;; Description items cannot be numbered (unless (and bullet-rule-p - (org-at-description-p)) '("1." "1)")))) + (or (eq org-plain-list-ordered-item-terminator ?.) + (org-at-description-p))) '("1)")) + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-description-p))) '("1.")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) (get-value (lambda (index) (nth (mod index len) bullet-list))) From 7c424b33ead413314188bc029e02ebcce67fcbc0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 25 Jul 2010 17:35:26 +0200 Subject: [PATCH 177/348] Cycle indentation for newly created description items or checkboxes. * org-list.el (org-cycle-item-indentation): Allow a point just after a description item or a checkboxed item to start cycling. --- lisp/org-list.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b38702306..7575acccc 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -928,7 +928,8 @@ Assumes cursor in item line." (let ((org-suppress-item-indentation t) (org-adapt-indentation nil)) (when (and (looking-at "[ \t]*$") - (org-looking-back (concat org-item-beginning-re "[ \t]*"))) + (or (org-at-description-p) (org-at-item-checkbox-p) (org-at-item-p)) + (>= (match-end 0) (save-excursion (skip-chars-backward " \r\t\n") (point)))) (setq this-command 'org-cycle-item-indentation) ;; When in the middle of the cycle, try to outdent first. If it ;; fails, and point is still at initial position, indent. Else, From eabb0189136ab4da3eb4e0d1885ed696907b1602 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 25 Jul 2010 20:16:26 +0200 Subject: [PATCH 178/348] `org-cycle-item-indentation' works only on empty items. * org-list.el (org-cycle-item-indentation): Cycle when the whole item only contains bullet and maybe a checkbox. Previously, TAB would cycle when the first line of the item was blank. --- lisp/org-list.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 7575acccc..6c54506b1 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -927,9 +927,11 @@ Assumes cursor in item line." (defun org-cycle-item-indentation () (let ((org-suppress-item-indentation t) (org-adapt-indentation nil)) - (when (and (looking-at "[ \t]*$") - (or (org-at-description-p) (org-at-item-checkbox-p) (org-at-item-p)) - (>= (match-end 0) (save-excursion (skip-chars-backward " \r\t\n") (point)))) + (when (and (or (org-at-description-p) (org-at-item-checkbox-p) (org-at-item-p)) + (>= (match-end 0) (save-excursion + (org-end-of-item-text-before-children) + (skip-chars-backward " \r\t\n") + (point)))) (setq this-command 'org-cycle-item-indentation) ;; When in the middle of the cycle, try to outdent first. If it ;; fails, and point is still at initial position, indent. Else, From d99f7fcf05074ea363d2ba959dd9b43be1ce0958 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 25 Jul 2010 21:57:28 +0200 Subject: [PATCH 179/348] Try to keep relative column in line when indenting item. * org-list.el (org-indent-item-tree): Try to keep relative position on line. It can't if point is in white spaces before bullet because mixed tabs and spaces make some columns unattainable. --- lisp/org-list.el | 122 ++++++++++++++++++++++++++--------------------- 1 file changed, 68 insertions(+), 54 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6c54506b1..384c0b620 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -805,65 +805,76 @@ children. Return t if sucessful." (and (org-region-active-p) (org-cursor-to-region-beginning)) (unless (org-at-item-p) (error "Not on an item")) - (let ((origin-ind (save-excursion + (let ((line (org-current-line)) + (col (current-column)) + (pos (point)) + (origin-ind (save-excursion (goto-char (org-list-top-point)) (org-get-indentation))) beg end ind ind1 ind-pos bullet delta ind-down ind-up firstp) (setq firstp (org-first-list-item-p)) - (save-excursion - (setq end (and (org-region-active-p) (region-end))) - ;; If moving a subtree, don't drain other items on the way. - (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - ;; Determine end point of indentation - (if no-subtree - (org-end-of-item-text-before-children) - (org-end-of-item)) - (setq end (move-marker org-last-indent-end-marker (or end (point))))) - ;; Get some information - (goto-char beg) - (setq ind-pos (org-item-indent-positions) - bullet (cdr (car ind-pos)) - ind (caar ind-pos) - ind-down (car (nth 2 ind-pos)) - ind-up (car (nth 1 ind-pos)) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - ;; Make some checks before indenting. + (setq end (and (org-region-active-p) (region-end))) + ;; If moving a subtree, don't drain other items on the way. + (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (setq beg org-last-indent-begin-marker + end org-last-indent-end-marker) + (org-beginning-of-item) + (setq beg (move-marker org-last-indent-begin-marker (point))) + ;; Determine end point of indentation + (if no-subtree + (org-end-of-item-text-before-children) + (org-end-of-item)) + (setq end (move-marker org-last-indent-end-marker (or end (point))))) + ;; Get some information + (goto-char beg) + (setq ind-pos (org-item-indent-positions) + bullet (cdr (car ind-pos)) + ind (caar ind-pos) + ind-down (car (nth 2 ind-pos)) + ind-up (car (nth 1 ind-pos)) + delta (if (> arg 0) + (if ind-down (- ind-down ind) 2) + (if ind-up (- ind-up ind) -2))) + ;; Make some checks before indenting. + (cond + ((< (+ delta ind) 0) + (goto-char pos) + (error "Cannot outdent beyond margin")) + ;; Apply indent rules if activated. + ((cdr (assq 'indent org-list-automatic-rules)) (cond - ((< (+ delta ind) 0) (error "Cannot outdent beyond margin")) - ;; Apply indent rules if activated. - ((cdr (assq 'indent org-list-automatic-rules)) - (cond - ;; 1. If at top-point move the whole list. Moreover, if - ;; *-list is going to column 0, change bullet to "-". - ((= (point-at-bol) (org-list-top-point)) - (when (and (= (+ delta ind) 0) (equal bullet "*")) (org-fix-bullet-type "-")) - (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) - ;; 2. Do not indent before top-item. - ((< (+ delta ind) origin-ind) - (error "Cannot outdent beyond top level item")) - ;; 3. Do not indent the first item of a list. - ((and firstp (> delta 0)) - (error "Cannot indent the beginning of a sublist")) - ;; 4. Do not outdent item that has children without moving. - ;; In the case of a subtree, make sure the check applies to - ;; its last item. - ((and (< delta 0) - (save-excursion (goto-char (1- end)) (org-item-has-children-p))) - (error "Cannot outdent an item having children"))))) - ;; Proceed to reindentation. - (while (< (point) end) - (beginning-of-line) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (org-indent-to-column (+ ind1 delta))) - (beginning-of-line 2))) + ;; 1. If at top-point move the whole list. Moreover, if + ;; *-list is going to column 0, change bullet to "-". + ((= (point-at-bol) (org-list-top-point)) + (when (and (= (+ delta ind) 0) (equal bullet "*")) (org-fix-bullet-type "-")) + (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) + ;; 2. Do not indent before top-item. + ((< (+ delta ind) origin-ind) + (goto-char pos) + (error "Cannot outdent beyond top level item")) + ;; 3. Do not indent the first item of a list. + ((and firstp (> delta 0)) + (goto-char pos) + (error "Cannot indent the beginning of a sublist")) + ;; 4. Do not outdent item that has children without moving. + ;; In the case of a subtree, make sure the check applies to + ;; its last item. + ((and (< delta 0) + (save-excursion (goto-char (1- end)) (org-item-has-children-p))) + (goto-char pos) + (error "Cannot outdent an item having children"))))) + ;; Proceed to reindentation. + (while (< (point) end) + (beginning-of-line) + (skip-chars-forward " \t") (setq ind1 (current-column)) + (delete-region (point-at-bol) (point)) + (or (eolp) (org-indent-to-column (+ ind1 delta))) + (beginning-of-line 2)) + ;; Get back to original position, shifted by delta + (goto-line line) + (move-to-column (max (+ delta col) 0)) + ;; Fix bullet type (org-fix-bullet-type (and (> arg 0) (cdr (assoc bullet org-list-demote-modify-bullet)))) @@ -878,6 +889,9 @@ children. Return t if sucessful." (save-excursion (org-end-of-item-list) (org-maybe-renumber-ordered-list)) + ;; Get back to original position, shifted by delta + (goto-line line) + (move-to-column (+ delta col)) t)) (defun org-item-indent-positions () From a905db7db7d603ef07006d13a5f99597c2fd6821 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 26 Jul 2010 00:11:46 +0200 Subject: [PATCH 180/348] Smarter fix and reordering of list when indenting items. * org-list.el (org-indent-item-tree): Fix and reorder every list and sublist, from parent of list that has moved if indenting, or from list at point if outdenting. * org-list.el (org-list-replace-bullet): New internal function. --- lisp/org-list.el | 90 ++++++++++++++++++++++++++++++++---------------- 1 file changed, 60 insertions(+), 30 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 384c0b620..bacf064c2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -325,6 +325,19 @@ the end of the nearest terminator from max." (skip-chars-forward " \t") (looking-at regexp)))) +(defun org-list-replace-bullet (new-bullet) + "Replace current item's bullet with NEW-BULLET. +Assume point is at item. Indent body if needed." + (save-excursion + (let ((old (progn + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (match-string 1)))) + (unless (equal new-bullet old) + (replace-match new-bullet nil nil nil 1) + ;; When bullet lengths are differents, move the whole + ;; sublist accordingly + (org-shift-item-indentation (- (length new-bullet) (length old))))))) + (defun org-list-get-item-same-level (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. Search items using function SEARCH-FUN, from POS to LIMIT. It @@ -830,6 +843,7 @@ children. Return t if sucessful." (goto-char beg) (setq ind-pos (org-item-indent-positions) bullet (cdr (car ind-pos)) + bul-up (cdr (nth 1 ind-pos)) ind (caar ind-pos) ind-down (car (nth 2 ind-pos)) ind-up (car (nth 1 ind-pos)) @@ -864,6 +878,16 @@ children. Return t if sucessful." (save-excursion (goto-char (1- end)) (org-item-has-children-p))) (goto-char pos) (error "Cannot outdent an item having children"))))) + ;; Replace bullet of current item with the bullet it is going to + ;; have if we're outdenting. + (when (< delta 0) + (let ((new-bul (concat + (or bul-up bullet) " " + ;; Do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp next-bul)) + " ")))) + (org-list-replace-bullet new-bul))) ;; Proceed to reindentation. (while (< (point) end) (beginning-of-line) @@ -874,25 +898,39 @@ children. Return t if sucessful." ;; Get back to original position, shifted by delta (goto-line line) (move-to-column (max (+ delta col) 0)) - ;; Fix bullet type + ;; Fix and reorder all lists and sublists from parent of the list + ;; at point, or from list at point if it hasn't got any parent or + ;; if we're outdenting. + (save-excursion + ;; Take care of parent list, if it makes sense. + (org-beginning-of-item-list) + (unless (or (< arg 0) (= (org-list-top-point) (point))) + (beginning-of-line 0) + (org-beginning-of-item) + (org-beginning-of-item-list) + (org-fix-bullet-type))) + ;; Take care of list at point. If demoting, look at + ;; `org-list-demote-modify-bullet'. (org-fix-bullet-type (and (> arg 0) (cdr (assoc bullet org-list-demote-modify-bullet)))) - ;; Reorder lists that might have changed (save-excursion - (beginning-of-line 0) - (ignore-errors (org-beginning-of-item)) - (org-maybe-renumber-ordered-list)) - (save-excursion - (org-end-of-item-text-before-children) - (org-maybe-renumber-ordered-list)) - (save-excursion - (org-end-of-item-list) - (org-maybe-renumber-ordered-list)) - ;; Get back to original position, shifted by delta - (goto-line line) - (move-to-column (+ delta col)) - t)) + (when (org-item-has-children-p) + ;; Take care of child, or of every sublist if we're moving a + ;; subtree. + (org-end-of-item-text-before-children) + (if no-subtree + (org-fix-bullet-type) + (let ((fix-list (lambda (i) + (when (org-first-list-item-p) + (org-fix-bullet-type + (and (> arg 0) + (cdr (assoc (org-get-bullet) org-list-demote-modify-bullet))))) + (when (org-item-has-children-p) + (org-end-of-item-text-before-children) + (org-apply-on-list fix-list nil))))) + (org-apply-on-list fix-list nil)))))) + t) (defun org-item-indent-positions () "Return indentation for plain list items. @@ -984,23 +1022,15 @@ Also, fix the indentation." (org-preserve-lc (let* ((ini-bul (progn (org-beginning-of-item-list) (org-get-bullet))) (bullet - (progn - (concat - (or force-bullet ini-bul) " " - ;; Do we need to concat another white space ? - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp ini-bul)) - " ")))) + (concat + (or force-bullet ini-bul) " " + ;; Do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp ini-bul)) + " "))) (replace-bullet (lambda (result bullet) - (let* ((old (progn - (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") - (match-string 1)))) - (unless (equal bullet old) - (replace-match bullet nil nil nil 1) - ;; When bullet lengths are differents, move the whole - ;; sublist accordingly - (org-shift-item-indentation (- (length bullet) (length old)))))))) + (org-list-replace-bullet bullet)))) (org-apply-on-list replace-bullet nil bullet) (org-maybe-renumber-ordered-list)))) From 3a91400baac11e43a32b13463b593a638e7dc807 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 26 Jul 2010 09:53:17 +0200 Subject: [PATCH 181/348] Modified default number of blank lines when inserting an item. * org-list.el (org-list-insert-item-generic): the second item in a list will be separated from its predecessor with the number of blank lines separating the first item from its parent, if any, or no blank line. --- lisp/org-list.el | 20 ++++++-------------- 1 file changed, 6 insertions(+), 14 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index bacf064c2..53750b2a4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -398,14 +398,8 @@ function ends." ;; Trivial cases where there should be none. ((or org-empty-line-terminates-plain-lists (not insert-blank-p)) 0) - ;; When `org-blank-before-new-entry' says so, or item is - ;; alone in the whole list, it is 1. - ((or (eq insert-blank-p t) - (save-excursion - (goto-char (org-list-top-point)) - (end-of-line) - (not (org-search-forward-unenclosed - org-item-beginning-re (org-list-bottom-point) t)))) 1) + ;; When `org-blank-before-new-entry' says so, it is 1. + ((eq insert-blank-p t) 1) ;; plain-list-item is 'auto. Count blank lines separating ;; neighbours items in list. (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) @@ -415,12 +409,10 @@ function ends." (org-back-over-empty-lines)) ;; Is there a previous item? ((not (org-first-list-item-p)) (org-back-over-empty-lines)) - ;; Local search failed: search globally. - ((and (goto-char (org-list-bottom-point)) - (beginning-of-line 0) - (org-search-backward-unenclosed "^[ \t]*$" (org-list-top-point) t)) - (1+ (org-back-over-empty-lines))) - ;; No blank line found in the whole list. + ;; Item alone: count lines separating it from parent, if any + ((/= (org-list-top-point) (point-at-bol)) + (org-back-over-empty-lines)) + ;; No parent: no blank line. (t 0))))))) (insert-fun (lambda (text) From cbc337f28515ee0bc27584a818a48f5284af8293 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 27 Jul 2010 10:09:00 +0200 Subject: [PATCH 182/348] Bug fix. First bullet of *-list would not become "-" when hitting column 0. --- lisp/org-list.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 53750b2a4..3d8f92d53 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -853,7 +853,8 @@ children. Return t if sucessful." ;; 1. If at top-point move the whole list. Moreover, if ;; *-list is going to column 0, change bullet to "-". ((= (point-at-bol) (org-list-top-point)) - (when (and (= (+ delta ind) 0) (equal bullet "*")) (org-fix-bullet-type "-")) + (when (and (= (+ delta ind) 0) (equal bullet "*")) + (org-fix-bullet-type (setq bullet "-"))) (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) ;; 2. Do not indent before top-item. ((< (+ delta ind) origin-ind) @@ -871,7 +872,8 @@ children. Return t if sucessful." (goto-char pos) (error "Cannot outdent an item having children"))))) ;; Replace bullet of current item with the bullet it is going to - ;; have if we're outdenting. + ;; have if we're outdenting. This is needed to prevent indentation + ;; problems of subtrees when outdenting changes bullet size. (when (< delta 0) (let ((new-bul (concat (or bul-up bullet) " " From 66bf386e259a364bcca68174047d67fe7d046709 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 27 Jul 2010 20:52:30 +0200 Subject: [PATCH 183/348] Correctly handle bullets with two spaces. * org-list.el (org-list-bullet-string): New function returning bullet concatenated with an appropriate number of white spaces. * org-list.el (org-list-insert-item-generic): Insert the right bullet, with help of `org-list-bullet-string'. * org-list.el (org-indent-item-tree): Use `org-list-bullet-string'. * org-list.el (org-fix-bullet-type): Use `org-list-bullet-string'. * org-list.el (org-toggle-checkbox): send an error when `org-toggle-checkbox' is trying to insert a checkbox at a description item. * org-list.el (org-item-re): modified regexp so it can catch correct number of white space before item body. * org-list.el (org-list-at-regexp-after-bullet-p): Take into consideration new `org-item-re'. --- lisp/org-list.el | 75 ++++++++++++++++++++++++------------------------ 1 file changed, 37 insertions(+), 38 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 3d8f92d53..79b15d92e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -261,11 +261,11 @@ If GENERAL is non-nil, return the general regexp independent of the value of `org-plain-list-ordered-item-terminator'." (cond ((or general (eq org-plain-list-ordered-item-terminator t)) - "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") ((= org-plain-list-ordered-item-terminator ?.) - "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") ((= org-plain-list-ordered-item-terminator ?\)) - "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)") + "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) (defconst org-item-beginning-re (concat "^" (org-item-re)) @@ -322,22 +322,8 @@ the end of the nearest terminator from max." (and (org-at-item-p) (save-excursion (goto-char (match-end 0)) - (skip-chars-forward " \t") (looking-at regexp)))) -(defun org-list-replace-bullet (new-bullet) - "Replace current item's bullet with NEW-BULLET. -Assume point is at item. Indent body if needed." - (save-excursion - (let ((old (progn - (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") - (match-string 1)))) - (unless (equal new-bullet old) - (replace-match new-bullet nil nil nil 1) - ;; When bullet lengths are differents, move the whole - ;; sublist accordingly - (org-shift-item-indentation (- (length new-bullet) (length old))))))) - (defun org-list-get-item-same-level (search-fun pos limit pre-move) "Return point at the beginning of next item at the same level. Search items using function SEARCH-FUN, from POS to LIMIT. It @@ -380,8 +366,8 @@ function ends." (end-of-line 0))) (let* ((true-pos (point)) (bullet (and (org-beginning-of-item) - (looking-at org-item-beginning-re) - (match-string 0))) + (org-list-bullet-string (org-get-bullet)))) + (ind (org-get-indentation)) (before-p (progn ;; Description item: text starts after colons. (or (org-at-description-p) @@ -419,6 +405,7 @@ function ends." ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. (org-beginning-of-item) + (indent-to-column ind) (insert (concat bullet (when checkbox "[ ] ") after-bullet)) ;; Stay between after-bullet and before text. (save-excursion @@ -875,12 +862,7 @@ children. Return t if sucessful." ;; have if we're outdenting. This is needed to prevent indentation ;; problems of subtrees when outdenting changes bullet size. (when (< delta 0) - (let ((new-bul (concat - (or bul-up bullet) " " - ;; Do we need to concat another white space ? - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp next-bul)) - " ")))) + (let ((new-bul (org-list-bullet-string (or bul-up bullet)))) (org-list-replace-bullet new-bul))) ;; Proceed to reindentation. (while (< (point) end) @@ -901,7 +883,6 @@ children. Return t if sucessful." (unless (or (< arg 0) (= (org-list-top-point) (point))) (beginning-of-line 0) (org-beginning-of-item) - (org-beginning-of-item-list) (org-fix-bullet-type))) ;; Take care of list at point. If demoting, look at ;; `org-list-demote-modify-bullet'. @@ -1008,6 +989,28 @@ Assumes cursor in item line." (and (org-at-item-p) (org-trim (match-string 1)))) +(defun org-list-bullet-string (bullet) + "Concatenate BULLET with an appropriate number of whitespaces. +It determines the number of whitespaces to append by looking at +`org-list-two-spaces-after-bullet-regexp'." + (concat + bullet " " + ;; Do we need to concat another white space ? + (when (string-match org-list-two-spaces-after-bullet-regexp bullet) " "))) + +(defun org-list-replace-bullet (new-bullet) + "Replace current item's bullet with NEW-BULLET. +Assume point is at item. Indent body if needed." + (save-excursion + (let ((old (progn + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (match-string 1)))) + (unless (equal new-bullet old) + (replace-match new-bullet nil nil nil 1) + ;; When bullet lengths are differents, move the whole + ;; sublist accordingly + (org-shift-item-indentation (- (length new-bullet) (length old))))))) + (defun org-fix-bullet-type (&optional force-bullet) "Make sure all items in this list have the same bullet as the first item. Also, fix the indentation." @@ -1015,13 +1018,7 @@ Also, fix the indentation." (unless (org-at-item-p) (error "This is not a list")) (org-preserve-lc (let* ((ini-bul (progn (org-beginning-of-item-list) (org-get-bullet))) - (bullet - (concat - (or force-bullet ini-bul) " " - ;; Do we need to concat another white space ? - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp ini-bul)) - " "))) + (bullet (org-list-bullet-string (or force-bullet ini-bul))) (replace-bullet (lambda (result bullet) (org-list-replace-bullet bullet)))) @@ -1147,11 +1144,13 @@ text below the heading." t t nil 1))) (throw 'exit t)) ((org-at-item-p) - ;; add a checkbox - (save-excursion - (goto-char (match-end 0)) - (insert "[ ] ")) - (throw 'exit t)) + ;; add a checkbox if point is not at a description item + (save-excursion + (goto-char (match-end 0)) + (if (org-at-description-p) + (error "Cannot add a checkbox in a description list") + (insert "[ ] "))) + (throw 'exit t)) (t (error "Not at a checkbox or heading, and no active region"))) (setq end (move-marker (make-marker) end)) (save-excursion From 6593fcc7cd31824c5df22051a43878d86dc516a4 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 27 Jul 2010 20:55:31 +0200 Subject: [PATCH 184/348] Unconditionally fix list when using C-c C-c. * org.el (org-ctrl-c-ctrl-c): call `org-fix-bullet-type' instead of `org-maybe-renumber-ordered-list' and `org-fix-bullet-type' before toggling a checkbox. --- lisp/org.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 8103c667f..e4e39e95f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17207,12 +17207,12 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) + (call-interactively 'org-fix-bullet-type) (call-interactively 'org-toggle-checkbox) (org-list-send-list 'maybe)) ((org-at-item-p) - (if arg - (call-interactively 'org-toggle-checkbox) - (call-interactively 'org-maybe-renumber-ordered-list)) + (call-interactively 'org-fix-bullet-type) + (when arg (call-interactively 'org-toggle-checkbox)) (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block From 3f762cf76d1021eae355075da78d9f8078e05114 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 00:05:42 +0200 Subject: [PATCH 185/348] Refactoring * org-list.el: `org-at-description-p' renamed to `org-at-item-description-p', `org-first-list-item-p' renamed to `org-list-first-item-p', `org-end-of-item-text-before-children' renamed to `org-end-of-item-or-at-child'. --- lisp/org-list.el | 79 ++++++++++++++++++++++-------------------------- 1 file changed, 36 insertions(+), 43 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 79b15d92e..3327f8605 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -273,7 +273,7 @@ of `org-plain-list-ordered-item-terminator'." (defun org-list-terminator-between (min max &optional firstp) "Find the position of a list ender between MIN and MAX, or nil. -This function looks for `org-list-end-re' not matching a block. +This function looks for `org-list-end-re' outside a block. If FIRSTP in non-nil, return the point at the beginning of the nearest valid terminator from min. Otherwise, return the point at @@ -358,7 +358,7 @@ function ends." "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) (if (not (cdr (assq 'insert org-list-automatic-rules))) - ;; Rule in `org-list-automatic-rules' disallows insertion. + ;; Rule in `org-list-automatic-rules' forbids insertion. (error "Cannot insert item inside a block.") ;; Else, move before it prior to add a new item. (end-of-line) @@ -370,7 +370,7 @@ function ends." (ind (org-get-indentation)) (before-p (progn ;; Description item: text starts after colons. - (or (org-at-description-p) + (or (org-at-item-description-p) ;; At a checkbox: text starts after it. (org-at-item-checkbox-p) ;; Otherwise, text starts after bullet. @@ -394,7 +394,7 @@ function ends." (next-p (goto-char next-p) (org-back-over-empty-lines)) ;; Is there a previous item? - ((not (org-first-list-item-p)) (org-back-over-empty-lines)) + ((not (org-list-first-item-p)) (org-back-over-empty-lines)) ;; Item alone: count lines separating it from parent, if any ((/= (org-list-top-point) (point-at-bol)) (org-back-over-empty-lines)) @@ -457,12 +457,10 @@ function ends." (and last-item-start (not list-ender)))))) -(defun org-first-list-item-p () - "Is this heading the first item in a plain list?" - (unless (org-at-item-p) - (error "Not at a plain list item")) +(defun org-list-first-item-p () + "Is this item the first item in a plain list?" (save-excursion - (= (save-excursion (org-beginning-of-item)) (org-beginning-of-item-list)))) + (= (org-beginning-of-item) (org-beginning-of-item-list)))) (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" @@ -480,7 +478,7 @@ function ends." "Is point at a line starting a plain list item with a timer?" (org-list-at-regexp-after-bullet-p "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) -(defun org-at-description-p () +(defun org-at-item-description-p () "Is point at a description list item?" (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+")) @@ -488,12 +486,12 @@ function ends." "Is point at a line starting a plain-list item with a checklet?" (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) -(defun org-item-has-children-p () +(defun org-item-has-child-p () "Does the current item have subitems?" (save-excursion (org-beginning-of-item) (let ((ind (org-get-indentation))) - (org-end-of-item-text-before-children) + (org-end-of-item-or-at-child) (and (org-at-item-p) (> (org-get-indentation) ind))))) @@ -566,16 +564,12 @@ If the cursor is not in an item, throw an error. Return point." If the cursor is not in an item, throw an error." (interactive) (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (cond ((not (org-in-item-p)) - (error "Not in an item")) - (next-p - (goto-char next-p)) - (t - (org-end-of-item-list))))) + (cond ((not (org-in-item-p)) (error "Not in an item")) + (next-p (goto-char next-p)) + (t (org-end-of-item-list))))) -(defun org-end-of-item-text-before-children () - "Move to the end of the item text, stops before the first child if any. -Assumes that the cursor is in the first line of an item." +(defun org-end-of-item-or-at-child () + "Move to the end of the item text, stops before the first child if any." (let ((limit (org-list-bottom-point))) (end-of-line) (goto-char @@ -629,6 +623,7 @@ in a plain list, or if this is the first item in the list." "Go to the beginning item of the current list or sublist. Return point." (interactive) + (org-beginning-of-item) (let ((limit (org-list-top-point)) (move-up (lambda (pos bound) ;; prev-p: any item of same level before ? @@ -734,7 +729,7 @@ invisible." ;; if we're in a description list, ask for the new term. (let ((desc-text (when (save-excursion (and (org-beginning-of-item) - (org-at-description-p))) + (org-at-item-description-p))) (concat (read-string "Term: ") " :: ")))) (org-list-insert-item-generic (point) (and checkbox (not desc-text)) desc-text))))) @@ -803,10 +798,10 @@ children. Return t if sucessful." (origin-ind (save-excursion (goto-char (org-list-top-point)) (org-get-indentation))) - beg end ind ind1 ind-pos bullet delta ind-down ind-up firstp) - (setq firstp (org-first-list-item-p)) + beg end ind ind1 ind-pos bullet delta ind-down ind-up) (setq end (and (org-region-active-p) (region-end))) - ;; If moving a subtree, don't drain other items on the way. + ;; If moving a subtree, don't drag additional items on subsequent + ;; moves. (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) (memq this-command '(org-shiftmetaright org-shiftmetaleft))) (setq beg org-last-indent-begin-marker @@ -814,9 +809,7 @@ children. Return t if sucessful." (org-beginning-of-item) (setq beg (move-marker org-last-indent-begin-marker (point))) ;; Determine end point of indentation - (if no-subtree - (org-end-of-item-text-before-children) - (org-end-of-item)) + (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item)) (setq end (move-marker org-last-indent-end-marker (or end (point))))) ;; Get some information (goto-char beg) @@ -848,14 +841,14 @@ children. Return t if sucessful." (goto-char pos) (error "Cannot outdent beyond top level item")) ;; 3. Do not indent the first item of a list. - ((and firstp (> delta 0)) + ((and (org-list-first-item-p) (> delta 0)) (goto-char pos) (error "Cannot indent the beginning of a sublist")) ;; 4. Do not outdent item that has children without moving. ;; In the case of a subtree, make sure the check applies to ;; its last item. ((and (< delta 0) - (save-excursion (goto-char (1- end)) (org-item-has-children-p))) + (save-excursion (goto-char (1- end)) (org-item-has-child-p))) (goto-char pos) (error "Cannot outdent an item having children"))))) ;; Replace bullet of current item with the bullet it is going to @@ -890,19 +883,19 @@ children. Return t if sucessful." (and (> arg 0) (cdr (assoc bullet org-list-demote-modify-bullet)))) (save-excursion - (when (org-item-has-children-p) + (when (org-item-has-child-p) ;; Take care of child, or of every sublist if we're moving a ;; subtree. - (org-end-of-item-text-before-children) + (org-end-of-item-or-at-child) (if no-subtree (org-fix-bullet-type) (let ((fix-list (lambda (i) - (when (org-first-list-item-p) + (when (org-list-first-item-p) (org-fix-bullet-type (and (> arg 0) (cdr (assoc (org-get-bullet) org-list-demote-modify-bullet))))) - (when (org-item-has-children-p) - (org-end-of-item-text-before-children) + (when (org-item-has-child-p) + (org-end-of-item-or-at-child) (org-apply-on-list fix-list nil))))) (org-apply-on-list fix-list nil)))))) t) @@ -954,9 +947,9 @@ Assumes cursor in item line." (defun org-cycle-item-indentation () (let ((org-suppress-item-indentation t) (org-adapt-indentation nil)) - (when (and (or (org-at-description-p) (org-at-item-checkbox-p) (org-at-item-p)) + (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p)) (>= (match-end 0) (save-excursion - (org-end-of-item-text-before-children) + (org-end-of-item-or-at-child) (skip-chars-backward " \r\t\n") (point)))) (setq this-command 'org-cycle-item-indentation) @@ -971,7 +964,7 @@ Assumes cursor in item line." (t (back-to-indentation) (org-indent-to-column org-tab-ind-state) (end-of-line) - (org-maybe-renumber-ordered-list) + (org-fix-bullet-type) ;; Break cycle (setq this-command 'identity))) ;; If a cycle has just started, try to indent first. If it @@ -1094,10 +1087,10 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ;; Description items cannot be numbered (unless (and bullet-rule-p (or (eq org-plain-list-ordered-item-terminator ?.) - (org-at-description-p))) '("1)")) + (org-at-item-description-p))) '("1)")) (unless (and bullet-rule-p (or (eq org-plain-list-ordered-item-terminator ?\)) - (org-at-description-p))) '("1.")))) + (org-at-item-description-p))) '("1.")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) (get-value (lambda (index) (nth (mod index len) bullet-list))) @@ -1147,7 +1140,7 @@ text below the heading." ;; add a checkbox if point is not at a description item (save-excursion (goto-char (match-end 0)) - (if (org-at-description-p) + (if (org-at-item-description-p) (error "Cannot add a checkbox in a description list") (insert "[ ] "))) (throw 'exit t)) @@ -1457,11 +1450,11 @@ sublevels as a list of strings." (save-excursion (beginning-of-line) (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered) - ((org-at-description-p) 'descriptive) + ((org-at-item-description-p) 'descriptive) (t 'unordered)))) (let* ((indent1 (org-get-indentation)) (nextitem (or (org-get-next-item (point) end) end)) - (item (org-trim (buffer-substring (point) (org-end-of-item-text-before-children)))) + (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child)))) (nextindent (if (= (point) end) 0 (org-get-indentation))) (item (if (string-match "^\\[\\([xX ]\\)\\]" item) (replace-match (if (equal (match-string 1 item) " ") From 4a4c4f2cf1a67e81b7673ec9bce26669fb24f6f0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 00:18:33 +0200 Subject: [PATCH 186/348] Ensure new indentation cycles always start with same bullet * org-list.el (org-cycle-item-indentation): org-tab-ind-state stores both indentation and bullet when cycle started. --- lisp/org-list.el | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 3327f8605..827698d89 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -942,8 +942,7 @@ Assumes cursor in item line." (cons ind-up bullet-up) (cons ind-down bullet-down)))) -(defvar org-tab-ind-state) ; defined in org.el - +(defvar org-tab-ind-state) (defun org-cycle-item-indentation () (let ((org-suppress-item-indentation t) (org-adapt-indentation nil)) @@ -959,17 +958,18 @@ Assumes cursor in item line." (if (eq last-command 'org-cycle-item-indentation) (cond ((ignore-errors (org-indent-item -1))) - ((and (= (org-get-indentation) org-tab-ind-state) + ((and (= (org-get-indentation) (car org-tab-ind-state)) (ignore-errors (org-indent-item 1)))) (t (back-to-indentation) - (org-indent-to-column org-tab-ind-state) + (indent-to-column (car org-tab-ind-state)) (end-of-line) - (org-fix-bullet-type) + (org-fix-bullet-type (nth 1 org-tab-ind-state)) ;; Break cycle (setq this-command 'identity))) - ;; If a cycle has just started, try to indent first. If it - ;; fails, try to outdent. - (setq org-tab-ind-state (org-get-indentation)) + ;; If a cycle is starting, remember indentation and bullet, + ;; then try to indent. If it fails, try to outdent. + (setq org-tab-ind-state + (list (org-get-indentation) (org-get-bullet))) (cond ((ignore-errors (org-indent-item 1))) ((ignore-errors (org-indent-item -1))) From c444086ade2f909a9721533de1a4eff009014f17 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 11:19:08 +0200 Subject: [PATCH 187/348] Documentation fixes. --- lisp/org-list.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 827698d89..843ddba1e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1324,10 +1324,10 @@ Otherwise it will be `org-todo'." (defun org-apply-on-list (function init-value &rest args) "Call FUNCTION for each item of a the list under point. -FUNCTION must be called with at least one argument : a return -value that will contain the value returned by the function at -the previous item, plus ARGS extra arguments. INIT-VALUE will be -the value passed to the function at the first item of the list. +FUNCTION must be called with at least one argument: a return +value that will contain the value returned by the function at the +previous item, plus ARGS extra arguments. INIT-VALUE will be the +value passed to the function at the first item of the list. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) will return the number of items in the current list. @@ -1357,14 +1357,13 @@ a time stamp, by a property or by priority. The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to -be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise meaning of each character: n Numerically, by converting the beginning of the item to a number. -a Alphabetically. +a Alphabetically. Only the first line of item is checked. t By date/time, either the first active time stamp in the entry, if - any, or by the first inactive one. In a timer list, sorts the timers. - Only the first line of item is checked. + any, or by the first inactive one. In a timer list, sort the timers. Capital letters will reverse the sort order. From 4d40259e56928853330c3adeb2bb19f0dcc91320 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 15:53:37 +0200 Subject: [PATCH 188/348] Better handling of checkboxes with regards to [@start:x] constructs * org.el (org-set-font-lock-defaults): Correct fontification for checkboxes found after [@start:?]. * org-list.el (org-list-at-regexp-after-bullet-p): skip any [@start:?] when looking at a regex after a bullet. * org-list.el (org-toggle-checkbox): correct insertion of checkboxes when there is already a [@start:?] in the item. * org-list.el (org-checkbox-blocked-p): properly check if there's an unchecked item before. * org-list.el (org-list-parse-list): function handles items having both a counter and a checkbox. --- lisp/org-list.el | 150 ++++++++++++++++++++++++----------------------- lisp/org.el | 2 +- 2 files changed, 78 insertions(+), 74 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 843ddba1e..c0799d350 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -322,6 +322,9 @@ the end of the nearest terminator from max." (and (org-at-item-p) (save-excursion (goto-char (match-end 0)) + ;; Ignore counter if any + (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) (looking-at regexp)))) (defun org-list-get-item-same-level (search-fun pos limit pre-move) @@ -465,8 +468,7 @@ function ends." (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" (save-excursion - (goto-char (point-at-bol)) - (looking-at org-item-beginning-re))) + (beginning-of-line) (looking-at org-item-beginning-re))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -513,7 +515,8 @@ A checkbox is blocked if all of the following conditions are fulfilled: (condition-case nil (org-back-to-heading t) (error (throw 'exit nil))) (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) - (when (org-search-forward-unenclosed "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t) + (when (org-search-forward-unenclosed + "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@start:[0-9]+\\][ \t]+\\)?\\[[- ]\\]" end t) (org-current-line))))))) ;;; Navigate @@ -1105,73 +1108,74 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. -With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. -With double prefix, set checkbox to [-]. -When there is an active region, toggle status or presence of the checkbox -in the first line, and make every item in the region have the same -status or presence, respectively. -If the cursor is in a headline, apply this to all checkbox items in the -text below the heading." + +With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With +double prefix, set checkbox to [-]. + +When there is an active region, toggle status or presence of the +checkbox in the first line, and make every item in the region +have the same status or presence, respectively. + +If the cursor is in a headline, apply this to all checkbox items +in the text below the heading, taking as reference the first item +in subtree." (interactive "P") - (catch 'exit - (let (beg end status first-present first-status blocked) - (cond - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - ((org-on-heading-p) - (setq beg (point) end (save-excursion (outline-next-heading) (point)))) - ((org-at-item-checkbox-p) - (save-excursion - (if (equal toggle-presence '(4)) - (progn - (replace-match "" nil nil nil 1) - (goto-char (match-beginning 0)) - (just-one-space)) - (when (setq blocked (org-checkbox-blocked-p)) - (error "Checkbox blocked because of unchecked box in line %d" - blocked)) - (replace-match - (cond ((equal toggle-presence '(16)) "[-]") - ((member (match-string 1) '("[ ]" "[-]")) "[X]") - (t "[ ]")) - t t nil 1))) - (throw 'exit t)) - ((org-at-item-p) - ;; add a checkbox if point is not at a description item - (save-excursion - (goto-char (match-end 0)) - (if (org-at-item-description-p) - (error "Cannot add a checkbox in a description list") - (insert "[ ] "))) - (throw 'exit t)) - (t (error "Not at a checkbox or heading, and no active region"))) - (setq end (move-marker (make-marker) end)) - (save-excursion - (goto-char beg) - (setq first-present (org-at-item-checkbox-p) - first-status - (save-excursion - (and (org-search-forward-unenclosed "[ \t]\\(\\[[ X]\\]\\)" end t) - (equal (match-string 0) "[X]")))) - (while (< (point) end) - (if toggle-presence - (cond - ((and first-present (org-at-item-checkbox-p)) - (save-excursion - (replace-match "") - (goto-char (match-beginning 0)) - (just-one-space))) - ((and (not first-present) (not (org-at-item-checkbox-p)) - (org-at-item-p)) - (save-excursion - (goto-char (match-end 0)) - (insert "[ ] ")))) - (when (org-at-item-checkbox-p) - (setq status (equal (match-string 1) "[X]")) - (replace-match - (if first-status "[ ]" "[X]") t t nil 1))) - (beginning-of-line 2))))) - (org-update-checkbox-count-maybe)) + ;; Bounds is a list of type (beg end single-p) where single-p is t + ;; when `org-toggle-checkbox' is applied to a single item. Only + ;; toggles on single items will return errors. + (let* ((bounds + (cond + ((org-region-active-p) + (list (region-beginning) (region-end) nil)) + ((org-on-heading-p) + ;; In this case, reference line is the first item in subtree + (let ((limit (save-excursion (outline-next-heading) (point)))) + (save-excursion + (org-search-forward-unenclosed org-item-beginning-re limit 'move) + (list (point) limit nil)))) + ((org-at-item-p) + (list (point-at-bol) (point-at-eol) t)) + (t (error "Not at an item or heading, and no active region")))) + ;; marker is needed because deleting checkboxes will change END + (end (copy-marker (nth 1 bounds))) + (single-p (nth 2 bounds)) + (ref-presence (save-excursion (goto-char (car bounds)) (org-at-item-checkbox-p))) + (ref-status (equal (match-string 1) "[X]")) + (act-on-item + (lambda (ref-pres ref-stat) + (if (equal toggle-presence '(4)) + (cond + ((and ref-pres (org-at-item-checkbox-p)) + (replace-match "")) + ((and (not ref-pres) + (not (org-at-item-checkbox-p)) + (org-at-item-p)) + (goto-char (match-end 0)) + ;; Ignore counter, if any + (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) + (let ((desc-p (and (org-at-item-description-p) + (cdr (assq 'checkbox org-list-automatic-rules))))) + (cond + ((and single-p desc-p) + (error "Cannot add a checkbox in a description list")) + ((not desc-p) (insert "[ ] ")))))) + (let ((blocked (org-checkbox-blocked-p))) + (cond + ((and blocked single-p) + (error "Checkbox blocked because of unchecked box in line %d" blocked)) + (blocked nil) + ((org-at-item-checkbox-p) + (replace-match + (cond ((equal toggle-presence '(16)) "[-]") + (ref-stat "[ ]") + (t "[X]")) + t t nil 1)))))))) + (save-excursion + (while (< (point) end) + (funcall act-on-item ref-presence ref-status) + (org-search-forward-unenclosed org-item-beginning-re end 'move))) + (org-update-checkbox-count-maybe))) (defun org-reset-checkbox-state-subtree () "Reset all checkboxes in an entry subtree." @@ -1455,11 +1459,11 @@ sublevels as a list of strings." (nextitem (or (org-get-next-item (point) end) end)) (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child)))) (nextindent (if (= (point) end) 0 (org-get-indentation))) - (item (if (string-match "^\\[\\([xX ]\\)\\]" item) + (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]+\\)?\\[\\([xX ]\\)\\]" item) (replace-match (if (equal (match-string 1 item) " ") - "[CBOFF]" - "[CBON]") - t nil item) + "CBOFF" + "CBON") + t nil item 1) item))) (push item output) (when (> nextindent indent1) diff --git a/lisp/org.el b/lisp/org.el index e4e39e95f..2f100b7cb 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5457,7 +5457,7 @@ needs to be inserted at a specific position in the font-lock sequence.") '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)" + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\(?:[ \t]+\\[@start:[0-9]+\\]\\)?\\)[ \t]+\\(\\[[- X]\\]\\)" 2 'org-checkbox prepend) (if org-provide-checkbox-statistics '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" From a73ce76fe378f07cee27a05a5f7a51977d7b0500 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 16:51:28 +0200 Subject: [PATCH 189/348] Checkbox rule forbids inserting checkboxes in description item --- lisp/org-list.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c0799d350..95051e42d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -173,15 +173,18 @@ precedence over it." By default, automatic actions are taken when using \\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return], \\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright], -\\[org-shiftmetaleft], \\[org-ctrl-c-minus] or -\\[org-insert-todo-heading]. You can disable individually these -rules by setting sets to nil. Valid sets are: +\\[org-shiftmetaleft], \\[org-ctrl-c-minus], +\\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can +disable individually these rules by setting them to nil. Valid +rules are: bullet when non-nil, cycling bullet do not allow lists at column 0 to have * as a bullet and descriptions lists to be numbered. checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. + It also prevents from inserting a checkbox in a + description item. indent when non-nil indenting or outdenting list top-item will move the whole list, indenting the first item of a sub-list will be forbidden and outdenting a list whose @@ -734,8 +737,13 @@ invisible." (and (org-beginning-of-item) (org-at-item-description-p))) (concat (read-string "Term: ") " :: ")))) + ;; Don't insert a checkbox if checkbox rule is applied and it + ;; is a description item. (org-list-insert-item-generic - (point) (and checkbox (not desc-text)) desc-text))))) + (point) (and checkbox + (or (not desc-text) + (not (cdr (assq 'checkbox org-list-automatic-rules))))) + desc-text))))) ;;; Indentation From cb23060a460a7474f0762ef3d56dc7ad151879cc Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 19:24:46 +0200 Subject: [PATCH 190/348] HTML and DocBook exporters handle multiple uses of [@start:?]. * org-docbook.el (org-export-as-docbook): Use override="num" in any listitem matching [@start:num] * org-html.el (org-export-as-html): Use value="num" in any li matching [@start:num] --- lisp/org-docbook.el | 16 ++++++++-------- lisp/org-html.el | 16 ++++++++-------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index ab2dfd6d9..d90d949c8 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -554,7 +554,7 @@ publishing directory." table-buffer table-orig-buffer ind item-type starter rpl path attr caption label desc descp desc1 desc2 link - fnc item-tag initial-number + fnc item-tag item-number footref-seen footnote-list id-file ) @@ -1023,9 +1023,9 @@ publishing directory." (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) item-tag nil - initial-number nil) + item-number nil) (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) - (setq initial-number (match-string 1 line) + (setq item-number (match-string 1 line) line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" @@ -1055,7 +1055,7 @@ publishing directory." (org-export-docbook-close-para-maybe) (insert (cond ((equal item-type "u") "<itemizedlist>\n<listitem>\n") - ((equal item-type "o") + ((and (equal item-type "o") item-number) ;; Check for a specific start number. If it ;; is specified, we use the ``override'' ;; attribute of element <listitem> to pass the @@ -1063,10 +1063,8 @@ publishing directory." ;; ``startingnumber'' attribute of element ;; <orderedlist>, but the former works on both ;; DocBook 5.0 and prior versions. - (if initial-number - (format "<orderedlist>\n<listitem override=\"%s\">\n" - initial-number) - "<orderedlist>\n<listitem>\n")) + (format "<orderedlist>\n<listitem override=\"%s\">\n" item-number)) + ((equal item-type "o") "<orderedlist>\n<listitem>\n") ((equal item-type "d") (format "<variablelist>\n<varlistentry><term>%s</term><listitem>\n" item-tag)))) ;; For DocBook, we need to open a para right after tag @@ -1080,6 +1078,8 @@ publishing directory." (let ((listtype (car local-list-type))) (org-export-docbook-close-li listtype) (insert (cond + ((and (equal listtype "o") item-number) + (format "<listitem override=\"%s\">" item-number)) ((equal listtype "o") "<listitem>") ((equal listtype "u") "<listitem>") ((equal listtype "d") (format diff --git a/lisp/org-html.el b/lisp/org-html.el index 60b4b9664..1a5c5eb9b 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -962,7 +962,7 @@ PUB-DIR is set, use this as the publishing directory." table-buffer table-orig-buffer ind item-type starter rpl path attr desc descp desc1 desc2 link - snumber fnc item-tag initial-number + snumber fnc item-tag item-number footnotes footref-seen id-file href ) @@ -1546,10 +1546,10 @@ lang=\"%s\" xml:lang=\"%s\"> starter (if (match-beginning 2) (substring (match-string 2 line) 0 -1)) line (substring line (match-beginning 5)) - initial-number nil + item-number nil item-tag nil) (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) - (setq initial-number (match-string 1 line) + (setq item-number (match-string 1 line) line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) (setq item-type "d" @@ -1571,15 +1571,13 @@ lang=\"%s\" xml:lang=\"%s\"> ((and starter (or (not in-local-list) (> ind (car local-list-indent)))) - ;; check for a specified start number ;; Start new (level of) list (org-close-par-maybe) (insert (cond ((equal item-type "u") "<ul>\n<li>\n") - ((equal item-type "o") - (if initial-number - (format "<ol start=%s>\n<li>\n" initial-number) - "<ol>\n<li>\n")) + ((and (equal item-type "o") item-number) + (format "<ol>\n<li value=\"%s\">\n" item-number)) + ((equal item-type "o") "<ol>\n<li>\n") ((equal item-type "d") (format "<dl>\n<dt>%s</dt><dd>\n" item-tag)))) (push item-type local-list-type) @@ -1591,6 +1589,8 @@ lang=\"%s\" xml:lang=\"%s\"> (insert (cond ((equal (car local-list-type) "d") (format "<dt>%s</dt><dd>\n" (or item-tag "???"))) + ((and (equal item-type "o") item-number) + (format "<li value=\"%s\">\n" item-number)) (t "<li>\n"))))) (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) (setq line From 884489c3fb99bfda1719198700e3b1e4b502be0a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 28 Jul 2010 22:13:47 +0200 Subject: [PATCH 191/348] When indenting an item, bullet should be more predictable. * org-list.el (org-indent-item-tree): removed unnecessary bullets fix, and improved heuristics to determine bullet when indenting. * org-list.el (org-item-indent-positions): function now returns sane results when there are two lists separated with blank lines only. --- lisp/org-list.el | 96 +++++++++++++++++++++++------------------------- 1 file changed, 45 insertions(+), 51 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 95051e42d..428fcfa7b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -827,6 +827,7 @@ children. Return t if sucessful." (setq ind-pos (org-item-indent-positions) bullet (cdr (car ind-pos)) bul-up (cdr (nth 1 ind-pos)) + bul-down (cdr (nth 2 ind-pos)) ind (caar ind-pos) ind-down (car (nth 2 ind-pos)) ind-up (car (nth 1 ind-pos)) @@ -855,9 +856,9 @@ children. Return t if sucessful." ((and (org-list-first-item-p) (> delta 0)) (goto-char pos) (error "Cannot indent the beginning of a sublist")) - ;; 4. Do not outdent item that has children without moving. - ;; In the case of a subtree, make sure the check applies to - ;; its last item. + ;; 4. Do not outdent item that has children without moving + ;; subtree. If moving subtree, the rule applies to its last + ;; sub-item. ((and (< delta 0) (save-excursion (goto-char (1- end)) (org-item-has-child-p))) (goto-char pos) @@ -878,21 +879,22 @@ children. Return t if sucessful." ;; Get back to original position, shifted by delta (goto-line line) (move-to-column (max (+ delta col) 0)) - ;; Fix and reorder all lists and sublists from parent of the list - ;; at point, or from list at point if it hasn't got any parent or - ;; if we're outdenting. + ;; Fix and reorder all lists and sublists from list at point. If + ;; it has a parent and we're indenting, renumber parent too. (save-excursion - ;; Take care of parent list, if it makes sense. + ;; Renumber parent list, if needed. No need for fixing bullets (org-beginning-of-item-list) (unless (or (< arg 0) (= (org-list-top-point) (point))) (beginning-of-line 0) (org-beginning-of-item) - (org-fix-bullet-type))) - ;; Take care of list at point. If demoting, look at - ;; `org-list-demote-modify-bullet'. + (org-maybe-renumber-ordered-list))) + ;; Take care of list at point. When demoting, to determine bullet + ;; of children, follow, in order: `org-list-demote-modify-bullet', + ;; same bullet as others children, same bullet as before (org-fix-bullet-type (and (> arg 0) - (cdr (assoc bullet org-list-demote-modify-bullet)))) + (or (cdr (assoc bullet org-list-demote-modify-bullet)) + bul-down))) (save-excursion (when (org-item-has-child-p) ;; Take care of child, or of every sublist if we're moving a @@ -912,46 +914,38 @@ children. Return t if sucessful." t) (defun org-item-indent-positions () - "Return indentation for plain list items. -This returns a list with three values: The current indentation, the -parent indentation and the indentation a child should have. -Assumes cursor in item line." - (let* ((bolpos (point-at-bol)) - (ind (org-get-indentation)) - (bullet (org-get-bullet)) - ind-down ind-up bullet-up bullet-down pos) - (save-excursion - (org-beginning-of-item-list) - (skip-chars-backward "\n\r \t") - (when (org-in-item-p) - (org-beginning-of-item) - (let ((prev-indent (org-get-indentation))) - (when (< prev-indent ind) - (setq ind-up prev-indent) - (setq bullet-up (org-get-bullet)))))) - (setq pos (point)) - (save-excursion - (cond - ((and (ignore-errors (progn (org-previous-item) t)) - (or (end-of-line) t) - (org-search-forward-unenclosed org-item-beginning-re bolpos t)) - (setq ind-down (org-get-indentation) - bullet-down (org-get-bullet))) - ((and (goto-char pos) - (org-at-item-p)) - (goto-char (match-end 0)) - (skip-chars-forward " \t") - (setq ind-down (current-column) - bullet-down (org-get-bullet))))) - (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down)) - (setq bullet-down (concat "1" (match-string 1 bullet-down)))) - (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up)) - (setq bullet-up (concat "1" (match-string 1 bullet-up)))) - (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet)) - (setq bullet (concat "1" (match-string 1 bullet)))) - (list (cons ind bullet) - (cons ind-up bullet-up) - (cons ind-down bullet-down)))) + "Return indentations and bullets relatives to a plain list item. +This returns a list with three cons-cells: the current item, the +parent item, if any, and the child item. Each cell has the +form (indentation . bullet). Assumes cursor in item line." + (let* ((init-bul (lambda (bullet) + (if (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet) + (concat "1" (match-string 1 bullet)) + bullet))) + ;; Current item + (item-cur (cons (org-get-indentation) + (funcall init-bul (org-get-bullet)))) + ;; Parent + (item-up (save-excursion + (org-beginning-of-item-list) + (unless (= (org-list-top-point) (point)) + (beginning-of-line 0) + (org-beginning-of-item) + (cons (org-get-indentation) + (funcall init-bul (org-get-bullet)))))) + ;; Child of previous item, if any. + (item-down (save-excursion + (let ((prev-p (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list))))) + (if (and prev-p (goto-char prev-p) (org-item-has-child-p)) + (progn + (org-end-of-item-or-at-child) + (cons (org-get-indentation) + (funcall init-bul (org-get-bullet)))) + (goto-char pos) + (org-at-item-p) + (goto-char (match-end 0)) + (cons (current-column) (cdr item-cur))))))) + (list item-cur item-up item-down))) (defvar org-tab-ind-state) (defun org-cycle-item-indentation () From 80b269d94706e5badb61b382f7aa15d02a6df478 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 11:44:54 +0200 Subject: [PATCH 192/348] `org-toggle-item' working as expected. * org-list.el (org-list-bullet-string): do not modify match-data. * org.el (org-toggle-item): now working again when changing list items into plain text. Moreover take into consideration `org-list-two-spaces-after-bullet-regexp'. --- lisp/org-list.el | 9 +++++---- lisp/org.el | 10 +++++----- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 428fcfa7b..e57535400 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -991,10 +991,11 @@ form (indentation . bullet). Assumes cursor in item line." "Concatenate BULLET with an appropriate number of whitespaces. It determines the number of whitespaces to append by looking at `org-list-two-spaces-after-bullet-regexp'." - (concat - bullet " " - ;; Do we need to concat another white space ? - (when (string-match org-list-two-spaces-after-bullet-regexp bullet) " "))) + (save-match-data + (concat + bullet " " + ;; Do we need to concat another white space ? + (when (string-match org-list-two-spaces-after-bullet-regexp bullet) " ")))) (defun org-list-replace-bullet (new-bullet) "Replace current item's bullet with NEW-BULLET. diff --git a/lisp/org.el b/lisp/org.el index 2f100b7cb..8a837befe 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17335,21 +17335,21 @@ If the first line is normal text, add an item bullet to each line." ;; We already have items, de-itemize (while (< (setq l (1+ l)) l2) (when (org-at-item-p) - (goto-char (match-beginning 2)) - (delete-region (match-beginning 2) (match-end 2)) - (and (looking-at "[ \t]+") (replace-match ""))) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) (beginning-of-line 2)) (if (org-on-heading-p) ;; Headings, convert to items (while (< (setq l (1+ l)) l2) (if (looking-at org-outline-regexp) - (replace-match "- " t t)) + (replace-match (org-list-bullet-string "-") t t)) (beginning-of-line 2)) ;; normal lines, turn them into items (while (< (setq l (1+ l)) l2) (unless (org-at-item-p) (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match "\\1- \\2"))) + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) (beginning-of-line 2))))))) (defun org-toggle-heading (&optional nstars) From 7eb193de1d4d7c4eee85b2de13a177b49eb80e8f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 12:29:41 +0200 Subject: [PATCH 193/348] Minor refactoring. --- lisp/org-list.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index e57535400..c287bd51a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1232,8 +1232,7 @@ the whole buffer." (or (ignore-errors (org-entry-get nil "COOKIE_DATA")) "")))) - (cstat 0) - ) + (cstat 0)) (when all (goto-char (point-min)) (outline-next-heading) From a665ecb66647de1caf7890fd1230b958f8239a4b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 12:38:55 +0200 Subject: [PATCH 194/348] Fix bug when `org-list-two-spaces-after-bullet-regexp' would be nil. * org-list.el (org-list-bullet-string): first check if `org-list-two-spaces-after-bullet-regexp' isn't nil. --- lisp/org-list.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c287bd51a..6596c516d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -995,7 +995,9 @@ It determines the number of whitespaces to append by looking at (concat bullet " " ;; Do we need to concat another white space ? - (when (string-match org-list-two-spaces-after-bullet-regexp bullet) " ")))) + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp bullet)) + " ")))) (defun org-list-replace-bullet (new-bullet) "Replace current item's bullet with NEW-BULLET. From d9c4c52533eb11615f10b8d0301b391825eeb859 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 12:43:54 +0200 Subject: [PATCH 195/348] Documentation fix. --- lisp/org-list.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6596c516d..d7c311ed5 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -915,9 +915,9 @@ children. Return t if sucessful." (defun org-item-indent-positions () "Return indentations and bullets relatives to a plain list item. -This returns a list with three cons-cells: the current item, the -parent item, if any, and the child item. Each cell has the -form (indentation . bullet). Assumes cursor in item line." +This returns a list with three cons-cells containing indentation +and bullet of: the item, the item after a promotion, and the item +after being demoted. Assume cursor in item line." (let* ((init-bul (lambda (bullet) (if (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet) (concat "1" (match-string 1 bullet)) From ee568516e89c6ac0fe1592abc04194970bdb8439 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 13:13:00 +0200 Subject: [PATCH 196/348] Bug fix when indenting items. * org-list.el (org-indent-item-tree): Removed region code. It was prone to errors and undocumented. * org-list.el (org-item-indent-positions): Better heuristics to determine what bullet the item will have when demoted. --- lisp/org-list.el | 36 +++++++++++++++++++++++------------- 1 file changed, 23 insertions(+), 13 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index d7c311ed5..8f0672357 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -800,7 +800,6 @@ If NO-SUBTREE is set, only outdent the item itself, not its children." If NO-SUBTREE is set, only indent the item itself, not its children. Return t if sucessful." (interactive "p") - (and (org-region-active-p) (org-cursor-to-region-beginning)) (unless (org-at-item-p) (error "Not on an item")) (let ((line (org-current-line)) @@ -810,7 +809,6 @@ children. Return t if sucessful." (goto-char (org-list-top-point)) (org-get-indentation))) beg end ind ind1 ind-pos bullet delta ind-down ind-up) - (setq end (and (org-region-active-p) (region-end))) ;; If moving a subtree, don't drag additional items on subsequent ;; moves. (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) @@ -834,7 +832,9 @@ children. Return t if sucessful." delta (if (> arg 0) (if ind-down (- ind-down ind) 2) (if ind-up (- ind-up ind) -2))) - ;; Make some checks before indenting. + + + ;; Check for error cases. (cond ((< (+ delta ind) 0) (goto-char pos) @@ -863,6 +863,8 @@ children. Return t if sucessful." (save-excursion (goto-char (1- end)) (org-item-has-child-p))) (goto-char pos) (error "Cannot outdent an item having children"))))) + + ;; Replace bullet of current item with the bullet it is going to ;; have if we're outdenting. This is needed to prevent indentation ;; problems of subtrees when outdenting changes bullet size. @@ -876,6 +878,8 @@ children. Return t if sucessful." (delete-region (point-at-bol) (point)) (or (eolp) (org-indent-to-column (+ ind1 delta))) (beginning-of-line 2)) + + ;; Get back to original position, shifted by delta (goto-line line) (move-to-column (max (+ delta col) 0)) @@ -918,7 +922,8 @@ children. Return t if sucessful." This returns a list with three cons-cells containing indentation and bullet of: the item, the item after a promotion, and the item after being demoted. Assume cursor in item line." - (let* ((init-bul (lambda (bullet) + (let* ((pos (point)) + (init-bul (lambda (bullet) (if (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet) (concat "1" (match-string 1 bullet)) bullet))) @@ -936,15 +941,20 @@ after being demoted. Assume cursor in item line." ;; Child of previous item, if any. (item-down (save-excursion (let ((prev-p (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list))))) - (if (and prev-p (goto-char prev-p) (org-item-has-child-p)) - (progn - (org-end-of-item-or-at-child) - (cons (org-get-indentation) - (funcall init-bul (org-get-bullet)))) - (goto-char pos) - (org-at-item-p) - (goto-char (match-end 0)) - (cons (current-column) (cdr item-cur))))))) + (cond + ((and prev-p (goto-char prev-p) (org-item-has-child-p)) + (progn + (org-end-of-item-or-at-child) + (cons (org-get-indentation) + (funcall init-bul (org-get-bullet))))) + ((and (goto-char pos) (org-item-has-child-p)) + (progn + (org-end-of-item-or-at-child) + (cons (org-get-indentation) + (funcall init-bul (org-get-bullet))))) + (t (org-at-item-p) + (goto-char (match-end 0)) + (cons (current-column) (cdr item-cur)))))))) (list item-cur item-up item-down))) (defvar org-tab-ind-state) From 5903c0844746e3f9ef3005f4ab946e26cfaa6ba3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 14:25:05 +0200 Subject: [PATCH 197/348] Moving top list item will move whole list only if moving by subtree. * org-list.el (org-list-automatic-rules): doc-string reflects this change. * org-list.el (org-indent-item-tree): prevent whole list from being moved when user is not moving subtree. Thus, `org-cycle-item-indentation' will not allow to move the list. --- lisp/org-list.el | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8f0672357..881001b7d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -185,10 +185,11 @@ checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. It also prevents from inserting a checkbox in a description item. -indent when non-nil indenting or outdenting list top-item will - move the whole list, indenting the first item of a - sub-list will be forbidden and outdenting a list whose - bullet is * to column 0 will change that bullet to -. +indent when non-nil indenting or outdenting list top-item with + its subtree will move the whole list, all moves that + would break list will be forbidden, and outdenting a + list whose bullet is * to column 0 will change that + bullet to -. insert when non-nil, trying to insert an item inside a block will insert it right before the block instead of throwing an error. @@ -844,7 +845,8 @@ children. Return t if sucessful." (cond ;; 1. If at top-point move the whole list. Moreover, if ;; *-list is going to column 0, change bullet to "-". - ((= (point-at-bol) (org-list-top-point)) + ((and (= (point-at-bol) (org-list-top-point)) + (not no-subtree)) (when (and (= (+ delta ind) 0) (equal bullet "*")) (org-fix-bullet-type (setq bullet "-"))) (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) From c5f408122109eceaac48b382d854082d73692f9b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 29 Jul 2010 19:11:06 +0200 Subject: [PATCH 198/348] Fix reordering bug when when cycling indentation above 10th item. * org-list.el : Removed unused variable `org-suppress-item-indentation'. * org-list.el (org-renumber-ordered-list): Skip item if bullet number is already good. --- lisp/org-list.el | 29 ++++++++++++----------------- 1 file changed, 12 insertions(+), 17 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 881001b7d..41619d6b3 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -759,23 +759,19 @@ invisible." (t (throw 'exit t))))) i)) -(defvar org-suppress-item-indentation) ; dynamically scoped parameter - (defun org-shift-item-indentation (delta) "Shift the indentation in current item by DELTA." - (unless (org-bound-and-true-p org-suppress-item-indentation) - (save-excursion - (let ((beg (point-at-bol)) - (end (org-end-of-item))) - (beginning-of-line 0) - (while (> (point) beg) - (when (looking-at "[ \t]*\\S-") - ;; this is not an empty line - (let ((i (org-get-indentation))) - (when (and (> i 0) (> (+ i delta) 0)) - (indent-line-to (+ i delta))))) - (beginning-of-line 0)))))) - + (save-excursion + (let ((beg (point-at-bol)) + (end (org-end-of-item))) + (beginning-of-line 0) + (while (> (point) beg) + (when (looking-at "[ \t]*\\S-") + ;; this is not an empty line + (let ((i (org-get-indentation))) + (when (and (> i 0) (> (+ i delta) 0)) + (indent-line-to (+ i delta))))) + (beginning-of-line 0))))) (defvar org-last-indent-begin-marker (make-marker)) (defvar org-last-indent-end-marker (make-marker)) @@ -961,8 +957,7 @@ after being demoted. Assume cursor in item line." (defvar org-tab-ind-state) (defun org-cycle-item-indentation () - (let ((org-suppress-item-indentation t) - (org-adapt-indentation nil)) + (let ((org-adapt-indentation nil)) (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p)) (>= (match-end 0) (save-excursion (org-end-of-item-or-at-child) From 5a3113592a3cc020b32ef138e92dc4dcd960f788 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 2 Aug 2010 11:57:43 +0200 Subject: [PATCH 199/348] Allow multiple [@start:num] in a list. * org-list.el (org-renumber-ordered-list): check for [@start:x] is done at each item. --- lisp/org-list.el | 60 +++++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 29 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 41619d6b3..f1844e73d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1038,35 +1038,37 @@ Also, fix the indentation." Cursor needs to be in the first line of an item, the line that starts with something like \"1.\" or \"2)\". Start to count at ARG or 1." (interactive "p") - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (org-preserve-lc - (let* ((offset (progn - (org-beginning-of-item) - (or (and (looking-at "[ \t]*\\[@start:\\([0-9]+\\)") - (string-to-number (match-string 1))) - arg - 1))) - (item-fmt (progn - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (concat "%d" (or (match-string 1) ".")))) - ;; Here is the function applied at each item of the list. - (renumber-item (lambda (counter off fmt) - (let* ((new (format fmt (+ counter off))) - (old (progn - (looking-at org-item-beginning-re) - (match-string 2))) - (begin (match-beginning 2)) - (end (match-end 2))) - (delete-region begin end) - (goto-char begin) - (insert new) - ;; In case item number went from 9. to 10. - ;; or the other way. - (org-shift-item-indentation (- (length new) (length old))) - (1+ counter))))) - (org-apply-on-list renumber-item 0 offset item-fmt)))) + (save-match-data + (unless (and (org-at-item-p) + (match-beginning 3)) + (error "This is not an ordered list")) + (org-preserve-lc + (let* ((item-fmt (progn + (looking-at "[ \t]*[0-9]+\\([.)]\\)") + (concat "%d" (or (match-string 1) ".")))) + ;; Here is the function applied at each item of the list. + (renumber-item (lambda (counter fmt) + (let* ((counter (or (save-excursion + (and (org-at-item-p) + (goto-char (match-end 0)) + (looking-at "\\[@start:\\([0-9]+\\)\\]") + (string-to-number (match-string 1)))) + counter)) + (new (format fmt counter)) + (old (progn + (looking-at org-item-beginning-re) + (match-string 2))) + (begin (match-beginning 2)) + (end (match-end 2))) + (unless (equal new old) + (delete-region begin end) + (goto-char begin) + (insert new) + ;; In case item number went from 9. to 10. + ;; or the other way. + (org-shift-item-indentation (- (length new) (length old)))) + (1+ counter))))) + (org-apply-on-list renumber-item (or arg 1) item-fmt))))) (defun org-maybe-renumber-ordered-list () "Renumber the ordered list at point if setup allows it. From 0dab6a2e1be1a79a142fee4f75ecabc3a4286727 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 2 Aug 2010 12:33:29 +0200 Subject: [PATCH 200/348] Do not enforce white spaces just after [@start:num]. --- lisp/org-list.el | 4 ++-- lisp/org.el | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index f1844e73d..92c8139fe 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -520,7 +520,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: (error (throw 'exit nil))) (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) (when (org-search-forward-unenclosed - "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@start:[0-9]+\\][ \t]+\\)?\\[[- ]\\]" end t) + "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@start:[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) (org-current-line))))))) ;;; Navigate @@ -1472,7 +1472,7 @@ sublevels as a list of strings." (nextitem (or (org-get-next-item (point) end) end)) (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child)))) (nextindent (if (= (point) end) 0 (org-get-indentation))) - (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]+\\)?\\[\\([xX ]\\)\\]" item) + (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" item) (replace-match (if (equal (match-string 1 item) " ") "CBOFF" "CBON") diff --git a/lisp/org.el b/lisp/org.el index 8a837befe..5f2bdc5d2 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5457,7 +5457,7 @@ needs to be inserted at a specific position in the font-lock sequence.") '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\(?:[ \t]+\\[@start:[0-9]+\\]\\)?\\)[ \t]+\\(\\[[- X]\\]\\)" + '("^[ \t]*\\([-+*]\\|[0-9]+[.)][ \t]+\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\)\\(\\[[- X]\\]\\)" 2 'org-checkbox prepend) (if org-provide-checkbox-statistics '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" From 12acf70f92ee5e4ce944228e2a033d6376575aab Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 2 Aug 2010 12:37:56 +0200 Subject: [PATCH 201/348] Little fix to ASCII exporter with regards to [@start:num] structures. --- lisp/org-ascii.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index 869e73804..f3b403abb 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -571,9 +571,8 @@ publishing directory." (replace-match "\\1\\2"))) ;; Remove list start counters (goto-char (point-min)) - (while (re-search-forward "\\[@start:[0-9]+\\] ?" nil t) - (org-if-unprotected - (replace-match ""))) + (while (org-search-forward-unenclosed "\\[@start:[0-9]+\\][ \t]*" nil t) + (replace-match "")) (remove-text-properties (point-min) (point-max) '(face nil font-lock-fontified nil font-lock-multiline nil line-prefix nil wrap-prefix nil))) From 030fc40b1d27e0d2f173e457d0f886d53bbcd2b1 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 2 Aug 2010 22:07:46 +0200 Subject: [PATCH 202/348] Minor refactoring. --- lisp/org-list.el | 5 +++-- lisp/org.el | 4 +--- 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 92c8139fe..8bce2d10d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -991,8 +991,9 @@ after being demoted. Assume cursor in item line." ;;; Bullets (defun org-get-bullet () - (and (org-at-item-p) - (org-trim (match-string 1)))) + "Return the bullet of the item at point. +Assume cursor is at an item." + (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))) (defun org-list-bullet-string (bullet) "Concatenate BULLET with an appropriate number of whitespaces. diff --git a/lisp/org.el b/lisp/org.el index 5f2bdc5d2..2e2c41d7d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18241,9 +18241,7 @@ returning a string. An optional third argument bounds the search for START-RE. It defaults to previous heading or `point-min'." (let ((pos (point)) - (limit (or bound - (save-excursion (outline-previous-heading)) - (point-min)))) + (limit (or bound (save-excursion (outline-previous-heading))))) (save-excursion ;; we're on a block when point is on start-re... (or (org-at-regexp-p start-re) From 9eab167626c063917d0c07bacd5f556bfbe11072 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 31 Jul 2010 00:45:34 +0200 Subject: [PATCH 203/348] Indentation is faster and now correct. Indenting region is back. --- lisp/org-list.el | 604 ++++++++++++++++++++++++++++++----------------- 1 file changed, 387 insertions(+), 217 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8bce2d10d..9a0caa829 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -140,7 +140,7 @@ the safe choice." (defcustom org-list-two-spaces-after-bullet-regexp nil "A regular expression matching bullets that should have 2 spaces after them. When nil, no bullet will have two spaces after them. -When a string, it will be used as a regular expression. When the +When a string, it will be used as a regular expression. When the bullet type of a list is changed, the new bullet type will be matched against this regexp. If it matches, there will be two spaces instead of one after the bullet in each item of the list." @@ -157,7 +157,7 @@ Otherwise, look for `org-list-end-regexp'." (defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n" "Regexp matching the end of all plain list levels. -It must start with \"^\" and end with \"\\n\". It defaults to 2 +It must start with \"^\" and end with \"\\n\". It defaults to 2 blank lines. `org-empty-line-terminates-plain-lists' has precedence over it." :group 'org-plain-lists @@ -186,8 +186,7 @@ checkbox when non-nil, checkbox statistics is updated each time It also prevents from inserting a checkbox in a description item. indent when non-nil indenting or outdenting list top-item with - its subtree will move the whole list, all moves that - would break list will be forbidden, and outdenting a + its subtree will move the whole list and outdenting a list whose bullet is * to column 0 will change that bullet to -. insert when non-nil, trying to insert an item inside a block @@ -642,6 +641,17 @@ Return point." (goto-char (funcall move-up (point) limit)) (goto-char (point-at-bol)))) +(defun org-list-last-item () + "Go to the last item of the current list. +Return point." + (let* ((limit (org-list-bottom-point)) + (get-last-item + (lambda (pos) + (let ((next-p (org-get-next-item pos limit))) + (if next-p (funcall get-last-item next-p) pos))))) + (org-beginning-of-item) + (goto-char (funcall get-last-item (point))))) + (defun org-end-of-item-list () "Go to the end of the current list or sublist. Return point." @@ -746,6 +756,267 @@ invisible." (not (cdr (assq 'checkbox org-list-automatic-rules))))) desc-text))))) +;;; Structures + +;; The idea behind structures is to avoid moving back and forth in the +;; buffer on costly operations like indenting or fixing bullets. + +;; It achieves this by taking a snapshot of an interesting part of the +;; list, in the shape of an alist, with `org-list-struct'. + +;; It then proceeds to changes directly on the alist. When those are +;; done, `org-list-struct-apply-struct' applies the changes in the +;; buffer. + +(defun org-list-struct-assoc-at-point () + "Return the structure association at point. +It is a cons-cell whose key is point and values are indentation, +bullet string and bullet counter, if any." + (save-excursion + (beginning-of-line) + (list (point-at-bol) + (org-get-indentation) + (progn + (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)") + (match-string 1)) + (progn + (goto-char (match-end 0)) + (and (looking-at "\\[@start:\\([0-9]+\\)\\]") + (match-string 1)))))) + +(defun org-list-struct (begin end &optional outdent) + "Return the structure containing the list between BEGIN and END. + +A structure is an alist where key is point of item and values +are, in that order, indentation, bullet string and value of +counter if any. The structure contains every list and sublist +that has items between BEGIN and END and their common parent, if +any. + +If OUTDENT is non-nil, it will also grab all of the parent list +and the grand-parent. Setting OUTDENT to t is mandatory when next +change is an outdent." + (save-excursion + (let* ((top (org-list-top-point)) + (bottom (org-list-bottom-point)) + struct + (extend + (lambda (struct) + (let* ((ind-min (apply 'min (mapcar 'cadr struct))) + (begin (caar struct)) + (end (caar (last struct))) + pre-list post-list) + (goto-char begin) + ;; Find beginning of most outdented list (min list) + (while (and (org-search-backward-unenclosed org-item-beginning-re top t) + (>= (org-get-indentation) ind-min)) + (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list))) + ;; Now get the parent, if any. If not, add a virtual + ;; ancestor at position 0. + (if (< (org-get-indentation) ind-min) + (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list)) + (setq pre-list (cons (list 0 (org-get-indentation) "" nil) pre-list))) + ;; Find end of min list + (goto-char end) + (end-of-line) + (while (and (org-search-forward-unenclosed org-item-beginning-re bottom t) + (>= (org-get-indentation) ind-min)) + (setq post-list (cons (org-list-struct-assoc-at-point) post-list))) + (append pre-list struct (reverse post-list)))))) + ;; Here we start: first get the core zone... + (goto-char end) + (while (org-search-backward-unenclosed org-item-beginning-re begin t) + (setq struct (cons (org-list-struct-assoc-at-point) struct))) + ;; ... then, extend it to make it a structure... + (let ((extended (funcall extend struct))) + ;; ... twice when OUTDENT is non-nil and struct still can be + ;; extended + (if (and outdent (> (caar extended) 0)) + (funcall extend extended) + extended))))) + +(defun org-list-struct-origins (struct) + "Return an alist where key is item's position and value parent's. +Common ancestor of structure is, as a convention, at position 0." + (let* ((struct-rev (reverse struct)) + (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev))))) + (get-origins + (lambda (item) + (let* ((item-pos (car item)) + (ind (nth 1 item)) + (prev-ind (caar acc))) + (cond + ;; List closing. + ((> prev-ind ind) + (setq acc (member (assq ind acc) acc)) + (cons item-pos (cdar acc))) + ;; New list + ((< prev-ind ind) + (let ((origin (funcall prev-item item-pos))) + (setq acc (cons (cons ind origin) acc)) + (cons item-pos origin))) + ;; Current list going on + (t (cons item-pos (cdar acc))))))) + (acc (list (cons (nth 1 (car struct)) 0)))) + (cons '(0 . 0) (mapcar get-origins (cdr struct))))) + +(defun org-list-struct-get-parent (item struct origins) + "Return parent association of ITEM in STRUCT or nil." + (let* ((parent-pos (cdr (assq (car item) origins)))) + (when (> parent-pos 0) (assq parent-pos struct)))) + +(defun org-list-struct-get-child (item struct) + "Return child association of ITEM in STRUCT or nil." + (let ((ind (nth 1 item)) + (next-item (cadr (member item struct)))) + (when (and next-item (> (nth 1 next-item) ind)) next-item))) + +(defun org-list-struct-fix-bul (struct origins) + "Verify and correct bullets for every association in STRUCT. +This function modifies STRUCT." + (let* ((init-bul (lambda (item) + (let ((counter (nth 3 item)) + (bullet (org-list-bullet-string (nth 2 item)))) + (cond + ((and (string-match "[0-9]+" bullet) counter) + (replace-match counter nil nil bullet)) + ((string-match "[0-9]+" bullet) + (replace-match "1" nil nil bullet)) + (t bullet))))) + (set-bul (lambda (item bullet) + (setcdr item (list (nth 1 item) bullet (nth 3 item))))) + (get-bul (lambda (item bullet) + (let* ((counter (nth 3 item))) + (if (and counter (string-match "[0-9]+" bullet)) + (replace-match counter nil nil bullet) + bullet)))) + (fix-bul + (lambda (item) struct + (let* ((parent (cdr (assq (car item) origins))) + (orig-ref (assq parent acc))) + (if orig-ref + ;; Continuing previous list + (let* ((prev-bul (cdr orig-ref)) + (new-bul (funcall get-bul item prev-bul))) + (setcdr orig-ref (org-list-inc-bullet-maybe new-bul)) + (funcall set-bul item new-bul)) + ;; A new list is starting + (let ((new-bul (funcall init-bul item))) + (funcall set-bul item new-bul) + (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc))))))) + acc) + (mapc fix-bul (cdr struct)))) + +(defun org-list-struct-fix-ind (struct origins) + "Verify and correct indentation for every association in STRUCT. +This function modifies STRUCT." + (let* ((headless (cdr struct)) + (ancestor (car struct)) + (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) + (new-ind + (lambda (item) + (let* ((parent (org-list-struct-get-parent item headless origins))) + (if parent + ;; Indent like parent + length of parent's bullet + (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) (cddr item))) + ;; If no parent, indent like top-point + (setcdr item (cons top-ind (cddr item)))))))) + (mapc new-ind headless))) + +(defun org-list-struct-fix-struct (struct origins) + "Return STRUCT with correct bullets and indentation. +Only elements of STRUCT that have changed are returned." + (let ((before (copy-alist struct)) + (set-diff (lambda (setA setB result) + (cond + ((null setA) result) + ((equal (car setA) (car setB)) + (funcall set-diff (cdr setA) (cdr setB) result)) + (t (funcall set-diff (cdr setA) (cdr setB) (cons (car setA) result))))))) + (org-list-struct-fix-bul struct origins) + (org-list-struct-fix-ind struct origins) + (nreverse (funcall set-diff struct before nil)))) + +(defun org-list-struct-outdent (start end origins) + "Outdent items in ORIGINS between BEGIN and END. +BEGIN is included and END excluded." + (let ((out (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ;; Item out of zone: follow associations in acc + ((>= item end) + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + ;; Item has no parent: error + ((<= parent 0) + (error "Cannot outdent top-level items")) + ;; Parent is outdented: keep association + ((>= parent start) + (setq acc (cons (cons parent item) acc)) cell) + (t + ;; Parent isn't outdented: reparent to grand-parent + (let ((grand-parent (cdr (assq parent origins)))) + (setq acc (cons (cons parent item) acc)) + (cons item grand-parent))))))) + acc) + (mapcar out origins))) + +(defun org-list-struct-indent (start end origins) + "Indent items in ORIGINS between BEGIN and END. +BEGIN is included and END excluded." + (let* ((orig-rev (reverse origins)) + (get-prev-item (lambda (cell parent) + (car (rassq parent (cdr (memq cell orig-rev)))))) + (set-assoc (lambda (cell) + (setq acc (cons cell acc)) cell)) + (ind + (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ((>= item end) + ;; Item out of zone: follow associations in acc + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + (t + ;; Item is in zone... + (let ((prev (funcall get-prev-item cell parent))) + (cond + ;; First item indented but not parent: error + ((and (or (not prev) (= prev 0)) (< parent start)) + (error "Cannot indent the first item of a list")) + ;; First item and parent indented: keep same parent + ((or (not prev) (= prev 0)) + (funcall set-assoc cell)) + ;; Previous item not indented: reparent to it + ((< prev start) + (funcall set-assoc (cons item prev))) + ;; Previous item indented: reparent like it + (t + (funcall set-assoc (cons item (cdr (assq prev acc)))))))))))) + acc) + (mapcar ind origins))) + +(defun org-list-struct-apply-struct (struct) + "Apply modifications to list so it mirrors STRUCT. +Initial position is restored after the changes." + (let* ((pos (copy-marker (point))) + (modify + (lambda (item) + (goto-char (car item)) + (org-list-indent-item (nth 1 item)) + (org-list-replace-bullet (org-list-bullet-string (nth 2 item))))) + ;; Remove ancestor if it is left. + (struct-to-apply (if (= 0 (caar struct)) (cdr struct) struct))) + ;; Apply changes from bottom to top + (mapc modify (nreverse struct-to-apply)) + (goto-char pos))) + ;;; Indentation (defun org-get-string-indentation (s) @@ -760,11 +1031,12 @@ invisible." i)) (defun org-shift-item-indentation (delta) - "Shift the indentation in current item by DELTA." + "Shift the indentation in current item by DELTA. +Sub-items are not moved." (save-excursion (let ((beg (point-at-bol)) - (end (org-end-of-item))) - (beginning-of-line 0) + (end (org-end-of-item-or-at-child))) + (beginning-of-line (unless (eolp) 0)) (while (> (point) beg) (when (looking-at "[ \t]*\\S-") ;; this is not an empty line @@ -773,18 +1045,27 @@ invisible." (indent-line-to (+ i delta))))) (beginning-of-line 0))))) -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) +(defun org-list-indent-item (ind) + "Change indentation of item at point to IND. +It does not move sub-lists." + (save-excursion + (beginning-of-line) + (let ((old-ind (org-get-indentation))) + (unless (= ind old-ind) + (org-shift-item-indentation (- ind old-ind)) + (skip-chars-forward " \t") + (delete-region (point-at-bol) (point)) + (org-indent-to-column ind))))) (defun org-outdent-item (arg) "Outdent a local list item, but not its children." (interactive "p") - (org-indent-item-tree (- arg) 'no-subtree)) + (org-indent-item-tree (- arg) t)) (defun org-indent-item (arg) "Indent a local list item, but not its children." (interactive "p") - (org-indent-item-tree arg 'no-subtree)) + (org-indent-item-tree arg t)) (defun org-outdent-item-tree (arg &optional no-subtree) "Outdent a local list item including its children. @@ -792,169 +1073,69 @@ If NO-SUBTREE is set, only outdent the item itself, not its children." (interactive "p") (org-indent-item-tree (- arg) no-subtree)) +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) + (defun org-indent-item-tree (arg &optional no-subtree) "Indent a local list item including its children. If NO-SUBTREE is set, only indent the item itself, not its -children. Return t if sucessful." +children. Return t if successful." (interactive "p") (unless (org-at-item-p) (error "Not on an item")) - (let ((line (org-current-line)) - (col (current-column)) - (pos (point)) - (origin-ind (save-excursion - (goto-char (org-list-top-point)) - (org-get-indentation))) - beg end ind ind1 ind-pos bullet delta ind-down ind-up) - ;; If moving a subtree, don't drag additional items on subsequent - ;; moves. - (if (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (setq beg org-last-indent-begin-marker - end org-last-indent-end-marker) - (org-beginning-of-item) - (setq beg (move-marker org-last-indent-begin-marker (point))) - ;; Determine end point of indentation - (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item)) - (setq end (move-marker org-last-indent-end-marker (or end (point))))) - ;; Get some information - (goto-char beg) - (setq ind-pos (org-item-indent-positions) - bullet (cdr (car ind-pos)) - bul-up (cdr (nth 1 ind-pos)) - bul-down (cdr (nth 2 ind-pos)) - ind (caar ind-pos) - ind-down (car (nth 2 ind-pos)) - ind-up (car (nth 1 ind-pos)) - delta (if (> arg 0) - (if ind-down (- ind-down ind) 2) - (if ind-up (- ind-up ind) -2))) - - - ;; Check for error cases. + ;; Determine begin and end points of zone to indent. If moving by + ;; subtrees, ensure we don't drag additional items on subsequent + ;; moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if (org-region-active-p) + (progn + (set-marker org-last-indent-begin-marker (region-beginning)) + (set-marker org-last-indent-end-marker (region-end))) + (set-marker org-last-indent-begin-marker (save-excursion (org-beginning-of-item))) + (set-marker org-last-indent-end-marker + (save-excursion + (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item)))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (org-list-struct beg end (< arg 0))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct)) + (end-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (org-beginning-of-item) + (org-list-struct-assoc-at-point))) + (top (org-list-top-point))) (cond - ((< (+ delta ind) 0) - (goto-char pos) - (error "Cannot outdent beyond margin")) - ;; Apply indent rules if activated. - ((cdr (assq 'indent org-list-automatic-rules)) - (cond - ;; 1. If at top-point move the whole list. Moreover, if - ;; *-list is going to column 0, change bullet to "-". - ((and (= (point-at-bol) (org-list-top-point)) - (not no-subtree)) - (when (and (= (+ delta ind) 0) (equal bullet "*")) - (org-fix-bullet-type (setq bullet "-"))) - (setq end (set-marker org-last-indent-end-marker (org-list-bottom-point)))) - ;; 2. Do not indent before top-item. - ((< (+ delta ind) origin-ind) - (goto-char pos) - (error "Cannot outdent beyond top level item")) - ;; 3. Do not indent the first item of a list. - ((and (org-list-first-item-p) (> delta 0)) - (goto-char pos) - (error "Cannot indent the beginning of a sublist")) - ;; 4. Do not outdent item that has children without moving - ;; subtree. If moving subtree, the rule applies to its last - ;; sub-item. - ((and (< delta 0) - (save-excursion (goto-char (1- end)) (org-item-has-child-p))) - (goto-char pos) - (error "Cannot outdent an item having children"))))) - - - ;; Replace bullet of current item with the bullet it is going to - ;; have if we're outdenting. This is needed to prevent indentation - ;; problems of subtrees when outdenting changes bullet size. - (when (< delta 0) - (let ((new-bul (org-list-bullet-string (or bul-up bullet)))) - (org-list-replace-bullet new-bul))) - ;; Proceed to reindentation. - (while (< (point) end) - (beginning-of-line) - (skip-chars-forward " \t") (setq ind1 (current-column)) - (delete-region (point-at-bol) (point)) - (or (eolp) (org-indent-to-column (+ ind1 delta))) - (beginning-of-line 2)) - - - ;; Get back to original position, shifted by delta - (goto-line line) - (move-to-column (max (+ delta col) 0)) - ;; Fix and reorder all lists and sublists from list at point. If - ;; it has a parent and we're indenting, renumber parent too. - (save-excursion - ;; Renumber parent list, if needed. No need for fixing bullets - (org-beginning-of-item-list) - (unless (or (< arg 0) (= (org-list-top-point) (point))) - (beginning-of-line 0) - (org-beginning-of-item) - (org-maybe-renumber-ordered-list))) - ;; Take care of list at point. When demoting, to determine bullet - ;; of children, follow, in order: `org-list-demote-modify-bullet', - ;; same bullet as others children, same bullet as before - (org-fix-bullet-type - (and (> arg 0) - (or (cdr (assoc bullet org-list-demote-modify-bullet)) - bul-down))) - (save-excursion - (when (org-item-has-child-p) - ;; Take care of child, or of every sublist if we're moving a - ;; subtree. - (org-end-of-item-or-at-child) - (if no-subtree - (org-fix-bullet-type) - (let ((fix-list (lambda (i) - (when (org-list-first-item-p) - (org-fix-bullet-type - (and (> arg 0) - (cdr (assoc (org-get-bullet) org-list-demote-modify-bullet))))) - (when (org-item-has-child-p) - (org-end-of-item-or-at-child) - (org-apply-on-list fix-list nil))))) - (org-apply-on-list fix-list nil)))))) + ;; Special case: moving top-item with indent rule + ((and (= top beg) (cdr (assq 'indent org-list-automatic-rules))) + (let ((offset (if (< arg 0) -2 2)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + (when (and (= (+ top-ind offset) 0) (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) (org-list-bullet-string "-")))) + (mapc '(lambda (item) (setcdr item (cons (+ (nth 1 item) offset) (cddr item)))) struct) + (org-list-struct-apply-struct struct)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not (org-region-active-p)) + (org-list-struct-get-child beg-item struct)) + (org-list-struct-get-child end-item struct))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct))))) + ;; Return value t) -(defun org-item-indent-positions () - "Return indentations and bullets relatives to a plain list item. -This returns a list with three cons-cells containing indentation -and bullet of: the item, the item after a promotion, and the item -after being demoted. Assume cursor in item line." - (let* ((pos (point)) - (init-bul (lambda (bullet) - (if (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet) - (concat "1" (match-string 1 bullet)) - bullet))) - ;; Current item - (item-cur (cons (org-get-indentation) - (funcall init-bul (org-get-bullet)))) - ;; Parent - (item-up (save-excursion - (org-beginning-of-item-list) - (unless (= (org-list-top-point) (point)) - (beginning-of-line 0) - (org-beginning-of-item) - (cons (org-get-indentation) - (funcall init-bul (org-get-bullet)))))) - ;; Child of previous item, if any. - (item-down (save-excursion - (let ((prev-p (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list))))) - (cond - ((and prev-p (goto-char prev-p) (org-item-has-child-p)) - (progn - (org-end-of-item-or-at-child) - (cons (org-get-indentation) - (funcall init-bul (org-get-bullet))))) - ((and (goto-char pos) (org-item-has-child-p)) - (progn - (org-end-of-item-or-at-child) - (cons (org-get-indentation) - (funcall init-bul (org-get-bullet))))) - (t (org-at-item-p) - (goto-char (match-end 0)) - (cons (current-column) (cdr item-cur)))))))) - (list item-cur item-up item-down))) - (defvar org-tab-ind-state) (defun org-cycle-item-indentation () (let ((org-adapt-indentation nil)) @@ -996,21 +1177,34 @@ Assume cursor is at an item." (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))) (defun org-list-bullet-string (bullet) - "Concatenate BULLET with an appropriate number of whitespaces. + "Return BULLET with the correct number of whitespaces. It determines the number of whitespaces to append by looking at `org-list-two-spaces-after-bullet-regexp'." (save-match-data - (concat - bullet " " - ;; Do we need to concat another white space ? - (when (and org-list-two-spaces-after-bullet-regexp - (string-match org-list-two-spaces-after-bullet-regexp bullet)) - " ")))) + (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match + (save-match-data + (concat + " " + ;; Do we need to concat another white space ? + (when (and org-list-two-spaces-after-bullet-regexp + (string-match org-list-two-spaces-after-bullet-regexp bullet)) + " "))) + nil nil bullet 1))) + +(defun org-list-inc-bullet-maybe (bullet) + "Increment numbered bullets." + (if (string-match "[0-9]+" bullet) + (replace-match + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet) + bullet)) (defun org-list-replace-bullet (new-bullet) "Replace current item's bullet with NEW-BULLET. -Assume point is at item. Indent body if needed." +Item body is re-indented, but sub-lists are not moved. Assume +point is at item." (save-excursion + (beginning-of-line) (let ((old (progn (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") (match-string 1)))) @@ -1018,58 +1212,34 @@ Assume point is at item. Indent body if needed." (replace-match new-bullet nil nil nil 1) ;; When bullet lengths are differents, move the whole ;; sublist accordingly - (org-shift-item-indentation (- (length new-bullet) (length old))))))) + (org-shift-item-indentation + (- (length new-bullet) (length old))))))) (defun org-fix-bullet-type (&optional force-bullet) "Make sure all items in this list have the same bullet as the first item. Also, fix the indentation." (interactive) (unless (org-at-item-p) (error "This is not a list")) - (org-preserve-lc - (let* ((ini-bul (progn (org-beginning-of-item-list) (org-get-bullet))) - (bullet (org-list-bullet-string (or force-bullet ini-bul))) - (replace-bullet - (lambda (result bullet) - (org-list-replace-bullet bullet)))) - (org-apply-on-list replace-bullet nil bullet) - (org-maybe-renumber-ordered-list)))) + (let* ((struct (org-list-struct (point-at-bol) (point-at-eol))) + (origins (org-list-struct-origins struct)) + fixed-struct) + (if force-bullet + (let ((begin (nth 1 struct))) + (setcdr begin (list (nth 1 begin) (org-list-bullet-string force-bullet) (nth 3 begin))) + (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins)))) + (setq fixed-struct (org-list-struct-fix-struct struct origins))) + (org-list-struct-apply-struct fixed-struct))) -(defun org-renumber-ordered-list (&optional arg) +(defun org-renumber-ordered-list () "Renumber an ordered plain list. -Cursor needs to be in the first line of an item, the line that starts -with something like \"1.\" or \"2)\". Start to count at ARG or 1." - (interactive "p") - (save-match-data - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (org-preserve-lc - (let* ((item-fmt (progn - (looking-at "[ \t]*[0-9]+\\([.)]\\)") - (concat "%d" (or (match-string 1) ".")))) - ;; Here is the function applied at each item of the list. - (renumber-item (lambda (counter fmt) - (let* ((counter (or (save-excursion - (and (org-at-item-p) - (goto-char (match-end 0)) - (looking-at "\\[@start:\\([0-9]+\\)\\]") - (string-to-number (match-string 1)))) - counter)) - (new (format fmt counter)) - (old (progn - (looking-at org-item-beginning-re) - (match-string 2))) - (begin (match-beginning 2)) - (end (match-end 2))) - (unless (equal new old) - (delete-region begin end) - (goto-char begin) - (insert new) - ;; In case item number went from 9. to 10. - ;; or the other way. - (org-shift-item-indentation (- (length new) (length old)))) - (1+ counter))))) - (org-apply-on-list renumber-item (or arg 1) item-fmt))))) +Cursor needs to be in the first line of an item." + (interactive) + (unless (and (org-at-item-p) + (match-beginning 3)) + (error "This is not an ordered list")) + (let* ((struct (org-list-struct (point-at-bol) (point-at-eol))) + (origins (org-list-struct-origins struct))) + (org-list-struct-apply-struct (org-list-struct-fix-struct struct origins)))) (defun org-maybe-renumber-ordered-list () "Renumber the ordered list at point if setup allows it. From 5d196be9588d3aceddc81879446fe0ee216c294e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 7 Aug 2010 04:46:16 +0200 Subject: [PATCH 204/348] Small refactoring. --- lisp/org-list.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 9a0caa829..f6d4b7715 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -636,7 +636,7 @@ Return point." (let ((prev-p (org-get-previous-item pos bound))) ;; recurse until no more item of the same level ;; can be found. - (if prev-p (funcall move-up prev-p bound) pos))))) + (if (not prev-p) pos (funcall move-up prev-p bound)))))) ;; Go to the last item found and at bol in case we didn't move (goto-char (funcall move-up (point) limit)) (goto-char (point-at-bol)))) @@ -648,7 +648,7 @@ Return point." (get-last-item (lambda (pos) (let ((next-p (org-get-next-item pos limit))) - (if next-p (funcall get-last-item next-p) pos))))) + (if (not next-p) pos (funcall get-last-item next-p)))))) (org-beginning-of-item) (goto-char (funcall get-last-item (point))))) @@ -1277,7 +1277,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (or (eq org-plain-list-ordered-item-terminator ?.) (org-at-item-description-p))) '("1)")) (unless (and bullet-rule-p - (or (eq org-plain-list-ordered-item-terminator ?\)) + (or (eq org-plain-list-ordered-item-terminator ?\)) (org-at-item-description-p))) '("1.")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) From fd16515b4a88d48362223b19c511c4973cdbc84c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 7 Aug 2010 18:31:54 +0200 Subject: [PATCH 205/348] Removed last call to org-provide-checkbox-statistics. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 2e2c41d7d..d394a01d4 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5459,7 +5459,7 @@ needs to be inserted at a specific position in the font-lock sequence.") ;; Checkboxes '("^[ \t]*\\([-+*]\\|[0-9]+[.)][ \t]+\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\)\\(\\[[- X]\\]\\)" 2 'org-checkbox prepend) - (if org-provide-checkbox-statistics + (if (cdr (assq 'checkbox org-list-automatic-rules)) '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; Description list items From e8967901fa19384dc92ecf9d616a947c3c172fd6 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 7 Aug 2010 18:35:29 +0200 Subject: [PATCH 206/348] Little bug fix. * org-list.el (org-list-struct-apply-struct): check if ancestor exists. --- lisp/org-list.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index f6d4b7715..6adbab97b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1006,13 +1006,14 @@ BEGIN is included and END excluded." "Apply modifications to list so it mirrors STRUCT. Initial position is restored after the changes." (let* ((pos (copy-marker (point))) + (ancestor (caar struct)) (modify (lambda (item) (goto-char (car item)) (org-list-indent-item (nth 1 item)) (org-list-replace-bullet (org-list-bullet-string (nth 2 item))))) ;; Remove ancestor if it is left. - (struct-to-apply (if (= 0 (caar struct)) (cdr struct) struct))) + (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) struct))) ;; Apply changes from bottom to top (mapc modify (nreverse struct-to-apply)) (goto-char pos))) From e890cb5eeb18e0d17f19c975d9ab60e423b9c793 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 7 Aug 2010 18:59:54 +0200 Subject: [PATCH 207/348] Small changes to fontification. --- lisp/org.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index d394a01d4..80b0fbf33 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5457,13 +5457,13 @@ needs to be inserted at a specific position in the font-lock sequence.") '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes - '("^[ \t]*\\([-+*]\\|[0-9]+[.)][ \t]+\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\)\\(\\[[- X]\\]\\)" - 2 'org-checkbox prepend) + '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" + 1 'org-checkbox prepend) (if (cdr (assq 'checkbox org-list-automatic-rules)) '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" (0 (org-get-checkbox-statistics-face) t))) ;; Description list items - '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(.*? ::\\)" + '("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(.*? ::\\)" 2 'bold prepend) ;; ARCHIVEd headings (list (concat "^\\*+ \\(.*:" org-archive-tag ":.*\\)") From a2a72f38fa8cd5f13c7ddf18d91c8c76f4fdad69 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 7 Aug 2010 19:20:16 +0200 Subject: [PATCH 208/348] Toggle checkbox even if not at beginning of line. * org-list.el (org-toggle-checkbox): go to beginning of line before processing. --- lisp/org-list.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6adbab97b..ed12d4166 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1358,6 +1358,7 @@ in subtree." (t "[X]")) t t nil 1)))))))) (save-excursion + (beginning-of-line) (while (< (point) end) (funcall act-on-item ref-presence ref-status) (org-search-forward-unenclosed org-item-beginning-re end 'move))) From d726f924dd9d3162aff3148b1e7ab50a3c3a44da Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 8 Aug 2010 22:28:53 +0200 Subject: [PATCH 209/348] Fix bug when moving a *-list at column 0. Docstrings modifications. * org-list.el (org-indent-item-tree): when moving top item of a *-list to column 0, only the first item had its bullet changed to -. It now changes all items of the top-level list, as expected. --- lisp/org-list.el | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index ed12d4166..4aaaa3dc8 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -789,9 +789,10 @@ bullet string and bullet counter, if any." A structure is an alist where key is point of item and values are, in that order, indentation, bullet string and value of -counter if any. The structure contains every list and sublist -that has items between BEGIN and END and their common parent, if -any. +counter, if any. A structure contains every list and sublist that +has items between BEGIN and END along with their common ancestor. +If no such ancestor can be found, the function will add a virtual +ancestor at position 0. If OUTDENT is non-nil, it will also grab all of the parent list and the grand-parent. Setting OUTDENT to t is mandatory when next @@ -811,8 +812,7 @@ change is an outdent." (while (and (org-search-backward-unenclosed org-item-beginning-re top t) (>= (org-get-indentation) ind-min)) (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list))) - ;; Now get the parent, if any. If not, add a virtual - ;; ancestor at position 0. + ;; Now get the parent. If none, add a virtual ancestor (if (< (org-get-indentation) ind-min) (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list)) (setq pre-list (cons (list 0 (org-get-indentation) "" nil) pre-list))) @@ -836,8 +836,7 @@ change is an outdent." extended))))) (defun org-list-struct-origins (struct) - "Return an alist where key is item's position and value parent's. -Common ancestor of structure is, as a convention, at position 0." + "Return an alist where key is item's position and value parent's." (let* ((struct-rev (reverse struct)) (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev))))) (get-origins @@ -1116,9 +1115,12 @@ children. Return t if successful." (top-ind (nth 1 beg-item))) (if (< (+ top-ind offset) 0) (error "Cannot outdent beyond margin") + ;; Change bullet if necessary (when (and (= (+ top-ind offset) 0) (string-match "*" (nth 2 beg-item))) (setcdr beg-item (list (nth 1 beg-item) (org-list-bullet-string "-")))) - (mapc '(lambda (item) (setcdr item (cons (+ (nth 1 item) offset) (cddr item)))) struct) + ;; Shift ancestor + (let ((anc (car struct))) (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) (org-list-struct-apply-struct struct)))) ;; Forbidden move ((and (< arg 0) From 97c60a1a86919df438b3f7c959254c301e045d15 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 9 Aug 2010 20:03:50 +0200 Subject: [PATCH 210/348] More rules to determine blank lines when inserting item * org-list.el (org-list-insert-item-generic): A single item already counting blank lines in his body should be separated with the next one by a blank line. Moreover, if user already provided blank lines, follow his wishes. --- lisp/org-list.el | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 4aaaa3dc8..b5981e0bc 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -385,7 +385,8 @@ function ends." ;; Guess number of blank lines used to separate items. (blank-lines-nb (let ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry)))) + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + usr-blank) (cond ;; Trivial cases where there should be none. ((or org-empty-line-terminates-plain-lists @@ -401,9 +402,20 @@ function ends." (org-back-over-empty-lines)) ;; Is there a previous item? ((not (org-list-first-item-p)) (org-back-over-empty-lines)) + ;; User inserted blank lines, trust him + ((and (> true-pos (org-end-of-item-before-blank)) + (> (save-excursion + (goto-char true-pos) + (skip-chars-backward " \t") + (setq usr-blank (org-back-over-empty-lines))) 0)) + usr-blank) ;; Item alone: count lines separating it from parent, if any ((/= (org-list-top-point) (point-at-bol)) (org-back-over-empty-lines)) + ;; Are there blank lines inside the item ? + ((save-excursion + (org-search-forward-unenclosed + "^[ \t]*$" (org-end-of-item-before-blank) t)) 1) ;; No parent: no blank line. (t 0))))))) (insert-fun From 0c1b40bd6c2a6fc2dc197e10de1a11d597f872c3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 11 Aug 2010 11:37:36 +0200 Subject: [PATCH 211/348] Removed unused functions. --- lisp/org-list.el | 22 +--------------------- 1 file changed, 1 insertion(+), 21 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b5981e0bc..c57cec2b8 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -503,15 +503,6 @@ function ends." "Is point at a line starting a plain-list item with a checklet?" (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) -(defun org-item-has-child-p () - "Does the current item have subitems?" - (save-excursion - (org-beginning-of-item) - (let ((ind (org-get-indentation))) - (org-end-of-item-or-at-child) - (and (org-at-item-p) - (> (org-get-indentation) ind))))) - (defun org-checkbox-blocked-p () "Is the current checkbox blocked from for being checked now? A checkbox is blocked if all of the following conditions are fulfilled: @@ -653,17 +644,6 @@ Return point." (goto-char (funcall move-up (point) limit)) (goto-char (point-at-bol)))) -(defun org-list-last-item () - "Go to the last item of the current list. -Return point." - (let* ((limit (org-list-bottom-point)) - (get-last-item - (lambda (pos) - (let ((next-p (org-get-next-item pos limit))) - (if (not next-p) pos (funcall get-last-item next-p)))))) - (org-beginning-of-item) - (goto-char (funcall get-last-item (point))))) - (defun org-end-of-item-list () "Go to the end of the current list or sublist. Return point." @@ -676,7 +656,7 @@ Return point." (let ((next-p (org-get-next-item pos bound))) ;; recurse until no more item of the same level ;; can be found. - (if next-p (funcall get-last-item next-p bound) pos))))) + (if (not next-p) pos (funcall get-last-item next-p bound)))))) ;; Move to the last item of every list or sublist encountered, and ;; down to bol of a higher-level item, or limit. (while (and (/= (point) limit) From 443afde30c9fdba0c559695853a871dfb0e20f00 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 11 Aug 2010 13:08:48 +0200 Subject: [PATCH 212/348] Handle `org-list-demote-modify-bullet' * org-list.el (org-list-struct-indent): Added code to replace bullets if needed when indenting. --- lisp/org-list.el | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c57cec2b8..73c2b9468 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -955,14 +955,29 @@ BEGIN is included and END excluded." acc) (mapcar out origins))) -(defun org-list-struct-indent (start end origins) +(defun org-list-struct-indent (start end origins struct) "Indent items in ORIGINS between BEGIN and END. -BEGIN is included and END excluded." +BEGIN is included and END excluded. + +STRUCT may be modified if `org-list-demote-modify-bullet' is +concerning bullets between START and END." (let* ((orig-rev (reverse origins)) - (get-prev-item (lambda (cell parent) - (car (rassq parent (cdr (memq cell orig-rev)))))) - (set-assoc (lambda (cell) - (setq acc (cons cell acc)) cell)) + (get-prev-item + (lambda (cell parent) + (car (rassq parent (cdr (memq cell orig-rev)))))) + (set-assoc + (lambda (cell) + (setq acc (cons cell acc)) cell)) + (change-bullet-maybe + (lambda (item) + (let* ((full-item (assq item struct)) + (item-bul (org-trim (nth 2 full-item))) + (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet)))) + (when new-bul-p + ;; new bullet is stored without space to ensure item + ;; will be modified + (setcdr full-item + (list (nth 1 full-item) new-bul-p (nth 3 full-item))))))) (ind (lambda (cell) (let* ((item (car cell)) @@ -977,6 +992,8 @@ BEGIN is included and END excluded." (t ;; Item is in zone... (let ((prev (funcall get-prev-item cell parent))) + ;; Check if bullet needs to be changed + (funcall change-bullet-maybe item) (cond ;; First item indented but not parent: error ((and (or (not prev) (= prev 0)) (< parent start)) @@ -1125,7 +1142,7 @@ children. Return t if successful." (t (let* ((shifted-ori (if (< arg 0) (org-list-struct-outdent beg end origins) - (org-list-struct-indent beg end origins)))) + (org-list-struct-indent beg end origins struct)))) (org-list-struct-fix-struct struct shifted-ori) (org-list-struct-apply-struct struct))))) ;; Return value From bed92c68639f5dde015c8036980e189267902031 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 12 Aug 2010 14:14:37 +0200 Subject: [PATCH 213/348] Refactoring --- lisp/org-list.el | 73 ++++++++++++++++-------------------------------- 1 file changed, 24 insertions(+), 49 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 73c2b9468..a2fe2a7a1 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -476,9 +476,13 @@ function ends." (not list-ender)))))) (defun org-list-first-item-p () - "Is this item the first item in a plain list?" + "Is this item the first item in a plain list? +Assume point is at an item." (save-excursion - (= (org-beginning-of-item) (org-beginning-of-item-list)))) + (beginning-of-line) + (let ((ind (org-get-indentation))) + (or (not (org-search-backward-unenclosed org-item-beginning-re (org-list-top-point) t)) + (< (org-get-indentation) ind))))) (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" @@ -544,7 +548,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: "Return point just before list ending or nil if not in a list." (save-excursion (and (org-in-item-p) - (let ((pos (org-beginning-of-item)) + (let ((pos (point)) (bound (or (and (let ((outline-regexp org-outline-regexp)) ;; Use default regexp because folding ;; changes OUTLINE-REGEXP. @@ -570,12 +574,10 @@ If the cursor is not in an item, throw an error. Return point." (defun org-end-of-item () "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error." +If the cursor is not in an item, throw an error. Return point." (interactive) (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (cond ((not (org-in-item-p)) (error "Not in an item")) - (next-p (goto-char next-p)) - (t (org-end-of-item-list))))) + (if next-p (goto-char next-p) (org-end-of-item-list)))) (defun org-end-of-item-or-at-child () "Move to the end of the item text, stops before the first child if any." @@ -614,9 +616,7 @@ Item is at the same level in the current plain list. Error if not in a plain list, or if this is the last item in the list." (interactive) (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (if next-p - (goto-char next-p) - (error "On last item")))) + (if next-p (goto-char next-p) (error "On last item")))) (defun org-previous-item () "Move to the beginning of the previous item. @@ -624,24 +624,16 @@ Item is at the same level in the current plain list. Error if not in a plain list, or if this is the first item in the list." (interactive) (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) - (if prev-p - (goto-char prev-p) - (error "On first item")))) + (if prev-p (goto-char prev-p) (error "On first item")))) (defun org-beginning-of-item-list () "Go to the beginning item of the current list or sublist. Return point." (interactive) - (org-beginning-of-item) (let ((limit (org-list-top-point)) - (move-up (lambda (pos bound) - ;; prev-p: any item of same level before ? - (let ((prev-p (org-get-previous-item pos bound))) - ;; recurse until no more item of the same level - ;; can be found. - (if (not prev-p) pos (funcall move-up prev-p bound)))))) - ;; Go to the last item found and at bol in case we didn't move - (goto-char (funcall move-up (point) limit)) + prev-p) + (while (setq prev-p (org-get-previous-item (point) limit)) + (goto-char prev-p)) (goto-char (point-at-bol)))) (defun org-end-of-item-list () @@ -650,22 +642,11 @@ Return point." (interactive) (org-beginning-of-item) (let ((limit (org-list-bottom-point)) - (ind (org-get-indentation)) - (get-last-item (lambda (pos bound) - ;; next-p: any item of same level after ? - (let ((next-p (org-get-next-item pos bound))) - ;; recurse until no more item of the same level - ;; can be found. - (if (not next-p) pos (funcall get-last-item next-p bound)))))) - ;; Move to the last item of every list or sublist encountered, and - ;; down to bol of a higher-level item, or limit. + (ind (org-get-indentation))) (while (and (/= (point) limit) (>= (org-get-indentation) ind)) - (goto-char (funcall get-last-item (point) limit)) - (end-of-line) - (when (org-search-forward-unenclosed org-item-beginning-re limit 'move) - (beginning-of-line))) - (point))) + (org-search-forward-unenclosed org-item-beginning-re limit 'move)) + (if (= (point) limit) limit (goto-char (point-at-bol))))) ;;; Manipulate @@ -694,7 +675,7 @@ so this really moves item trees." (let ((pos (point)) (col (current-column)) (actual-item (org-beginning-of-item)) - (next-item (org-get-next-item (point) (save-excursion (org-end-of-item-list))))) + (next-item (org-get-next-item (point) (org-list-bottom-point)))) (if (not next-item) (progn (goto-char pos) @@ -712,7 +693,7 @@ so this really moves item trees." (let ((pos (point)) (col (current-column)) (actual-item (org-beginning-of-item)) - (prev-item (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list))))) + (prev-item (org-get-previous-item (point) (org-list-top-point)))) (if (not prev-item) (progn (goto-char pos) @@ -917,16 +898,10 @@ This function modifies STRUCT." (defun org-list-struct-fix-struct (struct origins) "Return STRUCT with correct bullets and indentation. Only elements of STRUCT that have changed are returned." - (let ((before (copy-alist struct)) - (set-diff (lambda (setA setB result) - (cond - ((null setA) result) - ((equal (car setA) (car setB)) - (funcall set-diff (cdr setA) (cdr setB) result)) - (t (funcall set-diff (cdr setA) (cdr setB) (cons (car setA) result))))))) + (let ((old (copy-alist struct))) (org-list-struct-fix-bul struct origins) (org-list-struct-fix-ind struct origins) - (nreverse (funcall set-diff struct before nil)))) + (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) (defun org-list-struct-outdent (start end origins) "Outdent items in ORIGINS between BEGIN and END. @@ -1168,13 +1143,13 @@ children. Return t if successful." (t (back-to-indentation) (indent-to-column (car org-tab-ind-state)) (end-of-line) - (org-fix-bullet-type (nth 1 org-tab-ind-state)) + (org-fix-bullet-type (cdr org-tab-ind-state)) ;; Break cycle (setq this-command 'identity))) ;; If a cycle is starting, remember indentation and bullet, ;; then try to indent. If it fails, try to outdent. (setq org-tab-ind-state - (list (org-get-indentation) (org-get-bullet))) + (cons (org-get-indentation) (org-get-bullet))) (cond ((ignore-errors (org-indent-item 1))) ((ignore-errors (org-indent-item -1))) @@ -1536,7 +1511,7 @@ will return the number of items in the current list. Sublists of the list are skipped. Cursor is always at the beginning of the item." (save-excursion - (let ((end (copy-marker (save-excursion (org-end-of-item-list)))) + (let ((end (copy-marker (org-list-bottom-point))) (next-p (make-marker)) (move-down-action (lambda (pos value &rest args) From 8c89086e73780ca54e6ad2bd8d8741619e825050 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 13 Aug 2010 10:52:27 +0200 Subject: [PATCH 214/348] Refactoring of search functions. --- lisp/org-list.el | 40 ++++++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a2fe2a7a1..d9614b8aa 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -295,30 +295,34 @@ the end of the nearest terminator from max." ;; we want to be on the first line of the list ender (match-beginning 0))))) -(defun org-list-search-unenclosed-generic (search-fun regexp bound noerror count) - "Search for REGEXP with SEARCH-FUN but don't stop inside blocks or at protected places." - (let ((origin (point))) - (cond - ;; nothing found: return nil - ((not (funcall search-fun regexp bound noerror count)) nil) - ((or (save-match-data - (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)" - '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))) - (get-text-property (match-beginning 0) 'org-protected)) - ;; match is enclosed or protected: start again, searching one - ;; occurrence away. - (goto-char origin) - (org-list-search-unenclosed-generic search-fun regexp bound noerror (1+ count))) - ;; else return point. - (t (point))))) +(defun org-list-search-unenclosed-generic (search skip len re bound noerr) + "Search for RE with SEARCH outside blocks and protected places." + (let ((in-block-p + (lambda () + (let ((case-fold-search t)) + (when (save-excursion + (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" bound t) + (= (length (match-string 1)) len))) + ;; We're in a block: get out of it and resume searching + (goto-char (funcall skip 0))))))) + (catch 'exit + (let ((origin (point))) + (while t + (unless (funcall search re bound noerr) + (throw 'exit (and (goto-char (if (booleanp noerr) origin bound)) nil))) + (unless (or (get-text-property (match-beginning 0) 'org-protected) + (save-match-data (funcall in-block-p))) + (throw 'exit (point)))))))) (defun org-search-backward-unenclosed (regexp &optional bound noerror) "Like `re-search-backward' but don't stop inside blocks or at protected places." - (org-list-search-unenclosed-generic #'re-search-backward regexp bound noerror 1)) + (org-list-search-unenclosed-generic + #'re-search-backward #'match-beginning 5 regexp (or bound (point-min)) noerror)) (defun org-search-forward-unenclosed (regexp &optional bound noerror) "Like `re-search-forward' but don't stop inside blocks or at protected places." - (org-list-search-unenclosed-generic #'re-search-forward regexp bound noerror 1)) + (org-list-search-unenclosed-generic + #'re-search-forward #'match-end 3 regexp (or bound (point-max)) noerror)) (defun org-list-at-regexp-after-bullet-p (regexp) "Is point at a list item with REGEXP after bullet?" From 8385393fe68d12a30ebeb601a82203e7c69278ae Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 15 Aug 2010 00:21:15 +0200 Subject: [PATCH 215/348] Optimize writing of structure to buffer. * org-list.el (org-list-struct-apply-struct): No longer shift item's body twice: one after replacing bullet and one after changing indentation. --- lisp/org-list.el | 50 ++++++++++++++++++------------------------------ 1 file changed, 19 insertions(+), 31 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index d9614b8aa..94b4272dc 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -996,9 +996,25 @@ Initial position is restored after the changes." (ancestor (caar struct)) (modify (lambda (item) - (goto-char (car item)) - (org-list-indent-item (nth 1 item)) - (org-list-replace-bullet (org-list-bullet-string (nth 2 item))))) + (goto-char (car item)) + (let* ((new-ind (nth 1 item)) + (new-bul (org-list-bullet-string (nth 2 item))) + (old-ind (org-get-indentation)) + (old-bul (progn + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (match-string 1))) + (old-body-ind (+ (length old-bul) old-ind)) + (new-body-ind (+ (length new-bul) new-ind))) + ;; Replace bullet + (unless (equal new-bul old-bul) + (save-excursion (replace-match new-bul nil nil nil 1))) + ;; Indent item to appropriate column + (unless (= new-ind old-ind) + (delete-region (point-at-bol) (match-beginning 1)) + (indent-to new-ind)) + ;; Shift item's body + (unless (= old-body-ind new-body-ind) + (org-shift-item-indentation (- new-body-ind old-body-ind)))))) ;; Remove ancestor if it is left. (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) struct))) ;; Apply changes from bottom to top @@ -1033,18 +1049,6 @@ Sub-items are not moved." (indent-line-to (+ i delta))))) (beginning-of-line 0))))) -(defun org-list-indent-item (ind) - "Change indentation of item at point to IND. -It does not move sub-lists." - (save-excursion - (beginning-of-line) - (let ((old-ind (org-get-indentation))) - (unless (= ind old-ind) - (org-shift-item-indentation (- ind old-ind)) - (skip-chars-forward " \t") - (delete-region (point-at-bol) (point)) - (org-indent-to-column ind))))) - (defun org-outdent-item (arg) "Outdent a local list item, but not its children." (interactive "p") @@ -1190,22 +1194,6 @@ It determines the number of whitespaces to append by looking at (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet) bullet)) -(defun org-list-replace-bullet (new-bullet) - "Replace current item's bullet with NEW-BULLET. -Item body is re-indented, but sub-lists are not moved. Assume -point is at item." - (save-excursion - (beginning-of-line) - (let ((old (progn - (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") - (match-string 1)))) - (unless (equal new-bullet old) - (replace-match new-bullet nil nil nil 1) - ;; When bullet lengths are differents, move the whole - ;; sublist accordingly - (org-shift-item-indentation - (- (length new-bullet) (length old))))))) - (defun org-fix-bullet-type (&optional force-bullet) "Make sure all items in this list have the same bullet as the first item. Also, fix the indentation." From 1230cf9f097d81d38a6838835bb31495576de030 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 15 Aug 2010 11:45:08 +0200 Subject: [PATCH 216/348] Fix bug when inserting an item after bottom point of list * org-list.el (org-list-bottom-point): Take into consideration that bound of search can be before true ending of the list. --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 94b4272dc..2fb10b6e7 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -563,7 +563,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;; The list ending is either first point matching ;; `org-list-end-re', point at first white-line before next ;; heading, or eob. - (or (org-list-terminator-between pos bound t) bound))))) + (or (org-list-terminator-between (min pos bound) bound t) bound))))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. From 7ef456426e75c333fcabebb40359fde3e47bedee Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 15 Aug 2010 12:39:01 +0200 Subject: [PATCH 217/348] Fix DocBook and HTML sensitivity about item's body indentation * org-docbook.el (org-export-as-docbook): Removed check for indentation on lines that do not start with a list bullet. * org-html.el (org-export-as-html): Same thing. --- lisp/org-docbook.el | 29 ++++++++++++----------------- lisp/org-html.el | 21 ++++++++------------- 2 files changed, 20 insertions(+), 30 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index d90d949c8..bca412e6e 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1031,22 +1031,6 @@ publishing directory." (setq item-type "d" item-tag (match-string 1 line) line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; Empty line. Pretend indentation is large. - (setq ind (1+ (or (car local-list-indent) 1)))) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (let ((listtype (car local-list-type))) - (org-export-docbook-close-li listtype) - (insert (cond - ((equal listtype "o") "</orderedlist>\n") - ((equal listtype "u") "</itemizedlist>\n") - ((equal listtype "d") "</variablelist>\n")))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) (cond ((and starter (or (not in-local-list) @@ -1073,8 +1057,19 @@ publishing directory." (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) - (starter ;; Continue current list + (starter + ;; terminate any previous sublist + (while (< ind (car local-list-indent)) + (let ((listtype (car local-list-type))) + (org-export-docbook-close-li listtype) + (insert (cond + ((equal listtype "o") "</orderedlist>\n") + ((equal listtype "u") "</itemizedlist>\n") + ((equal listtype "d") "</variablelist>\n")))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + ;; insert new item (let ((listtype (car local-list-type))) (org-export-docbook-close-li listtype) (insert (cond diff --git a/lisp/org-html.el b/lisp/org-html.el index 1a5c5eb9b..ac0a48809 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1555,18 +1555,6 @@ lang=\"%s\" xml:lang=\"%s\"> (setq item-type "d" item-tag (match-string 1 line) line (substring line (match-end 0)))) - (when (and (not (equal item-type "d")) - (not (string-match "[^ \t]" line))) - ;; empty line. Pretend indentation is large. - (setq ind (1+ (or (car local-list-indent) 1)))) - (while (and in-local-list - (or (and (= ind (car local-list-indent)) - (not starter)) - (< ind (car local-list-indent)))) - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type) (pop local-list-indent) - (setq in-local-list local-list-indent)) (cond ((and starter (or (not in-local-list) @@ -1583,8 +1571,15 @@ lang=\"%s\" xml:lang=\"%s\"> (push item-type local-list-type) (push ind local-list-indent) (setq in-local-list t)) + ;; Continue list (starter - ;; continue current list + ;; terminate any previous sublist + (while (< ind (car local-list-indent)) + (org-close-li (car local-list-type)) + (insert (format "</%sl>\n" (car local-list-type))) + (pop local-list-type) (pop local-list-indent) + (setq in-local-list local-list-indent)) + ;; insert new item (org-close-li (car local-list-type)) (insert (cond ((equal (car local-list-type) "d") From 05aeeae9ed2a845e89c1e62c3bbab8cd6e35fe1f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 15 Aug 2010 16:37:39 +0200 Subject: [PATCH 218/348] First line after a list should not be indented according to list * org.el (org-indent-line-function): Indent first non blank line after a list according to current heading level. --- lisp/org.el | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 80b0fbf33..1bd446796 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18585,10 +18585,16 @@ which make use of the date at the cursor." ((looking-at "\\([ \t]*\\):END:") (goto-char (match-end 1)) (setq column (current-column))) - ;; There was a list that since ended: indent like top point. + ;; There was a list that since ended: indent relatively to + ;; current heading. ((org-in-item-p) - (goto-char (org-list-top-point)) - (setq column (org-get-indentation))) + (outline-previous-heading) + (if (and org-adapt-indentation + (looking-at "\\*+[ \t]+")) + (progn + (goto-char (match-end 0)) + (setq column (current-column))) + (setq column 0))) ;; Else, nothing noticeable found: get indentation and go on. (t (setq column (org-get-indentation)))))) (goto-char pos) From dea5050dbc8444745db69a67ca0d317983e44da0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 15 Aug 2010 16:49:47 +0200 Subject: [PATCH 219/348] Ensure shifting top-level item can catch column 0 * org-list.el (org-indent-item-tree): shifting step of top-level item depends on `org-level-increment'. --- lisp/org-list.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2fb10b6e7..0d024fccf 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1103,8 +1103,9 @@ children. Return t if successful." (cond ;; Special case: moving top-item with indent rule ((and (= top beg) (cdr (assq 'indent org-list-automatic-rules))) - (let ((offset (if (< arg 0) -2 2)) - (top-ind (nth 1 beg-item))) + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) (if (< (+ top-ind offset) 0) (error "Cannot outdent beyond margin") ;; Change bullet if necessary From dae1ec63a9da88ffd52f45d419e69065234c1cfb Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 17 Aug 2010 21:29:49 +0200 Subject: [PATCH 220/348] org-fix-bullet-type is now org-list-repair. Created aliases for compatibility. --- lisp/org-capture.el | 2 +- lisp/org-list.el | 46 ++++++++++++++++++--------------------------- lisp/org.el | 4 ++-- 3 files changed, 21 insertions(+), 31 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 2e2a34fa1..3bc30eb4c 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -973,7 +973,7 @@ Point will remain at the first line after the inserted text." (insert template) (org-capture-empty-lines-after) (goto-char beg) - (org-maybe-renumber-ordered-list) + (org-list-repair) (org-end-of-item) (setq end (point))) (t (insert template))) diff --git a/lisp/org-list.el b/lisp/org-list.el index 0d024fccf..ab8dcbf46 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -439,7 +439,7 @@ function ends." (before-p (funcall insert-fun nil) ;; Not taking advantage of renumbering while moving ;; down. Need to call it directly. - (org-maybe-renumber-ordered-list) t) + (org-list-repair) t) ;; Can't split item: insert bullet at the end of item. ((not (org-get-alist-option org-M-RET-may-split-line 'item)) (funcall insert-fun nil) t) @@ -685,7 +685,7 @@ so this really moves item trees." (goto-char pos) (error "Cannot move this item further down")) (org-list-exchange-items actual-item next-item) - (org-maybe-renumber-ordered-list) + (org-list-repair) (org-next-item) (move-to-column col)))) @@ -703,7 +703,7 @@ so this really moves item trees." (goto-char pos) (error "Cannot move this item further up")) (org-list-exchange-items prev-item actual-item) - (org-maybe-renumber-ordered-list) + (org-list-repair) (move-to-column col)))) (defun org-insert-item (&optional checkbox) @@ -1152,7 +1152,7 @@ children. Return t if successful." (t (back-to-indentation) (indent-to-column (car org-tab-ind-state)) (end-of-line) - (org-fix-bullet-type (cdr org-tab-ind-state)) + (org-list-repair (cdr org-tab-ind-state)) ;; Break cycle (setq this-command 'identity))) ;; If a cycle is starting, remember indentation and bullet, @@ -1195,9 +1195,14 @@ It determines the number of whitespaces to append by looking at (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet) bullet)) -(defun org-fix-bullet-type (&optional force-bullet) - "Make sure all items in this list have the same bullet as the first item. -Also, fix the indentation." +(defun org-list-repair (&optional force-bullet) + "Make sure all items are correctly indented, with the right bullet. +This function scans the list at point, along with any sublist. + +If the string FORCE-BULLET is provided, ensure all items in list +share this bullet, or a logical successor in an ordered list. + +Item's body is not indented, only shifted with the bullet." (interactive) (unless (org-at-item-p) (error "This is not a list")) (let* ((struct (org-list-struct (point-at-bol) (point-at-eol))) @@ -1210,25 +1215,10 @@ Also, fix the indentation." (setq fixed-struct (org-list-struct-fix-struct struct origins))) (org-list-struct-apply-struct fixed-struct))) -(defun org-renumber-ordered-list () - "Renumber an ordered plain list. -Cursor needs to be in the first line of an item." - (interactive) - (unless (and (org-at-item-p) - (match-beginning 3)) - (error "This is not an ordered list")) - (let* ((struct (org-list-struct (point-at-bol) (point-at-eol))) - (origins (org-list-struct-origins struct))) - (org-list-struct-apply-struct (org-list-struct-fix-struct struct origins)))) - -(defun org-maybe-renumber-ordered-list () - "Renumber the ordered list at point if setup allows it. -This tests the if 'renumber rule is set in -`org-list-automatic-rules' before doing the renumbering. -Do not throw error on failure." - (interactive) - (when (cdr (assq 'renumber org-list-automatic-rules)) - (ignore-errors (org-renumber-ordered-list)))) +;; For backward compatibility +(defalias 'org-fix-bullet-type 'org-list-repair) +(defalias 'org-renumber-ordered-list 'org-list-repair) +(defalias 'org-maybe-renumber-ordered-list 'org-list-repair) (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. @@ -1267,7 +1257,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is ((numberp which) (funcall get-value which)) ((eq 'previous which) (funcall get-value (1- item-index))) (t (funcall get-value (1+ item-index)))))) - (org-fix-bullet-type new)))) + (org-list-repair new)))) ;;; Checkboxes @@ -1601,7 +1591,7 @@ optional argument WITH-CASE, the sorting considers case as well." (error "Invalid key function `%s'" getkey-func))) (t (error "Invalid sorting type `%c'" sorting-type))))))) (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func) - (org-maybe-renumber-ordered-list) + (org-list-repair) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) diff --git a/lisp/org.el b/lisp/org.el index 1bd446796..5c745b6d1 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17207,11 +17207,11 @@ This command does many different things, depending on context: (org-footnote-at-definition-p)) (call-interactively 'org-footnote-action)) ((org-at-item-checkbox-p) - (call-interactively 'org-fix-bullet-type) + (call-interactively 'org-list-repair) (call-interactively 'org-toggle-checkbox) (org-list-send-list 'maybe)) ((org-at-item-p) - (call-interactively 'org-fix-bullet-type) + (call-interactively 'org-list-repair) (when arg (call-interactively 'org-toggle-checkbox)) (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) From d2b3923b6a72a893b24bb5e83eb4f573b947683d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 17 Aug 2010 22:21:24 +0200 Subject: [PATCH 221/348] Keep byte-compiler happy. --- lisp/org-list.el | 84 +++++++++++++++++++++++------------------------- 1 file changed, 41 insertions(+), 43 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index ab8dcbf46..84d7e139b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -46,10 +46,10 @@ (declare-function outline-next-heading "outline" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-back-over-empty-lines "org" ()) -(declare-function org-skip-whitespace "org" ()) (declare-function org-trim "org" (s)) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-timer-item "org-timer" (&optional arg)) +(declare-function org-timer-hms-to-secs "org-timer" (hms)) (declare-function org-combine-plists "org" (&rest plists)) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) @@ -815,6 +815,7 @@ change is an outdent." (defun org-list-struct-origins (struct) "Return an alist where key is item's position and value parent's." (let* ((struct-rev (reverse struct)) + (acc (list (cons (nth 1 (car struct)) 0))) (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev))))) (get-origins (lambda (item) @@ -832,8 +833,7 @@ change is an outdent." (setq acc (cons (cons ind origin) acc)) (cons item-pos origin))) ;; Current list going on - (t (cons item-pos (cdar acc))))))) - (acc (list (cons (nth 1 (car struct)) 0)))) + (t (cons item-pos (cdar acc)))))))) (cons '(0 . 0) (mapcar get-origins (cdr struct))))) (defun org-list-struct-get-parent (item struct origins) @@ -850,7 +850,8 @@ change is an outdent." (defun org-list-struct-fix-bul (struct origins) "Verify and correct bullets for every association in STRUCT. This function modifies STRUCT." - (let* ((init-bul (lambda (item) + (let* (acc + (init-bul (lambda (item) (let ((counter (nth 3 item)) (bullet (org-list-bullet-string (nth 2 item)))) (cond @@ -879,8 +880,7 @@ This function modifies STRUCT." ;; A new list is starting (let ((new-bul (funcall init-bul item))) (funcall set-bul item new-bul) - (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc))))))) - acc) + (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))) (mapc fix-bul (cdr struct)))) (defun org-list-struct-fix-ind (struct origins) @@ -910,28 +910,28 @@ Only elements of STRUCT that have changed are returned." (defun org-list-struct-outdent (start end origins) "Outdent items in ORIGINS between BEGIN and END. BEGIN is included and END excluded." - (let ((out (lambda (cell) - (let* ((item (car cell)) - (parent (cdr cell))) - (cond - ;; Item not yet in zone: keep association - ((< item start) cell) - ;; Item out of zone: follow associations in acc - ((>= item end) - (let ((convert (assq parent acc))) - (if convert (cons item (cdr convert)) cell))) - ;; Item has no parent: error - ((<= parent 0) - (error "Cannot outdent top-level items")) - ;; Parent is outdented: keep association - ((>= parent start) - (setq acc (cons (cons parent item) acc)) cell) - (t - ;; Parent isn't outdented: reparent to grand-parent - (let ((grand-parent (cdr (assq parent origins)))) - (setq acc (cons (cons parent item) acc)) - (cons item grand-parent))))))) - acc) + (let* (acc + (out (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association + ((< item start) cell) + ;; Item out of zone: follow associations in acc + ((>= item end) + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + ;; Item has no parent: error + ((<= parent 0) + (error "Cannot outdent top-level items")) + ;; Parent is outdented: keep association + ((>= parent start) + (setq acc (cons (cons parent item) acc)) cell) + (t + ;; Parent isn't outdented: reparent to grand-parent + (let ((grand-parent (cdr (assq parent origins)))) + (setq acc (cons (cons parent item) acc)) + (cons item grand-parent)))))))) (mapcar out origins))) (defun org-list-struct-indent (start end origins struct) @@ -940,7 +940,8 @@ BEGIN is included and END excluded. STRUCT may be modified if `org-list-demote-modify-bullet' is concerning bullets between START and END." - (let* ((orig-rev (reverse origins)) + (let* (acc + (orig-rev (reverse origins)) (get-prev-item (lambda (cell parent) (car (rassq parent (cdr (memq cell orig-rev)))))) @@ -985,8 +986,7 @@ concerning bullets between START and END." (funcall set-assoc (cons item prev))) ;; Previous item indented: reparent like it (t - (funcall set-assoc (cons item (cdr (assq prev acc)))))))))))) - acc) + (funcall set-assoc (cons item (cdr (assq prev acc))))))))))))) (mapcar ind origins))) (defun org-list-struct-apply-struct (struct) @@ -1493,18 +1493,16 @@ will return the number of items in the current list. Sublists of the list are skipped. Cursor is always at the beginning of the item." - (save-excursion - (let ((end (copy-marker (org-list-bottom-point))) - (next-p (make-marker)) - (move-down-action - (lambda (pos value &rest args) - (goto-char pos) - (set-marker next-p (org-get-next-item pos end)) - (let ((return-value (apply function value args))) - (if (marker-position next-p) - (apply move-down-action next-p return-value args) - return-value))))) - (apply move-down-action (org-beginning-of-item-list) init-value args)))) + (let* ((pos (copy-marker (point))) + (end (copy-marker (org-list-bottom-point))) + (next-p (copy-marker (save-excursion (org-beginning-of-item-list)))) + (value init-value)) + (while (< next-p end) + (goto-char next-p) + (set-marker next-p (or (org-get-next-item (point) end) end)) + (setq value (apply function value args))) + (goto-char pos) + value)) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) "Sort plain list items. From 8b66f2692044fbcd859708c7a3ff8703d13cac84 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 19 Aug 2010 16:40:21 +0200 Subject: [PATCH 222/348] Modified indentation of long lines of code. --- lisp/org-list.el | 112 +++++++++++++++++++++++++++++++++-------------- 1 file changed, 79 insertions(+), 33 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 84d7e139b..1419a18fe 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -399,7 +399,8 @@ function ends." ((eq insert-blank-p t) 1) ;; plain-list-item is 'auto. Count blank lines separating ;; neighbours items in list. - (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (t (let ((next-p (org-get-next-item (point) + (org-list-bottom-point)))) (cond ;; Is there a next item? (next-p (goto-char next-p) @@ -786,19 +787,25 @@ change is an outdent." pre-list post-list) (goto-char begin) ;; Find beginning of most outdented list (min list) - (while (and (org-search-backward-unenclosed org-item-beginning-re top t) + (while (and (org-search-backward-unenclosed + org-item-beginning-re top t) (>= (org-get-indentation) ind-min)) - (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list))) + (setq pre-list (cons (org-list-struct-assoc-at-point) + pre-list))) ;; Now get the parent. If none, add a virtual ancestor (if (< (org-get-indentation) ind-min) - (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list)) - (setq pre-list (cons (list 0 (org-get-indentation) "" nil) pre-list))) + (setq pre-list (cons (org-list-struct-assoc-at-point) + pre-list)) + (setq pre-list (cons (list 0 (org-get-indentation) "" nil) + pre-list))) ;; Find end of min list (goto-char end) (end-of-line) - (while (and (org-search-forward-unenclosed org-item-beginning-re bottom t) + (while (and (org-search-forward-unenclosed + org-item-beginning-re bottom t) (>= (org-get-indentation) ind-min)) - (setq post-list (cons (org-list-struct-assoc-at-point) post-list))) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list))) (append pre-list struct (reverse post-list)))))) ;; Here we start: first get the core zone... (goto-char end) @@ -816,7 +823,8 @@ change is an outdent." "Return an alist where key is item's position and value parent's." (let* ((struct-rev (reverse struct)) (acc (list (cons (nth 1 (car struct)) 0))) - (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev))))) + (prev-item (lambda (item) + (car (nth 1 (member (assq item struct) struct-rev))))) (get-origins (lambda (item) (let* ((item-pos (car item)) @@ -880,7 +888,9 @@ This function modifies STRUCT." ;; A new list is starting (let ((new-bul (funcall init-bul item))) (funcall set-bul item new-bul) - (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))) + (setq acc (cons (cons parent + (org-list-inc-bullet-maybe new-bul)) + acc)))))))) (mapc fix-bul (cdr struct)))) (defun org-list-struct-fix-ind (struct origins) @@ -894,7 +904,8 @@ This function modifies STRUCT." (let* ((parent (org-list-struct-get-parent item headless origins))) (if parent ;; Indent like parent + length of parent's bullet - (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) (cddr item))) + (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) + (cddr item))) ;; If no parent, indent like top-point (setcdr item (cons top-ind (cddr item)))))))) (mapc new-ind headless))) @@ -957,7 +968,9 @@ concerning bullets between START and END." ;; new bullet is stored without space to ensure item ;; will be modified (setcdr full-item - (list (nth 1 full-item) new-bul-p (nth 3 full-item))))))) + (list (nth 1 full-item) + new-bul-p + (nth 3 full-item))))))) (ind (lambda (cell) (let* ((item (car cell)) @@ -986,7 +999,8 @@ concerning bullets between START and END." (funcall set-assoc (cons item prev))) ;; Previous item indented: reparent like it (t - (funcall set-assoc (cons item (cdr (assq prev acc))))))))))))) + (funcall set-assoc (cons item + (cdr (assq prev acc))))))))))))) (mapcar ind origins))) (defun org-list-struct-apply-struct (struct) @@ -1016,7 +1030,9 @@ Initial position is restored after the changes." (unless (= old-body-ind new-body-ind) (org-shift-item-indentation (- new-body-ind old-body-ind)))))) ;; Remove ancestor if it is left. - (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) struct))) + (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) + (cdr struct) + struct))) ;; Apply changes from bottom to top (mapc modify (nreverse struct-to-apply)) (goto-char pos))) @@ -1084,10 +1100,13 @@ children. Return t if successful." (progn (set-marker org-last-indent-begin-marker (region-beginning)) (set-marker org-last-indent-end-marker (region-end))) - (set-marker org-last-indent-begin-marker (save-excursion (org-beginning-of-item))) + (set-marker org-last-indent-begin-marker + (save-excursion (org-beginning-of-item))) (set-marker org-last-indent-end-marker (save-excursion - (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item)))))) + (if no-subtree + (org-end-of-item-or-at-child) + (org-end-of-item)))))) ;; Get everything ready (let* ((beg (marker-position org-last-indent-begin-marker)) (end (marker-position org-last-indent-end-marker)) @@ -1109,10 +1128,13 @@ children. Return t if successful." (if (< (+ top-ind offset) 0) (error "Cannot outdent beyond margin") ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) (org-list-bullet-string "-")))) + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) ;; Shift ancestor - (let ((anc (car struct))) (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) (org-list-struct-fix-struct struct origins) (org-list-struct-apply-struct struct)))) ;; Forbidden move @@ -1135,7 +1157,9 @@ children. Return t if successful." (defvar org-tab-ind-state) (defun org-cycle-item-indentation () (let ((org-adapt-indentation nil)) - (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p)) + (when (and (or (org-at-item-description-p) + (org-at-item-checkbox-p) + (org-at-item-p)) (>= (match-end 0) (save-excursion (org-end-of-item-or-at-child) (skip-chars-backward " \r\t\n") @@ -1192,7 +1216,8 @@ It determines the number of whitespaces to append by looking at "Increment numbered bullets." (if (string-match "[0-9]+" bullet) (replace-match - (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet) + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) + nil nil bullet) bullet)) (defun org-list-repair (&optional force-bullet) @@ -1210,8 +1235,11 @@ Item's body is not indented, only shifted with the bullet." fixed-struct) (if force-bullet (let ((begin (nth 1 struct))) - (setcdr begin (list (nth 1 begin) (org-list-bullet-string force-bullet) (nth 3 begin))) - (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins)))) + (setcdr begin (list (nth 1 begin) + (org-list-bullet-string force-bullet) + (nth 3 begin))) + (setq fixed-struct + (cons begin (org-list-struct-fix-struct struct origins)))) (setq fixed-struct (org-list-struct-fix-struct struct origins))) (org-list-struct-apply-struct fixed-struct))) @@ -1286,7 +1314,8 @@ in subtree." ;; In this case, reference line is the first item in subtree (let ((limit (save-excursion (outline-next-heading) (point)))) (save-excursion - (org-search-forward-unenclosed org-item-beginning-re limit 'move) + (org-search-forward-unenclosed + org-item-beginning-re limit 'move) (list (point) limit nil)))) ((org-at-item-p) (list (point-at-bol) (point-at-eol) t)) @@ -1294,7 +1323,9 @@ in subtree." ;; marker is needed because deleting checkboxes will change END (end (copy-marker (nth 1 bounds))) (single-p (nth 2 bounds)) - (ref-presence (save-excursion (goto-char (car bounds)) (org-at-item-checkbox-p))) + (ref-presence (save-excursion + (goto-char (car bounds)) + (org-at-item-checkbox-p))) (ref-status (equal (match-string 1) "[X]")) (act-on-item (lambda (ref-pres ref-stat) @@ -1435,14 +1466,16 @@ the whole buffer." ;; with proper limit. (goto-char (or (org-get-next-item (point) lim) lim)) (end-of-line) - (when (org-search-forward-unenclosed org-item-beginning-re lim t) + (when (org-search-forward-unenclosed + org-item-beginning-re lim t) (beginning-of-line))) (setq next-ind (org-get-indentation))))) (goto-char continue-from) ;; update cookie (when end-cookie (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off)))) + (format "[%d%%]" (/ (* 100 c-on) + (max 1 (+ c-on c-off)))) (format "[%d/%d]" c-on (+ c-on c-off)))) (goto-char beg-cookie) (insert new) @@ -1588,7 +1621,12 @@ optional argument WITH-CASE, the sorting considers case as well." value)) (error "Invalid key function `%s'" getkey-func))) (t (error "Invalid sorting type `%c'" sorting-type))))))) - (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func) + (sort-subr (/= dcst sorting-type) + begin-record + end-record + value-to-sort + nil + sort-func) (org-list-repair) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) @@ -1610,9 +1648,12 @@ sublevels as a list of strings." (t 'unordered)))) (let* ((indent1 (org-get-indentation)) (nextitem (or (org-get-next-item (point) end) end)) - (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child)))) + (item (org-trim (buffer-substring (point) + (org-end-of-item-or-at-child)))) (nextindent (if (= (point) end) 0 (org-get-indentation))) - (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" item) + (item (if (string-match + "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" + item) (replace-match (if (equal (match-string 1 item) " ") "CBOFF" "CBON") @@ -1641,7 +1682,8 @@ sublevels as a list of strings." (save-excursion (if (ignore-errors (org-back-to-heading)) - (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t) + (progn (org-search-forward-unenclosed + org-complex-heading-regexp nil t) (setq nstars (length (match-string 1)))) (setq nstars 0))) (org-list-make-subtrees list (1+ nstars))))) @@ -1690,7 +1732,8 @@ this list." (transform (intern (match-string 2))) (bottom-point (save-excursion - (re-search-forward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) + (re-search-forward + "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) (match-beginning 0))) (top-point (progn @@ -1708,7 +1751,9 @@ this list." (save-excursion (goto-char (point-min)) (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t) + (concat "BEGIN RECEIVE ORGLST +" + name + "\\([ \t]\\|$\\)") nil t) (error "Don't know where to insert translated list")) (goto-char (match-beginning 0)) (beginning-of-line 2) @@ -1782,7 +1827,8 @@ Valid parameters PARAMS are (setq term (org-trim (format (concat dtstart "%s" dtend) (match-string 1 sublist)))) (setq sublist (concat ddstart - (org-trim (substring sublist (match-end 0))) + (org-trim (substring sublist + (match-end 0))) ddend))) (if (string-match "\\[CBON\\]" sublist) (setq sublist (replace-match cbon t t sublist))) From 2cca51027640cb800a47d039981faff9658b2a79 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 19 Aug 2010 17:59:55 +0200 Subject: [PATCH 223/348] Fix structure for malformed lists. --- lisp/org-list.el | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 1419a18fe..334f7f919 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -802,10 +802,19 @@ change is an outdent." (goto-char end) (end-of-line) (while (and (org-search-forward-unenclosed - org-item-beginning-re bottom t) + org-item-beginning-re bottom 'move) (>= (org-get-indentation) ind-min)) (setq post-list (cons (org-list-struct-assoc-at-point) post-list))) + ;; we need to check if list is malformed and some + ;; items are less indented that top-item + (when (and (= (caar pre-list) 0) (org-at-item-p)) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list)) + (while (org-search-forward-unenclosed + org-item-beginning-re bottom t) + (setq post-list (cons (org-list-struct-assoc-at-point) + post-list)))) (append pre-list struct (reverse post-list)))))) ;; Here we start: first get the core zone... (goto-char end) @@ -833,8 +842,12 @@ change is an outdent." (cond ;; List closing. ((> prev-ind ind) - (setq acc (member (assq ind acc) acc)) - (cons item-pos (cdar acc))) + (let ((current-origin (or (member (assq ind acc) acc) + ;; needed if top-point is + ;; not the most outdented + (last acc)))) + (setq acc current-origin) + (cons item-pos (cdar acc)))) ;; New list ((< prev-ind ind) (let ((origin (funcall prev-item item-pos))) From b5eb7047f36f65ff79b1b01cc893dacc4fa12d63 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 19 Aug 2010 16:09:45 +0200 Subject: [PATCH 224/348] Now both indentation and regexps can end lists * org-list.el (org-list-ending-method): New customizable variable to tell Org Mode how lists end. See docstring. --- lisp/org-exp.el | 3 +- lisp/org-list.el | 306 +++++++++++++++++++++++++++++++++++------------ 2 files changed, 234 insertions(+), 75 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 2151b7a7e..c16bec8b0 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1638,7 +1638,8 @@ These special cookies will later be interpreted by the backend. (goto-char (point-min)) (while (org-search-forward-unenclosed org-item-beginning-re nil t) (goto-char (org-list-bottom-point)) - (when (looking-at (org-list-end-re)) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) (replace-match "\n")) (insert end-list-marker))))) ;; We need to divide backends into 3 categories. diff --git a/lisp/org-list.el b/lisp/org-list.el index 334f7f919..394a96831 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -149,9 +149,32 @@ spaces instead of one after the bullet in each item of the list." (const :tag "never" nil) (regexp))) +(defcustom org-list-ending-method 'regexp + "Determine where plain lists should end. + +Valid values are symbols 'regexp, 'indent or 'both. + +When set to 'regexp, Org will look into two variables, +`org-empty-line-terminates-plain-lists' and the more general +`org-list-end-regexp', to know what will end lists. This is the +default value. + +When set to 'indent, indentation of the last non-blank line will +determine if point is in a list. If that line is less indented +than the previous item in the section, if any, list has ended. + +When set to 'both, each of the preceding methods must confirm +that point is in a list." + :group 'org-plain-lists + :type '(choice + (const :tag "With a well defined ending (recommended)" regexp) + (const :tag "With indentation of the current line" indent) + (const :tag "With both methods" both))) + (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. -Otherwise, look for `org-list-end-regexp'." +This variable only makes sense if `org-list-ending-method' is set +to 'regexp or 'both." :group 'org-plain-lists :type 'boolean) @@ -295,34 +318,164 @@ the end of the nearest terminator from max." ;; we want to be on the first line of the list ender (match-beginning 0))))) -(defun org-list-search-unenclosed-generic (search skip len re bound noerr) +(defun org-list-maybe-skip-block (search limit) + "Return non-nil value if point is in a block, skipping it on the way. + +It looks for the boundary of the block in SEARCH direction." + (save-match-data + (let ((case-fold-search t) + (boundary (if (eq search 're-search-forward) 3 5))) + (when (save-excursion + (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t) + (= (length (match-string 1)) boundary))) + ;; We're in a block: get out of it + (goto-char (match-beginning 0)))))) + +(defun org-list-search-unenclosed-generic (search re bound noerr) "Search for RE with SEARCH outside blocks and protected places." - (let ((in-block-p - (lambda () - (let ((case-fold-search t)) - (when (save-excursion - (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" bound t) - (= (length (match-string 1)) len))) - ;; We're in a block: get out of it and resume searching - (goto-char (funcall skip 0))))))) - (catch 'exit - (let ((origin (point))) - (while t - (unless (funcall search re bound noerr) - (throw 'exit (and (goto-char (if (booleanp noerr) origin bound)) nil))) - (unless (or (get-text-property (match-beginning 0) 'org-protected) - (save-match-data (funcall in-block-p))) - (throw 'exit (point)))))))) + (catch 'exit + (let ((origin (point))) + (while t + (unless (funcall search re bound noerr) + (throw 'exit (and (goto-char (if (booleanp noerr) origin bound)) + nil))) + (unless (or (get-text-property (match-beginning 0) 'org-protected) + (org-list-maybe-skip-block search bound)) + (throw 'exit (point))))))) (defun org-search-backward-unenclosed (regexp &optional bound noerror) - "Like `re-search-backward' but don't stop inside blocks or at protected places." + "Like `re-search-backward' but don't stop inside blocks or protected places." (org-list-search-unenclosed-generic - #'re-search-backward #'match-beginning 5 regexp (or bound (point-min)) noerror)) + #'re-search-backward regexp (or bound (point-min)) noerror)) (defun org-search-forward-unenclosed (regexp &optional bound noerror) - "Like `re-search-forward' but don't stop inside blocks or at protected places." + "Like `re-search-forward' but don't stop inside blocks or protected places." (org-list-search-unenclosed-generic - #'re-search-forward #'match-end 3 regexp (or bound (point-max)) noerror)) + #'re-search-forward regexp (or bound (point-max)) noerror)) + +(defun org-list-in-item-p-with-indent (limit) + "Is the cursor inside a plain list? + +Plain lists are considered ending when a non-blank line is less +indented than the previous item within LIMIT. + +Return the position of the previous item, if applicable." + (save-excursion + (beginning-of-line) + ;; do not start searching at a blank line or inside a block + (while (or (and (org-list-maybe-skip-block #'re-search-backward limit) + (goto-char (1- (point-at-bol)))) + (looking-at "^[ \t]*$")) + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + (or (and (org-at-item-p) (point-at-bol)) + (let ((ind (org-get-indentation))) + (catch 'exit + (while t + (cond + ((or (bobp) (< (point) limit)) (throw 'exit nil)) + ((and (not (looking-at "[ \t]*$")) + (not (org-list-maybe-skip-block + #'re-search-backward limit)) + (< (org-get-indentation) ind)) + (throw 'exit (and (org-at-item-p) (point-at-bol)))) + (t (beginning-of-line 0))))))))) + +(defun org-list-in-item-p-with-regexp (limit) + "Is the cursor inside a plain list? + +Plain lists end when `org-list-end-regexp' is matched, or at a +blank line if `org-empty-line-terminates-plain-lists' is true." + (save-excursion + (let* ((actual-pos (goto-char (point-at-eol))) + ;; Moved to eol so current line can be matched by + ;; `org-item-re'. + (last-item-start (save-excursion + (org-search-backward-unenclosed + org-item-beginning-re limit t))) + (list-ender (org-list-terminator-between + last-item-start actual-pos))) + ;; We are in a list when we are on an item line or when we can + ;; find an item before point and there is no valid list ender + ;; between it and the point. + (and last-item-start + (not list-ender))))) + +(defun org-list-top-point-with-regexp (limit) + "Return point at the top level item in a list, or nil if not in a list. + +List ending is determined by regexp. See +`org-list-ending-method'. for more information." + (save-excursion + (and (org-list-in-item-p-with-regexp limit) + (let ((pos (point-at-eol))) + ;; Is there some list above this one ? If so, go to its ending. + ;; Otherwise, go back to the heading above or bob. + (goto-char (or (org-list-terminator-between limit pos) limit)) + ;; From there, search down our list. + (org-search-forward-unenclosed org-item-beginning-re pos t) + (point-at-bol))))) + +(defun org-list-bottom-point-with-regexp (limit) + "Return point just before list ending or nil if not in a list. + +List ending is determined by regexp. See +`org-list-ending-method'. for more information." + (save-excursion + (and (org-in-item-p) + (let ((pos (point))) + ;; The list ending is either first point matching + ;; `org-list-end-re', point at first white-line before next + ;; heading, or eob. + (or (org-list-terminator-between (min pos limit) limit t) limit))))) + +(defun org-list-top-point-with-indent (limit) + "Return point just before list ending or nil if not in a list. + +List ending is determined by indentation of text. See +`org-list-ending-method'. for more information." + (save-excursion + (let ((prev-p (org-list-in-item-p-with-indent limit))) + (and prev-p + (catch 'exit + (while t + (cond + ((not prev-p) (throw 'exit (1+ (point-at-eol)))) + ((= limit prev-p) (throw 'exit limit)) + (t + (goto-char prev-p) + (beginning-of-line 0) + (setq prev-p (org-list-in-item-p-with-indent limit)))))))))) + +(defun org-list-bottom-point-with-indent (limit) + "Return point just before list ending or nil if not in a list. + +List ending is determined by the indentation of text. See +`org-list-ending-method' for more information." + (save-excursion + (let* ((ind (save-excursion + (ignore-errors (org-beginning-of-item)) + (org-get-indentation))) + (end-item (lambda () + (save-excursion + (catch 'end + (while t + (beginning-of-line 2) + (cond + ((>= (point) limit) (throw 'end limit)) + ((or (looking-at "^[ \t]*$") + (org-list-maybe-skip-block + #'re-search-forward limit) + (> (org-get-indentation) ind))) + (t (throw 'end (point-at-bol)))))))))) + (and (org-in-item-p) + (catch 'exit + (while t + (goto-char (funcall end-item)) + (if (looking-at org-item-beginning-re) + (setq ind (org-get-indentation)) + (skip-chars-backward " \r\t\n") + (throw 'exit (1+ (point-at-eol)))))))))) (defun org-list-at-regexp-after-bullet-p (regexp) "Is point at a list item with REGEXP after bullet?" @@ -393,7 +546,8 @@ function ends." usr-blank) (cond ;; Trivial cases where there should be none. - ((or org-empty-line-terminates-plain-lists + ((or (and (not (eq org-list-ending-method 'indent)) + org-empty-line-terminates-plain-lists) (not insert-blank-p)) 0) ;; When `org-blank-before-new-entry' says so, it is 1. ((eq insert-blank-p t) 1) @@ -465,20 +619,18 @@ function ends." ;;; Predicates (defun org-in-item-p () - "Is the cursor inside a plain list ?" + "Is the cursor inside a plain list? +This checks `org-list-ending-method'." (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) - (save-excursion - (let* ((limit (save-excursion (outline-previous-heading))) - ;; Move to eol so current line can be matched by `org-item-re'. - (actual-pos (goto-char (point-at-eol))) - (last-item-start (save-excursion - (org-search-backward-unenclosed org-item-beginning-re limit t))) - (list-ender (org-list-terminator-between last-item-start actual-pos))) - ;; We are in a list when we are on an item line or when we can - ;; find an item before point and there is no valid list ender - ;; between it and the point. - (and last-item-start - (not list-ender)))))) + (let ((bound (or (save-excursion (outline-previous-heading)) + (point-min)))) + (cond + ((eq org-list-ending-method 'indent) + (org-list-in-item-p-with-indent bound)) + ((eq org-list-ending-method 'both) + (and (org-list-in-item-p-with-indent bound) + (org-list-in-item-p-with-regexp bound))) + (t (org-list-in-item-p-with-regexp bound)))))) (defun org-list-first-item-p () "Is this item the first item in a plain list? @@ -486,7 +638,8 @@ Assume point is at an item." (save-excursion (beginning-of-line) (let ((ind (org-get-indentation))) - (or (not (org-search-backward-unenclosed org-item-beginning-re (org-list-top-point) t)) + (or (not (org-search-backward-unenclosed + org-item-beginning-re (org-list-top-point) t)) (< (org-get-indentation) ind))))) (defun org-at-item-p () @@ -502,7 +655,8 @@ Assume point is at an item." (defun org-at-item-timer-p () "Is point at a line starting a plain list item with a timer?" - (org-list-at-regexp-after-bullet-p "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) + (org-list-at-regexp-after-bullet-p + "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) (defun org-at-item-description-p () "Is point at a description list item?" @@ -537,34 +691,32 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;;; Navigate (defun org-list-top-point () - "Return point at the top level item in a list, or nil if not in a list." - (save-excursion - (and (org-in-item-p) - (let ((pos (point-at-eol)) - (bound (or (outline-previous-heading) (point-min)))) - ;; Is there some list above this one ? If so, go to its ending. - ;; Otherwise, go back to the heading above or bob. - (goto-char (or (org-list-terminator-between bound pos) bound)) - ;; From there, search down our list. - (org-search-forward-unenclosed org-item-beginning-re pos t) - (point-at-bol))))) + (let ((limit (or (save-excursion (outline-previous-heading)) + (point-min)))) + (cond + ((eq org-list-ending-method 'indent) + (org-list-top-point-with-indent limit)) + ((eq org-list-ending-method 'both) + (max (org-list-top-point-with-regexp limit) + (org-list-top-point-with-indent limit))) + (t (org-list-top-point-with-regexp limit))))) (defun org-list-bottom-point () - "Return point just before list ending or nil if not in a list." - (save-excursion - (and (org-in-item-p) - (let ((pos (point)) - (bound (or (and (let ((outline-regexp org-outline-regexp)) - ;; Use default regexp because folding - ;; changes OUTLINE-REGEXP. - (outline-next-heading)) - (skip-chars-backward " \t\r\n") - (1+ (point-at-eol))) - (point-max)))) - ;; The list ending is either first point matching - ;; `org-list-end-re', point at first white-line before next - ;; heading, or eob. - (or (org-list-terminator-between (min pos bound) bound t) bound))))) + (let ((limit (or (save-excursion + (and (let ((outline-regexp org-outline-regexp)) + ;; Use default regexp because folding + ;; changes OUTLINE-REGEXP. + (outline-next-heading)) + (skip-chars-backward " \r\t\n") + (1+ (point-at-eol)))) + (point-max)))) + (cond + ((eq org-list-ending-method 'indent) + (org-list-bottom-point-with-indent limit)) + ((eq org-list-ending-method 'both) + (min (org-list-bottom-point-with-regexp limit) + (org-list-bottom-point-with-indent limit))) + (t (org-list-bottom-point-with-regexp limit))))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. @@ -1032,16 +1184,21 @@ Initial position is restored after the changes." (match-string 1))) (old-body-ind (+ (length old-bul) old-ind)) (new-body-ind (+ (length new-bul) new-ind))) - ;; Replace bullet - (unless (equal new-bul old-bul) - (save-excursion (replace-match new-bul nil nil nil 1))) - ;; Indent item to appropriate column - (unless (= new-ind old-ind) - (delete-region (point-at-bol) (match-beginning 1)) - (indent-to new-ind)) - ;; Shift item's body + ;; 1. Shift item's body (unless (= old-body-ind new-body-ind) - (org-shift-item-indentation (- new-body-ind old-body-ind)))))) + (org-shift-item-indentation (- new-body-ind old-body-ind))) + ;; 2. Replace bullet + (unless (equal new-bul old-bul) + (save-excursion + (looking-at "[ \t]*\\(\\S-+[ \t]*\\)") + (replace-match new-bul nil nil nil 1))) + ;; 3. Indent item to appropriate column + (unless (= new-ind old-ind) + (delete-region (point-at-bol) + (progn + (skip-chars-forward " \t") + (point))) + (indent-to new-ind))))) ;; Remove ancestor if it is left. (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) @@ -1680,7 +1837,8 @@ sublevels as a list of strings." (when delete (delete-region start end) (save-match-data - (when (looking-at (org-list-end-re)) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) (replace-match "\n")))) (setq output (nreverse output)) (push ltype output))) From 347f39445ad5be132fbda34ca74c89a3f6740eb7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 20 Aug 2010 01:58:46 +0200 Subject: [PATCH 225/348] Added some documentation to code. --- lisp/org-list.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 394a96831..2469ee9f4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -173,8 +173,10 @@ that point is in a list." (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. + This variable only makes sense if `org-list-ending-method' is set -to 'regexp or 'both." +to 'regexp or 'both. This is then equivalent to set +`org-list-end-regexp' to \"^[ \\t]*$\"." :group 'org-plain-lists :type 'boolean) @@ -336,9 +338,12 @@ It looks for the boundary of the block in SEARCH direction." (catch 'exit (let ((origin (point))) (while t + ;; 1. No match: return to origin or bound, depending on NOERR. (unless (funcall search re bound noerr) (throw 'exit (and (goto-char (if (booleanp noerr) origin bound)) nil))) + ;; 2. Match not in block or protected: return point. Else + ;; skip the block and carry on. (unless (or (get-text-property (match-beginning 0) 'org-protected) (org-list-maybe-skip-block search bound)) (throw 'exit (point))))))) @@ -374,9 +379,12 @@ Return the position of the previous item, if applicable." (while t (cond ((or (bobp) (< (point) limit)) (throw 'exit nil)) + ;; skip blank lines.. ((and (not (looking-at "[ \t]*$")) + ;; blocks... (not (org-list-maybe-skip-block #'re-search-backward limit)) + ;; and items more indented. (< (org-get-indentation) ind)) (throw 'exit (and (org-at-item-p) (point-at-bol)))) (t (beginning-of-line 0))))))))) @@ -958,8 +966,8 @@ change is an outdent." (>= (org-get-indentation) ind-min)) (setq post-list (cons (org-list-struct-assoc-at-point) post-list))) - ;; we need to check if list is malformed and some - ;; items are less indented that top-item + ;; Is list is malformed? If some items are less + ;; indented that top-item, add them anyhow. (when (and (= (caar pre-list) 0) (org-at-item-p)) (setq post-list (cons (org-list-struct-assoc-at-point) post-list)) From 56542f799c0b86e094277909d7b66d01bb919ac7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 20 Aug 2010 11:35:56 +0200 Subject: [PATCH 226/348] Removed renumber rule. Documentation fixes. --- lisp/org-list.el | 56 ++++++++++++++++++++---------------------------- 1 file changed, 23 insertions(+), 33 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2469ee9f4..5bfd7931b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -152,18 +152,18 @@ spaces instead of one after the bullet in each item of the list." (defcustom org-list-ending-method 'regexp "Determine where plain lists should end. -Valid values are symbols 'regexp, 'indent or 'both. +Valid values are: `regexp', `indent' or `both'. -When set to 'regexp, Org will look into two variables, +When set to `regexp', Org will look into two variables, `org-empty-line-terminates-plain-lists' and the more general `org-list-end-regexp', to know what will end lists. This is the default value. -When set to 'indent, indentation of the last non-blank line will +When set to `indent', indentation of the last non-blank line will determine if point is in a list. If that line is less indented than the previous item in the section, if any, list has ended. -When set to 'both, each of the preceding methods must confirm +When set to `both', each of the preceding methods must confirm that point is in a list." :group 'org-plain-lists :type '(choice @@ -175,7 +175,7 @@ that point is in a list." "Non-nil means an empty line ends all plain list levels. This variable only makes sense if `org-list-ending-method' is set -to 'regexp or 'both. This is then equivalent to set +to regexp or both. This is then equivalent to set `org-list-end-regexp' to \"^[ \\t]*$\"." :group 'org-plain-lists :type 'boolean) @@ -191,8 +191,7 @@ precedence over it." (defcustom org-list-automatic-rules '((bullet . t) (checkbox . t) (indent . t) - (insert . t) - (renumber . t)) + (insert . t)) "Non-nil means apply set of rules when acting on lists. By default, automatic actions are taken when using @@ -210,16 +209,13 @@ checkbox when non-nil, checkbox statistics is updated each time you either insert a new checkbox or toggle a checkbox. It also prevents from inserting a checkbox in a description item. -indent when non-nil indenting or outdenting list top-item with - its subtree will move the whole list and outdenting a - list whose bullet is * to column 0 will change that - bullet to -. +indent when non-nil, indenting or outdenting list top-item + with its subtree will move the whole list and + outdenting a list whose bullet is * to column 0 will + change that bullet to - insert when non-nil, trying to insert an item inside a block will insert it right before the block instead of - throwing an error. -renumber when non-nil, renumber ordered plain lists whenever it - is modified. You can always use \\[org-ctrl-c-ctrl-c] - to trigger renumbering." + throwing an error." :group 'org-plain-lists :type '(alist :tag "Sets of rules" :key-type @@ -227,8 +223,7 @@ renumber when non-nil, renumber ordered plain lists whenever it (const :tag "Bullet" bullet) (const :tag "Checkbox" checkbox) (const :tag "Indent" indent) - (const :tag "Insert" insert) - (const :tag "Renumber" renumber)) + (const :tag "Insert" insert)) :value-type (boolean :tag "Activate" :value t))) @@ -304,8 +299,8 @@ of `org-plain-list-ordered-item-terminator'." This function looks for `org-list-end-re' outside a block. If FIRSTP in non-nil, return the point at the beginning of the -nearest valid terminator from min. Otherwise, return the point at -the end of the nearest terminator from max." +nearest valid terminator from MIN. Otherwise, return the point at +the end of the nearest terminator from MAX." (save-excursion (let* ((start (if firstp min max)) (end (if firstp max min)) @@ -438,7 +433,7 @@ List ending is determined by regexp. See (or (org-list-terminator-between (min pos limit) limit t) limit))))) (defun org-list-top-point-with-indent (limit) - "Return point just before list ending or nil if not in a list. + "Return point at the top level in a list, or nil if not in a list. List ending is determined by indentation of text. See `org-list-ending-method'. for more information." @@ -600,8 +595,6 @@ function ends." (goto-char true-pos) (cond (before-p (funcall insert-fun nil) - ;; Not taking advantage of renumbering while moving - ;; down. Need to call it directly. (org-list-repair) t) ;; Can't split item: insert bullet at the end of item. ((not (org-get-alist-option org-M-RET-may-split-line 'item)) @@ -1299,7 +1292,9 @@ children. Return t if successful." (top (org-list-top-point))) (cond ;; Special case: moving top-item with indent rule - ((and (= top beg) (cdr (assq 'indent org-list-automatic-rules))) + ((and (= top beg) + (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree)) (let* ((level-skip (org-level-increment)) (offset (if (< arg 0) (- level-skip) level-skip)) (top-ind (nth 1 beg-item))) @@ -1402,8 +1397,8 @@ It determines the number of whitespaces to append by looking at "Make sure all items are correctly indented, with the right bullet. This function scans the list at point, along with any sublist. -If the string FORCE-BULLET is provided, ensure all items in list -share this bullet, or a logical successor in an ordered list. +If FORCE-BULLET is a string, ensure all items in list share this +bullet, or a logical successor in the case of an ordered list. Item's body is not indented, only shifted with the bullet." (interactive) @@ -1411,7 +1406,7 @@ Item's body is not indented, only shifted with the bullet." (let* ((struct (org-list-struct (point-at-bol) (point-at-eol))) (origins (org-list-struct-origins struct)) fixed-struct) - (if force-bullet + (if (stringp force-bullet) (let ((begin (nth 1 struct))) (setcdr begin (list (nth 1 begin) (org-list-bullet-string force-bullet) @@ -1421,11 +1416,6 @@ Item's body is not indented, only shifted with the bullet." (setq fixed-struct (org-list-struct-fix-struct struct origins))) (org-list-struct-apply-struct fixed-struct))) -;; For backward compatibility -(defalias 'org-fix-bullet-type 'org-list-repair) -(defalias 'org-renumber-ordered-list 'org-list-repair) -(defalias 'org-maybe-renumber-ordered-list 'org-list-repair) - (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. This cycle the entire list level through the sequence: @@ -1559,8 +1549,8 @@ in subtree." (defvar org-checkbox-statistics-hook nil "Hook that is run whenever Org thinks checkbox statistics should be updated. -This hook runs even if 'checkbox rules in -`org-list-automatic-rules' do not apply, so it can be used to +This hook runs even if checkbox rule in +`org-list-automatic-rules' does not apply, so it can be used to implement alternative ways of collecting statistics information.") From 6b2468477e52d9993160b8e7c0f709b75aa33c53 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 20 Aug 2010 13:05:38 +0200 Subject: [PATCH 227/348] [@num] is valid to enforce a numbering (same as [@start:num]) --- lisp/org-ascii.el | 3 ++- lisp/org-docbook.el | 2 +- lisp/org-html.el | 2 +- lisp/org-latex.el | 2 +- lisp/org-list.el | 10 +++++----- lisp/org.el | 2 +- 6 files changed, 11 insertions(+), 10 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index f3b403abb..c05d4fb67 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -571,7 +571,8 @@ publishing directory." (replace-match "\\1\\2"))) ;; Remove list start counters (goto-char (point-min)) - (while (org-search-forward-unenclosed "\\[@start:[0-9]+\\][ \t]*" nil t) + (while (org-search-forward-unenclosed + "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t) (replace-match "")) (remove-text-properties (point-min) (point-max) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index bca412e6e..741465ef5 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1024,7 +1024,7 @@ publishing directory." line (substring line (match-beginning 5)) item-tag nil item-number nil) - (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) + (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) (setq item-number (match-string 1 line) line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) diff --git a/lisp/org-html.el b/lisp/org-html.el index ac0a48809..e9fcc4f53 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1548,7 +1548,7 @@ lang=\"%s\" xml:lang=\"%s\"> line (substring line (match-beginning 5)) item-number nil item-tag nil) - (if (string-match "\\`\\[@start:\\([0-9]+\\)\\][ \t]?" line) + (if (string-match "\\[@\\(?:start:\\)?\\([0-9]+\\)\\][ \t]?" line) (setq item-number (match-string 1 line) line (replace-match "" t t line))) (if (and starter (string-match "\\(.*?\\) ::[ \t]*" line)) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index bdabcdc22..852a83a05 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2242,7 +2242,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (beginning-of-line) (setq res (org-list-to-latex (org-list-parse-list t) org-export-latex-list-parameters)) - (while (string-match "^\\(\\\\item[ \t]+\\)\\[@start:\\([0-9]+\\)\\]" + (while (string-match "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]" res) (setq res (replace-match (concat (format "\\setcounter{enumi}{%d}" diff --git a/lisp/org-list.el b/lisp/org-list.el index 5bfd7931b..41303507e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -486,7 +486,7 @@ List ending is determined by the indentation of text. See (save-excursion (goto-char (match-end 0)) ;; Ignore counter if any - (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?") + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") (goto-char (match-end 0))) (looking-at regexp)))) @@ -686,7 +686,7 @@ A checkbox is blocked if all of the following conditions are fulfilled: (error (throw 'exit nil))) (unless (org-entry-get nil "ORDERED") (throw 'exit nil)) (when (org-search-forward-unenclosed - "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@start:[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) + "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) (org-current-line))))))) ;;; Navigate @@ -912,7 +912,7 @@ bullet string and bullet counter, if any." (match-string 1)) (progn (goto-char (match-end 0)) - (and (looking-at "\\[@start:\\([0-9]+\\)\\]") + (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") (match-string 1)))))) (defun org-list-struct (begin end &optional outdent) @@ -1506,7 +1506,7 @@ in subtree." (org-at-item-p)) (goto-char (match-end 0)) ;; Ignore counter, if any - (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?") + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") (goto-char (match-end 0))) (let ((desc-p (and (org-at-item-description-p) (cdr (assq 'checkbox org-list-automatic-rules))))) @@ -1820,7 +1820,7 @@ sublevels as a list of strings." (org-end-of-item-or-at-child)))) (nextindent (if (= (point) end) 0 (org-get-indentation))) (item (if (string-match - "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" + "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" item) (replace-match (if (equal (match-string 1 item) " ") "CBOFF" diff --git a/lisp/org.el b/lisp/org.el index 5c745b6d1..ead72346f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5457,7 +5457,7 @@ needs to be inserted at a specific position in the font-lock sequence.") '(org-do-emphasis-faces (0 nil append)) '(org-do-emphasis-faces))) ;; Checkboxes - '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" + '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" 1 'org-checkbox prepend) (if (cdr (assq 'checkbox org-list-automatic-rules)) '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" From 113818cdf02cda403dcc638373c0ec70747e3778 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 20 Aug 2010 13:58:11 +0200 Subject: [PATCH 228/348] Bug fix: infinite loop while looking for top point with indent method --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 41303507e..f4cf9a2fa 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -444,7 +444,7 @@ List ending is determined by indentation of text. See (while t (cond ((not prev-p) (throw 'exit (1+ (point-at-eol)))) - ((= limit prev-p) (throw 'exit limit)) + ((= (point) prev-p) (throw 'exit prev-p)) (t (goto-char prev-p) (beginning-of-line 0) From 221ff58e19fac0ce8cc9baf9af904a25acec1e10 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 20 Aug 2010 15:56:52 +0200 Subject: [PATCH 229/348] Small optimization. --- lisp/org-list.el | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index f4cf9a2fa..8df015f27 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -365,24 +365,31 @@ Return the position of the previous item, if applicable." ;; do not start searching at a blank line or inside a block (while (or (and (org-list-maybe-skip-block #'re-search-backward limit) (goto-char (1- (point-at-bol)))) - (looking-at "^[ \t]*$")) + (and (looking-at "^[ \t]*$") (not (bobp)))) (skip-chars-backward " \r\t\n") (beginning-of-line)) (or (and (org-at-item-p) (point-at-bol)) - (let ((ind (org-get-indentation))) - (catch 'exit - (while t - (cond - ((or (bobp) (< (point) limit)) (throw 'exit nil)) - ;; skip blank lines.. - ((and (not (looking-at "[ \t]*$")) - ;; blocks... - (not (org-list-maybe-skip-block - #'re-search-backward limit)) - ;; and items more indented. - (< (org-get-indentation) ind)) - (throw 'exit (and (org-at-item-p) (point-at-bol)))) - (t (beginning-of-line 0))))))))) + (let* ((pos (point)) + (ind (org-get-indentation)) + (bound (save-excursion + (goto-char limit) + (and (org-search-forward-unenclosed + org-item-beginning-re pos t) + (point-at-bol))))) + (when bound + (catch 'exit + (while t + (cond + ((or (bobp) (< (point) bound)) (throw 'exit nil)) + ;; skip blank lines.. + ((and (not (looking-at "[ \t]*$")) + ;; blocks... + (not (org-list-maybe-skip-block + #'re-search-backward bound)) + ;; and items more indented. + (< (org-get-indentation) ind)) + (throw 'exit (and (org-at-item-p) (point-at-bol)))) + (t (beginning-of-line 0)))))))))) (defun org-list-in-item-p-with-regexp (limit) "Is the cursor inside a plain list? @@ -629,8 +636,8 @@ This checks `org-list-ending-method'." ((eq org-list-ending-method 'indent) (org-list-in-item-p-with-indent bound)) ((eq org-list-ending-method 'both) - (and (org-list-in-item-p-with-indent bound) - (org-list-in-item-p-with-regexp bound))) + (and (org-list-in-item-p-with-regexp bound) + (org-list-in-item-p-with-indent bound))) (t (org-list-in-item-p-with-regexp bound)))))) (defun org-list-first-item-p () From c96c14a9d5dbc972ebb22622b6fb989bee673b8d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 20 Aug 2010 17:26:46 +0200 Subject: [PATCH 230/348] Fix bug in `org-list-bottom-point' and `org-list-top-point'. --- lisp/org-list.el | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8df015f27..9f210762a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -449,9 +449,9 @@ List ending is determined by indentation of text. See (and prev-p (catch 'exit (while t - (cond + (cond ((not prev-p) (throw 'exit (1+ (point-at-eol)))) - ((= (point) prev-p) (throw 'exit prev-p)) + ((= prev-p limit) (throw 'exit limit)) (t (goto-char prev-p) (beginning-of-line 0) @@ -699,17 +699,22 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;;; Navigate (defun org-list-top-point () + "Return point at the top level in a list, or nil if not in a list." (let ((limit (or (save-excursion (outline-previous-heading)) (point-min)))) (cond ((eq org-list-ending-method 'indent) (org-list-top-point-with-indent limit)) ((eq org-list-ending-method 'both) - (max (org-list-top-point-with-regexp limit) - (org-list-top-point-with-indent limit))) + (let ((top-re (org-list-top-point-with-regexp limit)) + (top-ind (org-list-top-point-with-indent limit))) + (if (and top-re top-ind) + (max top-re top-ind) + (or top-re top-ind)))) (t (org-list-top-point-with-regexp limit))))) (defun org-list-bottom-point () + "Return point just before list ending or nil if not in a list." (let ((limit (or (save-excursion (and (let ((outline-regexp org-outline-regexp)) ;; Use default regexp because folding @@ -722,8 +727,11 @@ A checkbox is blocked if all of the following conditions are fulfilled: ((eq org-list-ending-method 'indent) (org-list-bottom-point-with-indent limit)) ((eq org-list-ending-method 'both) - (min (org-list-bottom-point-with-regexp limit) - (org-list-bottom-point-with-indent limit))) + (let ((bottom-re (org-list-bottom-point-with-regexp limit)) + (bottom-ind (org-list-bottom-point-with-indent limit))) + (if (and bottom-re bottom-ind) + (min bottom-re bottom-ind) + (or bottom-re bottom-ind)))) (t (org-list-bottom-point-with-regexp limit))))) (defun org-beginning-of-item () From c675061eb2fa91b540f8371c795082b678d34b1e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 21 Aug 2010 04:32:48 +0200 Subject: [PATCH 231/348] Speed optimization of indent method --- lisp/org-list.el | 135 +++++++++++++++++++++++++++-------------------- 1 file changed, 77 insertions(+), 58 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 9f210762a..304980b4b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -361,35 +361,35 @@ indented than the previous item within LIMIT. Return the position of the previous item, if applicable." (save-excursion - (beginning-of-line) - ;; do not start searching at a blank line or inside a block - (while (or (and (org-list-maybe-skip-block #'re-search-backward limit) - (goto-char (1- (point-at-bol)))) - (and (looking-at "^[ \t]*$") (not (bobp)))) + (cond + ;; do not start searching inside a block... + ((org-list-maybe-skip-block #'re-search-backward limit)) + ;; ... or at a blank line + ((looking-at "^[ \t]*$") (skip-chars-backward " \r\t\n") - (beginning-of-line)) + (beginning-of-line))) + (beginning-of-line) (or (and (org-at-item-p) (point-at-bol)) - (let* ((pos (point)) - (ind (org-get-indentation)) - (bound (save-excursion - (goto-char limit) - (and (org-search-forward-unenclosed - org-item-beginning-re pos t) - (point-at-bol))))) - (when bound - (catch 'exit - (while t - (cond - ((or (bobp) (< (point) bound)) (throw 'exit nil)) - ;; skip blank lines.. - ((and (not (looking-at "[ \t]*$")) - ;; blocks... - (not (org-list-maybe-skip-block - #'re-search-backward bound)) - ;; and items more indented. - (< (org-get-indentation) ind)) - (throw 'exit (and (org-at-item-p) (point-at-bol)))) - (t (beginning-of-line 0)))))))))) + (let ((case-fold-search t) + (bound (save-excursion + (when (org-search-backward-unenclosed + org-item-beginning-re limit t) + (cons (point-at-bol) (org-get-indentation)))))) + (and bound + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + ((= (point) (car bound)) + (throw 'exit (car bound))) + ((>= (cdr bound) ind) + (throw 'exit nil)) + (t (forward-line -1))))))))))) (defun org-list-in-item-p-with-regexp (limit) "Is the cursor inside a plain list? @@ -445,17 +445,31 @@ List ending is determined by regexp. See List ending is determined by indentation of text. See `org-list-ending-method'. for more information." (save-excursion - (let ((prev-p (org-list-in-item-p-with-indent limit))) + (let ((prev-p (org-list-in-item-p-with-indent limit)) + (case-fold-search t)) (and prev-p - (catch 'exit - (while t - (cond - ((not prev-p) (throw 'exit (1+ (point-at-eol)))) - ((= prev-p limit) (throw 'exit limit)) - (t - (goto-char prev-p) - (beginning-of-line 0) - (setq prev-p (org-list-in-item-p-with-indent limit)))))))))) + (let ((item-ref (goto-char prev-p)) + (ind-ref 10000)) + (forward-line -1) + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((<= (point) limit) + (throw 'exit item-ref)) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + ((not (looking-at org-item-beginning-re)) + (setq ind-ref (min ind ind-ref)) + (forward-line -1)) + ((>= ind ind-ref) + (throw 'exit item-ref)) + (t + (setq item-ref (point-at-bol) ind-ref 10000) + (forward-line -1))))))))))) (defun org-list-bottom-point-with-indent (limit) "Return point just before list ending or nil if not in a list. @@ -463,29 +477,34 @@ List ending is determined by indentation of text. See List ending is determined by the indentation of text. See `org-list-ending-method' for more information." (save-excursion - (let* ((ind (save-excursion - (ignore-errors (org-beginning-of-item)) - (org-get-indentation))) - (end-item (lambda () - (save-excursion - (catch 'end - (while t - (beginning-of-line 2) - (cond - ((>= (point) limit) (throw 'end limit)) - ((or (looking-at "^[ \t]*$") - (org-list-maybe-skip-block - #'re-search-forward limit) - (> (org-get-indentation) ind))) - (t (throw 'end (point-at-bol)))))))))) - (and (org-in-item-p) + (let* ((beg-item (org-in-item-p)) + (ind-ref (save-excursion + (when beg-item + (goto-char beg-item) + (org-get-indentation)))) + (case-fold-search t)) + ;; do not start inside a block + (org-list-maybe-skip-block #'re-search-forward limit) + (beginning-of-line) + (and beg-item (catch 'exit (while t - (goto-char (funcall end-item)) - (if (looking-at org-item-beginning-re) - (setq ind (org-get-indentation)) - (skip-chars-backward " \r\t\n") - (throw 'exit (1+ (point-at-eol)))))))))) + (let ((ind (org-get-indentation))) + (cond + ((>= (point) limit) + (throw 'exit limit)) + ((looking-at "^[ \t]*$") + (skip-chars-forward " \r\t\n") + (beginning-of-line)) + ((looking-at org-item-beginning-re) + (setq ind-ref (min ind ind-ref)) + (forward-line 1)) + ((<= ind ind-ref) + (throw 'exit (point-at-bol))) + ((looking-at "^[ \t]*#\\+begin_") + (re-search-forward "[ \t]*#\\+end_") + (forward-line 1)) + (t (forward-line 1)))))))))) (defun org-list-at-regexp-after-bullet-p (regexp) "Is point at a list item with REGEXP after bullet?" From 50f2c13ddc9a73203064df4a8180a4a1742e50aa Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 21 Aug 2010 13:32:33 +0200 Subject: [PATCH 232/348] Modified docstrings according to `checkdoc-current-buffer'. --- lisp/org-list.el | 136 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 101 insertions(+), 35 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 304980b4b..a7bf4ff19 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -318,7 +318,8 @@ the end of the nearest terminator from MAX." (defun org-list-maybe-skip-block (search limit) "Return non-nil value if point is in a block, skipping it on the way. -It looks for the boundary of the block in SEARCH direction." +It looks for the boundary of the block in SEARCH direction, +stopping at LIMIT." (save-match-data (let ((case-fold-search t) (boundary (if (eq search 're-search-forward) 3 5))) @@ -329,7 +330,11 @@ It looks for the boundary of the block in SEARCH direction." (goto-char (match-beginning 0)))))) (defun org-list-search-unenclosed-generic (search re bound noerr) - "Search for RE with SEARCH outside blocks and protected places." + "Search a string outside blocks and protected places. + +Arguments SEARCH, RE, BOUND and NOERR are similar to those in +`search-forward', `search-backward', `re-search-forward' and +`re-search-backward'." (catch 'exit (let ((origin (point))) (while t @@ -344,12 +349,18 @@ It looks for the boundary of the block in SEARCH direction." (throw 'exit (point))))))) (defun org-search-backward-unenclosed (regexp &optional bound noerror) - "Like `re-search-backward' but don't stop inside blocks or protected places." + "Like `re-search-backward' but don't stop inside blocks or protected places. + +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-backward'." (org-list-search-unenclosed-generic #'re-search-backward regexp (or bound (point-min)) noerror)) (defun org-search-forward-unenclosed (regexp &optional bound noerror) - "Like `re-search-forward' but don't stop inside blocks or protected places." + "Like `re-search-forward' but don't stop inside blocks or protected places. + +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-forward'." (org-list-search-unenclosed-generic #'re-search-forward regexp (or bound (point-max)) noerror)) @@ -395,7 +406,9 @@ Return the position of the previous item, if applicable." "Is the cursor inside a plain list? Plain lists end when `org-list-end-regexp' is matched, or at a -blank line if `org-empty-line-terminates-plain-lists' is true." +blank line if `org-empty-line-terminates-plain-lists' is true. + +Argument LIMIT specifies the upper-bound of the search." (save-excursion (let* ((actual-pos (goto-char (point-at-eol))) ;; Moved to eol so current line can be matched by @@ -414,6 +427,8 @@ blank line if `org-empty-line-terminates-plain-lists' is true." (defun org-list-top-point-with-regexp (limit) "Return point at the top level item in a list, or nil if not in a list. +Argument LIMIT specifies the upper-bound of the search. + List ending is determined by regexp. See `org-list-ending-method'. for more information." (save-excursion @@ -429,6 +444,8 @@ List ending is determined by regexp. See (defun org-list-bottom-point-with-regexp (limit) "Return point just before list ending or nil if not in a list. +Argument LIMIT specifies the lower-bound of the search. + List ending is determined by regexp. See `org-list-ending-method'. for more information." (save-excursion @@ -442,6 +459,8 @@ List ending is determined by regexp. See (defun org-list-top-point-with-indent (limit) "Return point at the top level in a list, or nil if not in a list. +Argument LIMIT specifies the upper-bound of the search. + List ending is determined by indentation of text. See `org-list-ending-method'. for more information." (save-excursion @@ -474,6 +493,8 @@ List ending is determined by indentation of text. See (defun org-list-bottom-point-with-indent (limit) "Return point just before list ending or nil if not in a list. +Argument LIMIT specifies the lower-bound of the search. + List ending is determined by the indentation of text. See `org-list-ending-method' for more information." (save-excursion @@ -551,7 +572,7 @@ function ends." '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))) (if (not (cdr (assq 'insert org-list-automatic-rules))) ;; Rule in `org-list-automatic-rules' forbids insertion. - (error "Cannot insert item inside a block.") + (error "Cannot insert item inside a block") ;; Else, move before it prior to add a new item. (end-of-line) (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) @@ -790,20 +811,21 @@ Point returned is at eol." (defun org-get-next-item (pos limit) "Get the point of the next item at the same level as POS. - Stop searching at LIMIT. Return nil if no item is found. This - function does not move point." +Stop searching at LIMIT. Return nil if no item is found. This +function does not move point." (org-list-get-item-same-level #'org-search-forward-unenclosed pos limit #'end-of-line)) (defun org-get-previous-item (pos limit) "Get the point of the previous item at the same level as POS. - Stop searching at LIMIT. Return nil if no item is found. This - function does not move point." +Stop searching at LIMIT. Return nil if no item is found. This +function does not move point." (org-list-get-item-same-level #'org-search-backward-unenclosed pos limit #'beginning-of-line)) (defun org-next-item () "Move to the beginning of the next item. + Item is at the same level in the current plain list. Error if not in a plain list, or if this is the last item in the list." (interactive) @@ -812,6 +834,7 @@ in a plain list, or if this is the last item in the list." (defun org-previous-item () "Move to the beginning of the previous item. + Item is at the same level in the current plain list. Error if not in a plain list, or if this is the first item in the list." (interactive) @@ -830,7 +853,7 @@ Return point." (defun org-end-of-item-list () "Go to the end of the current list or sublist. - Return point." +Return point." (interactive) (org-beginning-of-item) (let ((limit (org-list-bottom-point)) @@ -844,8 +867,9 @@ Return point." (defun org-list-exchange-items (beg-A beg-B) "Swap item starting at BEG-A with item starting at BEG-B. - Blank lines at the end of items are left in place. Assumes - BEG-A is lesser than BEG-B." + +Blank lines at the end of items are left in place. Assumes BEG-A +is lesser than BEG-B." (save-excursion (let* ((end-of-item-no-blank (lambda (pos) (goto-char pos) @@ -861,6 +885,7 @@ Return point." (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. + Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) @@ -879,6 +904,7 @@ so this really moves item trees." (defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. + Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) @@ -898,9 +924,12 @@ so this really moves item trees." "Insert a new item at the current level. If cursor is before first character after bullet of the item, the -new item will be created before the current one. Return t when -things worked, nil when we are not in an item, or item is -invisible." +new item will be created before the current one. + +If CHECKBOX is non-nil, add a checkbox next to the bullet. + +Return t when things worked, nil when we are not in an item, or +item is invisible." (unless (or (not (org-in-item-p)) (org-invisible-p)) (if (save-excursion @@ -1016,7 +1045,9 @@ change is an outdent." extended))))) (defun org-list-struct-origins (struct) - "Return an alist where key is item's position and value parent's." + "Return an alist where key is item's position and value parent's. + +STRUCT is the list's structure looked up." (let* ((struct-rev (reverse struct)) (acc (list (cons (nth 1 (car struct)) 0))) (prev-item (lambda (item) @@ -1045,7 +1076,9 @@ change is an outdent." (cons '(0 . 0) (mapcar get-origins (cdr struct))))) (defun org-list-struct-get-parent (item struct origins) - "Return parent association of ITEM in STRUCT or nil." + "Return parent association of ITEM in STRUCT or nil. + +ORIGINS is the alist of parents. See `org-list-struct-origins'." (let* ((parent-pos (cdr (assq (car item) origins)))) (when (> parent-pos 0) (assq parent-pos struct)))) @@ -1057,6 +1090,9 @@ change is an outdent." (defun org-list-struct-fix-bul (struct origins) "Verify and correct bullets for every association in STRUCT. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + This function modifies STRUCT." (let* (acc (init-bul (lambda (item) @@ -1095,6 +1131,9 @@ This function modifies STRUCT." (defun org-list-struct-fix-ind (struct origins) "Verify and correct indentation for every association in STRUCT. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + This function modifies STRUCT." (let* ((headless (cdr struct)) (ancestor (car struct)) @@ -1112,6 +1151,9 @@ This function modifies STRUCT." (defun org-list-struct-fix-struct (struct origins) "Return STRUCT with correct bullets and indentation. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + Only elements of STRUCT that have changed are returned." (let ((old (copy-alist struct))) (org-list-struct-fix-bul struct origins) @@ -1119,8 +1161,14 @@ Only elements of STRUCT that have changed are returned." (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) (defun org-list-struct-outdent (start end origins) - "Outdent items in ORIGINS between BEGIN and END. -BEGIN is included and END excluded." + "Outdent items in a structure. + +Items are indented when their key is between START, included, and +END, excluded. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +STRUCT is the concerned structure." (let* (acc (out (lambda (cell) (let* ((item (car cell)) @@ -1146,11 +1194,16 @@ BEGIN is included and END excluded." (mapcar out origins))) (defun org-list-struct-indent (start end origins struct) - "Indent items in ORIGINS between BEGIN and END. -BEGIN is included and END excluded. + "Indent items in a structure. -STRUCT may be modified if `org-list-demote-modify-bullet' is -concerning bullets between START and END." +Items are indented when their key is between START, included, and +END, excluded. + +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +STRUCT is the concerned structure. It may be modified if +`org-list-demote-modify-bullet' matches bullets between START and +END." (let* (acc (orig-rev (reverse origins)) (get-prev-item @@ -1291,7 +1344,11 @@ If NO-SUBTREE is set, only outdent the item itself, not its children." (defun org-indent-item-tree (arg &optional no-subtree) "Indent a local list item including its children. -If NO-SUBTREE is set, only indent the item itself, not its + +When number ARG is a negative, item will be outdented, otherwise +it will be indented. + +If NO-SUBTREE is non-nil, only indent the item itself, not its children. Return t if successful." (interactive "p") (unless (org-at-item-p) @@ -1363,6 +1420,15 @@ children. Return t if successful." (defvar org-tab-ind-state) (defun org-cycle-item-indentation () + "Cycle levels of indentation of an empty item. + +The first run indent the item, if applicable. Subsequents runs +outdent it at meaningful levels in the list. When done, item is +put back at its original position with its original bullet. + +Return t at each successful move. + +The item must be empty." (let ((org-adapt-indentation nil)) (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) @@ -1420,7 +1486,7 @@ It determines the number of whitespaces to append by looking at nil nil bullet 1))) (defun org-list-inc-bullet-maybe (bullet) - "Increment numbered bullets." + "Increment BULLET if applicable." (if (string-match "[0-9]+" bullet) (replace-match (number-to-string (1+ (string-to-number (match-string 0 bullet)))) @@ -1718,10 +1784,9 @@ Otherwise it will be `org-todo'." (defun org-apply-on-list (function init-value &rest args) "Call FUNCTION for each item of a the list under point. -FUNCTION must be called with at least one argument: a return -value that will contain the value returned by the function at the -previous item, plus ARGS extra arguments. INIT-VALUE will be the -value passed to the function at the first item of the list. +FUNCTION must be called with at least one argument: INIT-VALUE, +that will contain the value returned by the function at the +previous item, plus ARGS extra arguments. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) will return the number of items in the current list. @@ -1747,6 +1812,9 @@ Sublists are not sorted. Checkboxes, if any, are ignored. Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. +Comparing entries ignores case by default. However, with an +optional argument WITH-CASE, the sorting considers case as well. + The command prompts for the sorting type unless it has been given to the function through the SORTING-TYPE argument, which needs to be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise @@ -1762,10 +1830,8 @@ Capital letters will reverse the sort order. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be called with point at the beginning of the record. It must return either a string or a number that should serve as -the sorting key for that record. - -Comparing entries ignores case by default. However, with an -optional argument WITH-CASE, the sorting considers case as well." +the sorting key for that record. It will then use COMPARE-FUNC to +compare entries." (interactive "P") (let* ((case-func (if with-case 'identity 'downcase)) (start (org-beginning-of-item-list)) @@ -1879,7 +1945,7 @@ sublevels as a list of strings." "Convert the plain list at point into a subtree." (interactive) (if (not (org-in-item-p)) - (error "Not in a list.") + (error "Not in a list") (goto-char (org-list-top-point)) (let ((list (org-list-parse-list t)) nstars) (save-excursion From bac9497d7aa14dc486638ad027804774c14f06a3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 21 Aug 2010 15:23:58 +0200 Subject: [PATCH 233/348] Handle drawers correctly. --- lisp/org-list.el | 97 ++++++++++++++++++++++++++++++------------------ lisp/org.el | 4 +- 2 files changed, 62 insertions(+), 39 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a7bf4ff19..bf43b4abc 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -381,26 +381,33 @@ Return the position of the previous item, if applicable." (beginning-of-line))) (beginning-of-line) (or (and (org-at-item-p) (point-at-bol)) - (let ((case-fold-search t) - (bound (save-excursion - (when (org-search-backward-unenclosed - org-item-beginning-re limit t) - (cons (point-at-bol) (org-get-indentation)))))) - (and bound + (let* ((case-fold-search t) + (pos (point)) + (ind-ref (org-get-indentation)) + ;; Is there an item above? + (up-item-p (save-excursion + (goto-char limit) + (org-search-forward-unenclosed + org-item-beginning-re pos t)))) + (and up-item-p (catch 'exit (while t - (let ((ind (org-get-indentation))) - (cond - ((looking-at "^[ \t]*$") - (skip-chars-backward " \r\t\n") - (beginning-of-line)) - ((looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_")) - ((= (point) (car bound)) - (throw 'exit (car bound))) - ((>= (cdr bound) ind) - (throw 'exit nil)) - (t (forward-line -1))))))))))) + (cond + ((or (= (point) limit) + (looking-at "^[ \t]*:END:")) + (throw 'exit nil)) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + ((looking-at org-item-beginning-re) + (if (< (org-get-indentation) ind-ref) + (throw 'exit (point-at-bol)) + (forward-line -1))) + (t + (setq ind-ref (min (org-get-indentation) ind-ref)) + (forward-line -1)))))))))) (defun org-list-in-item-p-with-regexp (limit) "Is the cursor inside a plain list? @@ -474,7 +481,8 @@ List ending is determined by indentation of text. See (while t (let ((ind (org-get-indentation))) (cond - ((<= (point) limit) + ((or (<= (point) limit) + (looking-at "^[ \t]*:END:")) (throw 'exit item-ref)) ((looking-at "^[ \t]*$") (skip-chars-backward " \r\t\n") @@ -512,8 +520,9 @@ List ending is determined by the indentation of text. See (while t (let ((ind (org-get-indentation))) (cond - ((>= (point) limit) - (throw 'exit limit)) + ((or (>= (point) limit) + (looking-at "^[ \t]*:END:")) + (throw 'exit (point))) ((looking-at "^[ \t]*$") (skip-chars-forward " \r\t\n") (beginning-of-line)) @@ -670,8 +679,13 @@ function ends." "Is the cursor inside a plain list? This checks `org-list-ending-method'." (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) - (let ((bound (or (save-excursion (outline-previous-heading)) - (point-min)))) + (let* ((prev-head (save-excursion (outline-previous-heading))) + (bound (if prev-head + (or (save-excursion + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*:END:" prev-head t))) + prev-head) + (point-min)))) (cond ((eq org-list-ending-method 'indent) (org-list-in-item-p-with-indent bound)) @@ -740,29 +754,38 @@ A checkbox is blocked if all of the following conditions are fulfilled: (defun org-list-top-point () "Return point at the top level in a list, or nil if not in a list." - (let ((limit (or (save-excursion (outline-previous-heading)) - (point-min)))) + (let* ((prev-head (save-excursion (outline-previous-heading))) + (bound (if prev-head + (or (save-excursion + (let ((case-fold-search t)) + (re-search-backward "^[ \t]*:END:" prev-head t))) + prev-head) + (point-min)))) (cond ((eq org-list-ending-method 'indent) - (org-list-top-point-with-indent limit)) + (org-list-top-point-with-indent bound)) ((eq org-list-ending-method 'both) - (let ((top-re (org-list-top-point-with-regexp limit)) - (top-ind (org-list-top-point-with-indent limit))) + (let ((top-re (org-list-top-point-with-regexp bound)) + (top-ind (org-list-top-point-with-indent bound))) (if (and top-re top-ind) (max top-re top-ind) (or top-re top-ind)))) - (t (org-list-top-point-with-regexp limit))))) + (t (org-list-top-point-with-regexp bound))))) (defun org-list-bottom-point () "Return point just before list ending or nil if not in a list." - (let ((limit (or (save-excursion - (and (let ((outline-regexp org-outline-regexp)) - ;; Use default regexp because folding - ;; changes OUTLINE-REGEXP. - (outline-next-heading)) - (skip-chars-backward " \r\t\n") - (1+ (point-at-eol)))) - (point-max)))) + (let* ((next-head (save-excursion + (and (let ((outline-regexp org-outline-regexp)) + ;; Use default regexp because folding + ;; changes OUTLINE-REGEXP. + (outline-next-heading)) + (skip-chars-backward " \r\t\n") + (1+ (point-at-eol))))) + (limit (or (save-excursion + (and (re-search-forward "^[ \t]*:END:" next-head t) + (point-at-bol))) + next-head + (point-max)))) (cond ((eq org-list-ending-method 'indent) (org-list-bottom-point-with-indent limit)) diff --git a/lisp/org.el b/lisp/org.el index ead72346f..ff73c225c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11699,7 +11699,7 @@ This is done in the same way as adding a state change note." (defvar org-property-end-re) (defun org-add-log-setup (&optional purpose state prev-state - findpos how &optional extra) + findpos how extra) "Set up the post command hook to take a note. If this is about to TODO state change, the new state is expected in STATE. When FINDPOS is non-nil, find the correct position for the note in @@ -11848,8 +11848,8 @@ EXTRA is additional text that will be inserted into the notes buffer." (move-marker org-log-note-marker nil) (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (insert "- " (pop lines)) (org-indent-line-function) + (insert "- " (pop lines)) (beginning-of-line 1) (looking-at "[ \t]*") (setq ind (concat (match-string 0) " ")) From 7b8352f94b77e10a82c4be57bb02005e9921ebab Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 22 Aug 2010 01:10:58 +0200 Subject: [PATCH 234/348] Renamed `org-indent-item-tree' to `org-list-indent-item-generic'. --- lisp/org-list.el | 193 ++++++++++++++++++++++++----------------------- 1 file changed, 100 insertions(+), 93 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index bf43b4abc..b3fe88594 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -673,6 +673,88 @@ function ends." (beginning-of-line 0)))))) (funcall insert-fun after-text) t))))) +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) + +(defun org-list-indent-item-generic (arg no-subtree) + "Indent a local list item including its children. + +When number ARG is a negative, item will be outdented, otherwise +it will be indented. + +If a region is active, all items in it will be moved. If +NO-SUBTREE is non-nil, only indent the item itself, not its +children. + +Return t if successful." + (interactive) + (unless (org-at-item-p) + (error "Not on an item")) + ;; Determine begin and end points of zone to indent. If moving by + ;; subtrees, ensure we don't drag additional items on subsequent + ;; moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if (org-region-active-p) + (progn + (set-marker org-last-indent-begin-marker (region-beginning)) + (set-marker org-last-indent-end-marker (region-end))) + (set-marker org-last-indent-begin-marker + (save-excursion (org-beginning-of-item))) + (set-marker org-last-indent-end-marker + (save-excursion + (if no-subtree + (org-end-of-item-or-at-child) + (org-end-of-item)))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (org-list-struct beg end (< arg 0))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct)) + (end-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (org-beginning-of-item) + (org-list-struct-assoc-at-point))) + (top (org-list-top-point))) + (cond + ;; Special case: moving top-item with indent rule + ((and (= top beg) + (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree)) + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) + ;; Shift ancestor + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) + (org-list-struct-apply-struct struct)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not (org-region-active-p)) + (org-list-struct-get-child beg-item struct)) + (org-list-struct-get-child end-item struct))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins struct)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct))))) + ;; Return value + t) + ;;; Predicates (defun org-in-item-p () @@ -1346,100 +1428,25 @@ Sub-items are not moved." (indent-line-to (+ i delta))))) (beginning-of-line 0))))) -(defun org-outdent-item (arg) +(defun org-outdent-item () "Outdent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree (- arg) t)) + (interactive) + (org-list-indent-item-generic -1 t)) -(defun org-indent-item (arg) +(defun org-indent-item () "Indent a local list item, but not its children." - (interactive "p") - (org-indent-item-tree arg t)) + (interactive) + (org-list-indent-item-generic 1 t)) -(defun org-outdent-item-tree (arg &optional no-subtree) - "Outdent a local list item including its children. -If NO-SUBTREE is set, only outdent the item itself, not its children." - (interactive "p") - (org-indent-item-tree (- arg) no-subtree)) +(defun org-outdent-item-tree () + "Outdent a local list item including its children." + (interactive) + (org-list-indent-item-generic -1 nil)) -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) - -(defun org-indent-item-tree (arg &optional no-subtree) - "Indent a local list item including its children. - -When number ARG is a negative, item will be outdented, otherwise -it will be indented. - -If NO-SUBTREE is non-nil, only indent the item itself, not its -children. Return t if successful." - (interactive "p") - (unless (org-at-item-p) - (error "Not on an item")) - ;; Determine begin and end points of zone to indent. If moving by - ;; subtrees, ensure we don't drag additional items on subsequent - ;; moves. - (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (if (org-region-active-p) - (progn - (set-marker org-last-indent-begin-marker (region-beginning)) - (set-marker org-last-indent-end-marker (region-end))) - (set-marker org-last-indent-begin-marker - (save-excursion (org-beginning-of-item))) - (set-marker org-last-indent-end-marker - (save-excursion - (if no-subtree - (org-end-of-item-or-at-child) - (org-end-of-item)))))) - ;; Get everything ready - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker)) - (struct (org-list-struct beg end (< arg 0))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct)) - (end-item (save-excursion - (goto-char end) - (skip-chars-backward " \r\t\n") - (org-beginning-of-item) - (org-list-struct-assoc-at-point))) - (top (org-list-top-point))) - (cond - ;; Special case: moving top-item with indent rule - ((and (= top beg) - (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree)) - (let* ((level-skip (org-level-increment)) - (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (nth 1 beg-item))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) - (org-list-bullet-string "-")))) - ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) - (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct)))) - ;; Forbidden move - ((and (< arg 0) - (or (and no-subtree - (not (org-region-active-p)) - (org-list-struct-get-child beg-item struct)) - (org-list-struct-get-child end-item struct))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((shifted-ori (if (< arg 0) - (org-list-struct-outdent beg end origins) - (org-list-struct-indent beg end origins struct)))) - (org-list-struct-fix-struct struct shifted-ori) - (org-list-struct-apply-struct struct))))) - ;; Return value - t) +(defun org-indent-item-tree () + "Indent a local list item including its children." + (interactive) + (org-list-indent-item-generic 1 nil)) (defvar org-tab-ind-state) (defun org-cycle-item-indentation () @@ -1466,9 +1473,9 @@ The item must be empty." ;; go back to original position. (if (eq last-command 'org-cycle-item-indentation) (cond - ((ignore-errors (org-indent-item -1))) + ((ignore-errors (org-outdent-item))) ((and (= (org-get-indentation) (car org-tab-ind-state)) - (ignore-errors (org-indent-item 1)))) + (ignore-errors (org-indent-item)))) (t (back-to-indentation) (indent-to-column (car org-tab-ind-state)) (end-of-line) @@ -1480,8 +1487,8 @@ The item must be empty." (setq org-tab-ind-state (cons (org-get-indentation) (org-get-bullet))) (cond - ((ignore-errors (org-indent-item 1))) - ((ignore-errors (org-indent-item -1))) + ((ignore-errors (org-indent-item))) + ((ignore-errors (org-outdent-item))) (t (error "Cannot move item")))) t))) From df33ccb95658ca7962dab640664e619fad36f219 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 22 Aug 2010 02:48:05 +0200 Subject: [PATCH 235/348] Do not drag outside items when moving whole list multiple times. --- lisp/org-list.el | 138 +++++++++++++++++++++++++---------------------- 1 file changed, 73 insertions(+), 65 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b3fe88594..628b7f5c6 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -687,71 +687,79 @@ NO-SUBTREE is non-nil, only indent the item itself, not its children. Return t if successful." - (interactive) - (unless (org-at-item-p) - (error "Not on an item")) - ;; Determine begin and end points of zone to indent. If moving by - ;; subtrees, ensure we don't drag additional items on subsequent - ;; moves. - (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (if (org-region-active-p) - (progn - (set-marker org-last-indent-begin-marker (region-beginning)) - (set-marker org-last-indent-end-marker (region-end))) - (set-marker org-last-indent-begin-marker - (save-excursion (org-beginning-of-item))) - (set-marker org-last-indent-end-marker - (save-excursion - (if no-subtree - (org-end-of-item-or-at-child) - (org-end-of-item)))))) - ;; Get everything ready - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker)) - (struct (org-list-struct beg end (< arg 0))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct)) - (end-item (save-excursion - (goto-char end) - (skip-chars-backward " \r\t\n") - (org-beginning-of-item) - (org-list-struct-assoc-at-point))) - (top (org-list-top-point))) - (cond - ;; Special case: moving top-item with indent rule - ((and (= top beg) - (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree)) - (let* ((level-skip (org-level-increment)) - (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (nth 1 beg-item))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) - (org-list-bullet-string "-")))) - ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) - (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct)))) - ;; Forbidden move - ((and (< arg 0) - (or (and no-subtree - (not (org-region-active-p)) - (org-list-struct-get-child beg-item struct)) - (org-list-struct-get-child end-item struct))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((shifted-ori (if (< arg 0) - (org-list-struct-outdent beg end origins) - (org-list-struct-indent beg end origins struct)))) - (org-list-struct-fix-struct struct shifted-ori) - (org-list-struct-apply-struct struct))))) + (save-restriction + (unless (or (org-at-item-p) + (and (org-region-active-p) + (goto-char region-beginning) + (org-at-item-p))) + (error "Not on an item")) + ;; Are we going to move the whole list? + (let ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= (org-list-top-point) (point-at-bol))))) + ;; Determine begin and end points of zone to indent. If moving by + ;; subtrees, ensure we don't drag additional items on subsequent + ;; moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if (org-region-active-p) + (progn + (set-marker org-last-indent-begin-marker (region-beginning)) + (set-marker org-last-indent-end-marker (region-end))) + (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-end-marker + (save-excursion + (cond + (specialp + (org-list-bottom-point)) + (no-subtree + (org-end-of-item-or-at-child)) + (t (org-end-of-item))))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (progn + (when specialp (narrow-to-region beg end)) + (org-list-struct beg end (< arg 0)))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct))) + (cond + ;; Special case: moving top-item with indent rule + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) + ;; Shift ancestor + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) + (org-list-struct-apply-struct struct)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not (org-region-active-p)) + (org-list-struct-get-child beg-item struct)) + (let ((last-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (org-beginning-of-item) + (org-list-struct-assoc-at-point)))) + (org-list-struct-get-child last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins struct)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct))))))) ;; Return value t) From ebf5e1236b09a8ee61804a80259757c2466534f7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 22 Aug 2010 19:19:00 +0200 Subject: [PATCH 236/348] Fix bug when buffer is starting with a list. * org-list.el (org-list-in-item-p-with-indent): Test if first line is the item beginning. * org-list.el (org-list-top-point-with-indent): Test if first line is a valid list beginning. --- lisp/org-list.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 628b7f5c6..aee456548 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -393,9 +393,13 @@ Return the position of the previous item, if applicable." (catch 'exit (while t (cond - ((or (= (point) limit) - (looking-at "^[ \t]*:END:")) + ((looking-at "^[ \t]*:END:") (throw 'exit nil)) + ((<= (point) limit) + (throw 'exit + (and (org-at-item-p) + (< (org-get-indentation) ind-ref) + (point-at-bol)))) ((looking-at "^[ \t]*$") (skip-chars-backward " \r\t\n") (beginning-of-line)) @@ -481,9 +485,13 @@ List ending is determined by indentation of text. See (while t (let ((ind (org-get-indentation))) (cond - ((or (<= (point) limit) - (looking-at "^[ \t]*:END:")) + ((looking-at "^[ \t]*:END:") (throw 'exit item-ref)) + ((<= (point) limit) + (throw 'exit + (if (and (org-at-item-p) (< ind ind-ref)) + (point-at-bol) + item-ref))) ((looking-at "^[ \t]*$") (skip-chars-backward " \r\t\n") (beginning-of-line)) From 86228b817c701b58c2717873e9b44d71f6db5808 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 22 Aug 2010 19:34:46 +0200 Subject: [PATCH 237/348] Changed default value of `org-list-ending-method' * org-list.el (org-list-ending-method): default value is now `both', to ensure maximum compatibility before previous implementation. --- lisp/org-list.el | 48 ++++++++++++++++++++++++------------------------ 1 file changed, 24 insertions(+), 24 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index aee456548..807e7c136 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -149,7 +149,7 @@ spaces instead of one after the bullet in each item of the list." (const :tag "never" nil) (regexp))) -(defcustom org-list-ending-method 'regexp +(defcustom org-list-ending-method 'both "Determine where plain lists should end. Valid values are: `regexp', `indent' or `both'. @@ -157,14 +157,14 @@ Valid values are: `regexp', `indent' or `both'. When set to `regexp', Org will look into two variables, `org-empty-line-terminates-plain-lists' and the more general `org-list-end-regexp', to know what will end lists. This is the -default value. +fastest method. -When set to `indent', indentation of the last non-blank line will -determine if point is in a list. If that line is less indented -than the previous item in the section, if any, list has ended. +When set to `indent', a list will end whenever a line following +an item, but not starting one, is less or equally indented than +it. When set to `both', each of the preceding methods must confirm -that point is in a list." +that point is in a list. This is the default method." :group 'org-plain-lists :type '(choice (const :tag "With a well defined ending (recommended)" regexp) @@ -785,12 +785,12 @@ This checks `org-list-ending-method'." prev-head) (point-min)))) (cond + ((eq org-list-ending-method 'regexp) + (org-list-in-item-p-with-regexp bound)) ((eq org-list-ending-method 'indent) (org-list-in-item-p-with-indent bound)) - ((eq org-list-ending-method 'both) - (and (org-list-in-item-p-with-regexp bound) - (org-list-in-item-p-with-indent bound))) - (t (org-list-in-item-p-with-regexp bound)))))) + (t (and (org-list-in-item-p-with-regexp bound) + (org-list-in-item-p-with-indent bound))))))) (defun org-list-first-item-p () "Is this item the first item in a plain list? @@ -860,15 +860,15 @@ A checkbox is blocked if all of the following conditions are fulfilled: prev-head) (point-min)))) (cond + ((eq org-list-ending-method 'regexp) + (org-list-top-point-with-regexp bound)) ((eq org-list-ending-method 'indent) (org-list-top-point-with-indent bound)) - ((eq org-list-ending-method 'both) - (let ((top-re (org-list-top-point-with-regexp bound)) - (top-ind (org-list-top-point-with-indent bound))) - (if (and top-re top-ind) - (max top-re top-ind) - (or top-re top-ind)))) - (t (org-list-top-point-with-regexp bound))))) + (t (let ((top-re (org-list-top-point-with-regexp bound)) + (top-ind (org-list-top-point-with-indent bound))) + (if (and top-re top-ind) + (max top-re top-ind) + (or top-re top-ind))))))) (defun org-list-bottom-point () "Return point just before list ending or nil if not in a list." @@ -885,15 +885,15 @@ A checkbox is blocked if all of the following conditions are fulfilled: next-head (point-max)))) (cond + ((eq org-list-ending-method 'regexp) + (org-list-bottom-point-with-regexp limit)) ((eq org-list-ending-method 'indent) (org-list-bottom-point-with-indent limit)) - ((eq org-list-ending-method 'both) - (let ((bottom-re (org-list-bottom-point-with-regexp limit)) - (bottom-ind (org-list-bottom-point-with-indent limit))) - (if (and bottom-re bottom-ind) - (min bottom-re bottom-ind) - (or bottom-re bottom-ind)))) - (t (org-list-bottom-point-with-regexp limit))))) + (t (let ((bottom-re (org-list-bottom-point-with-regexp limit)) + (bottom-ind (org-list-bottom-point-with-indent limit))) + (if (and bottom-re bottom-ind) + (min bottom-re bottom-ind) + (or bottom-re bottom-ind))))))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. From 5dee2ec3511d6bf84758174276f82c3597cf72e9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 22 Aug 2010 20:01:33 +0200 Subject: [PATCH 238/348] Fix code typo. --- lisp/org-list.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 807e7c136..1956a42c1 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -690,15 +690,17 @@ function ends." When number ARG is a negative, item will be outdented, otherwise it will be indented. -If a region is active, all items in it will be moved. If -NO-SUBTREE is non-nil, only indent the item itself, not its +If a region is active and its first line is an item beginning, +all items inside will be moved. + +If NO-SUBTREE is non-nil, only indent the item itself, not its children. Return t if successful." (save-restriction (unless (or (org-at-item-p) (and (org-region-active-p) - (goto-char region-beginning) + (goto-char (region-beginning)) (org-at-item-p))) (error "Not on an item")) ;; Are we going to move the whole list? From 668e5832c20a30dac5b48de0d40d857e881f0595 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 22 Aug 2010 21:48:33 +0200 Subject: [PATCH 239/348] Bug fix: `org-list-struct' would get the last item twice sometimes. --- lisp/org-list.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 1956a42c1..921471c3d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1147,9 +1147,8 @@ change is an outdent." post-list))) ;; Is list is malformed? If some items are less ;; indented that top-item, add them anyhow. - (when (and (= (caar pre-list) 0) (org-at-item-p)) - (setq post-list (cons (org-list-struct-assoc-at-point) - post-list)) + (when (and (= (caar pre-list) 0) (< (point) bottom)) + (beginning-of-line) (while (org-search-forward-unenclosed org-item-beginning-re bottom t) (setq post-list (cons (org-list-struct-assoc-at-point) From 7e6778c16f31fd10bcd3ff19bd92ea2c1775dcd1 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 23 Aug 2010 11:24:57 +0200 Subject: [PATCH 240/348] When indenting a region, first check if there is any item to move. --- lisp/org-list.el | 148 +++++++++++++++++++++++------------------------ 1 file changed, 74 insertions(+), 74 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 921471c3d..93a78b670 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -690,88 +690,88 @@ function ends." When number ARG is a negative, item will be outdented, otherwise it will be indented. -If a region is active and its first line is an item beginning, -all items inside will be moved. +If a region is active, all items inside will be moved. If NO-SUBTREE is non-nil, only indent the item itself, not its children. Return t if successful." (save-restriction - (unless (or (org-at-item-p) - (and (org-region-active-p) - (goto-char (region-beginning)) - (org-at-item-p))) - (error "Not on an item")) - ;; Are we going to move the whole list? - (let ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree) - (= (org-list-top-point) (point-at-bol))))) - ;; Determine begin and end points of zone to indent. If moving by - ;; subtrees, ensure we don't drag additional items on subsequent - ;; moves. - (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (if (org-region-active-p) - (progn - (set-marker org-last-indent-begin-marker (region-beginning)) - (set-marker org-last-indent-end-marker (region-end))) - (set-marker org-last-indent-begin-marker (point-at-bol)) - (set-marker org-last-indent-end-marker - (save-excursion - (cond - (specialp - (org-list-bottom-point)) - (no-subtree - (org-end-of-item-or-at-child)) - (t (org-end-of-item))))))) - ;; Get everything ready - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker)) - (struct (progn - (when specialp (narrow-to-region beg end)) - (org-list-struct beg end (< arg 0)))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct))) + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end)))) (cond - ;; Special case: moving top-item with indent rule - (specialp - (let* ((level-skip (org-level-increment)) - (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (nth 1 beg-item))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) - (org-list-bullet-string "-")))) - ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) - (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct)))) - ;; Forbidden move - ((and (< arg 0) - (or (and no-subtree - (not (org-region-active-p)) - (org-list-struct-get-child beg-item struct)) - (let ((last-item (save-excursion - (goto-char end) - (skip-chars-backward " \r\t\n") - (org-beginning-of-item) - (org-list-struct-assoc-at-point)))) - (org-list-struct-get-child last-item struct)))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting + ((and regionp + (goto-char rbeg) + (not (org-search-forward-unenclosed org-item-beginning-re rend t))) + (error "No item in region")) + ((not (org-at-item-p)) + (error "Not on an item")) (t - (let* ((shifted-ori (if (< arg 0) - (org-list-struct-outdent beg end origins) - (org-list-struct-indent beg end origins struct)))) - (org-list-struct-fix-struct struct shifted-ori) - (org-list-struct-apply-struct struct))))))) - ;; Return value - t) + ;; Are we going to move the whole list? + (let ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= (org-list-top-point) (point-at-bol))))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, ensure we keep them on subsequent moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if regionp + (progn + (set-marker org-last-indent-begin-marker rbeg) + (set-marker org-last-indent-end-marker rend)) + (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-end-marker + (save-excursion + (cond + (specialp (org-list-bottom-point)) + (no-subtree (org-end-of-item-or-at-child)) + (t (org-end-of-item))))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (progn + (when specialp (narrow-to-region beg end)) + (org-list-struct beg end (< arg 0)))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct))) + (cond + ;; Special case: moving top-item with indent rule + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) + ;; Shift ancestor + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) + (org-list-struct-apply-struct struct)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not regionp) + (org-list-struct-get-child beg-item struct)) + (let ((last-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (org-beginning-of-item) + (org-list-struct-assoc-at-point)))) + (org-list-struct-get-child last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins struct)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct))))))))))) ;;; Predicates From 5de49d203273b0923925bf445bbaba8ae87450d2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 23 Aug 2010 11:47:52 +0200 Subject: [PATCH 241/348] Optimize list indentation. * org-list.el (org-list-struct): accept list boundaries as an argument in order to avoid computing `org-list-top-point' and `org-list-bottom-point' twice when indenting. --- lisp/org-list.el | 162 ++++++++++++++++++++++++----------------------- 1 file changed, 82 insertions(+), 80 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 93a78b670..9543680e4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -696,82 +696,80 @@ If NO-SUBTREE is non-nil, only indent the item itself, not its children. Return t if successful." - (save-restriction - (let* ((regionp (org-region-active-p)) - (rbeg (and regionp (region-beginning))) - (rend (and regionp (region-end)))) - (cond - ((and regionp - (goto-char rbeg) - (not (org-search-forward-unenclosed org-item-beginning-re rend t))) - (error "No item in region")) - ((not (org-at-item-p)) - (error "Not on an item")) - (t - ;; Are we going to move the whole list? - (let ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree) - (= (org-list-top-point) (point-at-bol))))) - ;; Determine begin and end points of zone to indent. If moving - ;; more than one item, ensure we keep them on subsequent moves. - (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (if regionp - (progn - (set-marker org-last-indent-begin-marker rbeg) - (set-marker org-last-indent-end-marker rend)) - (set-marker org-last-indent-begin-marker (point-at-bol)) - (set-marker org-last-indent-end-marker - (save-excursion - (cond - (specialp (org-list-bottom-point)) - (no-subtree (org-end-of-item-or-at-child)) - (t (org-end-of-item))))))) - ;; Get everything ready - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker)) - (struct (progn - (when specialp (narrow-to-region beg end)) - (org-list-struct beg end (< arg 0)))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct))) - (cond - ;; Special case: moving top-item with indent rule - (specialp - (let* ((level-skip (org-level-increment)) - (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (nth 1 beg-item))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" (nth 2 beg-item))) - (setcdr beg-item (list (nth 1 beg-item) - (org-list-bullet-string "-")))) - ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) - (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct)))) - ;; Forbidden move - ((and (< arg 0) - (or (and no-subtree - (not regionp) - (org-list-struct-get-child beg-item struct)) - (let ((last-item (save-excursion - (goto-char end) - (skip-chars-backward " \r\t\n") - (org-beginning-of-item) - (org-list-struct-assoc-at-point)))) - (org-list-struct-get-child last-item struct)))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((shifted-ori (if (< arg 0) - (org-list-struct-outdent beg end origins) - (org-list-struct-indent beg end origins struct)))) - (org-list-struct-fix-struct struct shifted-ori) - (org-list-struct-apply-struct struct))))))))))) + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end)))) + (cond + ((and regionp + (goto-char rbeg) + (not (org-search-forward-unenclosed org-item-beginning-re rend t))) + (error "No item in region")) + ((not (org-at-item-p)) + (error "Not on an item")) + (t + ;; Are we going to move the whole list? + (let* ((top (org-list-top-point)) + (specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= top (point-at-bol))))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, ensure we keep them on subsequent moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if regionp + (progn + (set-marker org-last-indent-begin-marker rbeg) + (set-marker org-last-indent-end-marker rend)) + (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-end-marker + (save-excursion + (cond + (specialp (org-list-bottom-point)) + (no-subtree (org-end-of-item-or-at-child)) + (t (org-end-of-item))))))) + ;; Get everything ready + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker)) + (struct (org-list-struct beg end (< arg 0) top (if specialp end))) + (origins (org-list-struct-origins struct)) + (beg-item (assq beg struct))) + (cond + ;; Special case: moving top-item with indent rule + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (nth 1 beg-item))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" (nth 2 beg-item))) + (setcdr beg-item (list (nth 1 beg-item) + (org-list-bullet-string "-")))) + ;; Shift ancestor + (let ((anc (car struct))) + (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (org-list-struct-fix-struct struct origins) + (org-list-struct-apply-struct struct)))) + ;; Forbidden move + ((and (< arg 0) + (or (and no-subtree + (not regionp) + (org-list-struct-get-child beg-item struct)) + (let ((last-item (save-excursion + (goto-char end) + (skip-chars-backward " \r\t\n") + (org-beginning-of-item) + (org-list-struct-assoc-at-point)))) + (org-list-struct-get-child last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((shifted-ori (if (< arg 0) + (org-list-struct-outdent beg end origins) + (org-list-struct-indent beg end origins struct)))) + (org-list-struct-fix-struct struct shifted-ori) + (org-list-struct-apply-struct struct)))))))))) ;;; Predicates @@ -1101,7 +1099,7 @@ bullet string and bullet counter, if any." (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") (match-string 1)))))) -(defun org-list-struct (begin end &optional outdent) +(defun org-list-struct (begin end &optional outdent limit-up limit-down) "Return the structure containing the list between BEGIN and END. A structure is an alist where key is point of item and values @@ -1113,10 +1111,14 @@ ancestor at position 0. If OUTDENT is non-nil, it will also grab all of the parent list and the grand-parent. Setting OUTDENT to t is mandatory when next -change is an outdent." +change is an outdent. + +Numbers LIMIT-UP and LIMIT-DOWN are the maximal positions the +structure can extend to. They default respectively to list's top +point and bottom point." (save-excursion - (let* ((top (org-list-top-point)) - (bottom (org-list-bottom-point)) + (let* ((top (or limit-up (org-list-top-point))) + (bottom (or limit-down (org-list-bottom-point))) struct (extend (lambda (struct) From 595ce4e7f86f3b0635a1a78870c76417cec74319 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 23 Aug 2010 11:53:08 +0200 Subject: [PATCH 242/348] Minor fix. --- lisp/org-list.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 9543680e4..99b2d9909 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1995,13 +1995,11 @@ sublevels as a list of strings." (interactive) (if (not (org-in-item-p)) (error "Not in a list") - (goto-char (org-list-top-point)) (let ((list (org-list-parse-list t)) nstars) (save-excursion (if (ignore-errors (org-back-to-heading)) - (progn (org-search-forward-unenclosed - org-complex-heading-regexp nil t) + (progn (looking-at org-complex-heading-regexp) (setq nstars (length (match-string 1)))) (setq nstars 0))) (org-list-make-subtrees list (1+ nstars))))) From 7a46718ec60560d84ff9884c25d6a0e1a7b9ab21 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 23 Aug 2010 13:06:04 +0200 Subject: [PATCH 243/348] Optimize search of top and bottom points when ending method is `both' --- lisp/org-list.el | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 99b2d9909..8d1bad90d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -864,11 +864,8 @@ A checkbox is blocked if all of the following conditions are fulfilled: (org-list-top-point-with-regexp bound)) ((eq org-list-ending-method 'indent) (org-list-top-point-with-indent bound)) - (t (let ((top-re (org-list-top-point-with-regexp bound)) - (top-ind (org-list-top-point-with-indent bound))) - (if (and top-re top-ind) - (max top-re top-ind) - (or top-re top-ind))))))) + (t (let ((top-re (org-list-top-point-with-regexp bound))) + (org-list-top-point-with-indent (or top-re bound))))))) (defun org-list-bottom-point () "Return point just before list ending or nil if not in a list." @@ -889,11 +886,8 @@ A checkbox is blocked if all of the following conditions are fulfilled: (org-list-bottom-point-with-regexp limit)) ((eq org-list-ending-method 'indent) (org-list-bottom-point-with-indent limit)) - (t (let ((bottom-re (org-list-bottom-point-with-regexp limit)) - (bottom-ind (org-list-bottom-point-with-indent limit))) - (if (and bottom-re bottom-ind) - (min bottom-re bottom-ind) - (or bottom-re bottom-ind))))))) + (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) + (org-list-bottom-point-with-indent (or bottom-re limit))))))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. From e2dc3cd985bcdb2a315f1978265190ce89736979 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 23 Aug 2010 13:32:00 +0200 Subject: [PATCH 244/348] Small modification to `org-list-ending-method' docstring. --- lisp/org-list.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8d1bad90d..102cf8f2e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -156,19 +156,19 @@ Valid values are: `regexp', `indent' or `both'. When set to `regexp', Org will look into two variables, `org-empty-line-terminates-plain-lists' and the more general -`org-list-end-regexp', to know what will end lists. This is the -fastest method. +`org-list-end-regexp', to determine what will end lists. This is +the fastest method. When set to `indent', a list will end whenever a line following an item, but not starting one, is less or equally indented than it. -When set to `both', each of the preceding methods must confirm -that point is in a list. This is the default method." +When set to `both', each of the preceding methods is applied to +determine lists endings. This is the default method." :group 'org-plain-lists :type '(choice - (const :tag "With a well defined ending (recommended)" regexp) - (const :tag "With indentation of the current line" indent) + (const :tag "With a regexp defining ending" regexp) + (const :tag "With indentation of regular (no bullet) text" indent) (const :tag "With both methods" both))) (defcustom org-empty-line-terminates-plain-lists nil From 0932dac73dee1d296c15b6245101e205a51d8860 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Wed, 25 Aug 2010 15:45:05 +0200 Subject: [PATCH 245/348] Fix `org-list-bottom-point' when point is after end of list. --- lisp/org-list.el | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 102cf8f2e..83ee5906a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -873,21 +873,24 @@ A checkbox is blocked if all of the following conditions are fulfilled: (and (let ((outline-regexp org-outline-regexp)) ;; Use default regexp because folding ;; changes OUTLINE-REGEXP. - (outline-next-heading)) - (skip-chars-backward " \r\t\n") - (1+ (point-at-eol))))) + (outline-next-heading))))) (limit (or (save-excursion (and (re-search-forward "^[ \t]*:END:" next-head t) (point-at-bol))) next-head - (point-max)))) - (cond - ((eq org-list-ending-method 'regexp) - (org-list-bottom-point-with-regexp limit)) - ((eq org-list-ending-method 'indent) - (org-list-bottom-point-with-indent limit)) - (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) - (org-list-bottom-point-with-indent (or bottom-re limit))))))) + (point-max))) + (bottom (cond + ((eq org-list-ending-method 'regexp) + (org-list-bottom-point-with-regexp limit)) + ((eq org-list-ending-method 'indent) + (org-list-bottom-point-with-indent limit)) + (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) + (org-list-bottom-point-with-indent (or bottom-re limit))))))) + (when bottom + (save-excursion + (goto-char bottom) + (skip-chars-backward " \r\t\n") + (1+ (point-at-eol)))))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. From bfce8dd35724a4f4f4082901db67e9409bd34025 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 27 Aug 2010 11:05:58 +0200 Subject: [PATCH 246/348] Do not crash when trying to export an ill-formed list in HTML and DocBook. --- lisp/org-docbook.el | 5 ++++- lisp/org-html.el | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 741465ef5..d4668cbca 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1059,7 +1059,10 @@ publishing directory." (setq in-local-list t)) ;; Continue current list (starter - ;; terminate any previous sublist + ;; terminate any previous sublist but first ensure + ;; list is not ill-formed + (let ((min-ind (apply 'min local-list-indent))) + (when (< ind min-ind) (setq ind min-ind))) (while (< ind (car local-list-indent)) (let ((listtype (car local-list-type))) (org-export-docbook-close-li listtype) diff --git a/lisp/org-html.el b/lisp/org-html.el index e9fcc4f53..23b2729cd 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1573,7 +1573,10 @@ lang=\"%s\" xml:lang=\"%s\"> (setq in-local-list t)) ;; Continue list (starter - ;; terminate any previous sublist + ;; terminate any previous sublist but first ensure + ;; list is not ill-formed. + (let ((min-ind (apply 'min local-list-indent))) + (when (< ind min-ind) (setq ind min-ind))) (while (< ind (car local-list-indent)) (org-close-li (car local-list-type)) (insert (format "</%sl>\n" (car local-list-type))) From 421ba3a1872b0e5952a4a68e2220dc3e07ab6dd2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 27 Aug 2010 11:48:51 +0200 Subject: [PATCH 247/348] Correctly get bullet when point is not at bol. --- lisp/org-list.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 83ee5906a..99dc41929 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1513,7 +1513,9 @@ The item must be empty." (defun org-get-bullet () "Return the bullet of the item at point. Assume cursor is at an item." - (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))) + (save-excursion + (beginning-of-line) + (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))) (defun org-list-bullet-string (bullet) "Return BULLET with the correct number of whitespaces. From d05c77d6a5150207b061bea82b39b85de2b020b6 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Fri, 27 Aug 2010 16:12:44 +0200 Subject: [PATCH 248/348] Fix infinite loop when buffer was ending on a blank lines with whitespaces. --- lisp/org-list.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 99dc41929..8a927db7f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -525,21 +525,22 @@ List ending is determined by the indentation of text. See (beginning-of-line) (and beg-item (catch 'exit + (skip-chars-forward " \t") (while t (let ((ind (org-get-indentation))) (cond ((or (>= (point) limit) - (looking-at "^[ \t]*:END:")) + (looking-at ":END:")) (throw 'exit (point))) - ((looking-at "^[ \t]*$") + ((= (point) (point-at-eol)) (skip-chars-forward " \r\t\n") (beginning-of-line)) - ((looking-at org-item-beginning-re) + ((org-at-item-p) (setq ind-ref (min ind ind-ref)) (forward-line 1)) ((<= ind ind-ref) (throw 'exit (point-at-bol))) - ((looking-at "^[ \t]*#\\+begin_") + ((looking-at "#\\+begin_") (re-search-forward "[ \t]*#\\+end_") (forward-line 1)) (t (forward-line 1)))))))))) @@ -889,8 +890,10 @@ A checkbox is blocked if all of the following conditions are fulfilled: (when bottom (save-excursion (goto-char bottom) - (skip-chars-backward " \r\t\n") - (1+ (point-at-eol)))))) + (if (eobp) + (point) + (skip-chars-backward " \r\t\n") + (1+ (point-at-eol))))))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. From 8e5729c466f4f673519b116152518a9bad5154cf Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 28 Aug 2010 12:53:19 +0200 Subject: [PATCH 249/348] Speed optimizations and docstring modifications. --- lisp/org-html.el | 8 - lisp/org-list.el | 803 ++++++++++++++++++++++++++--------------------- 2 files changed, 438 insertions(+), 373 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 23b2729cd..df55de02f 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1495,14 +1495,6 @@ lang=\"%s\" xml:lang=\"%s\"> (setq txt (replace-match "" t t txt))) (if (<= level (max umax umax-toc)) (setq head-count (+ head-count 1))) - (when in-local-list - ;; Close any local lists before inserting a new header line - (while local-list-type - (org-close-li (car local-list-type)) - (insert (format "</%sl>\n" (car local-list-type))) - (pop local-list-type)) - (setq local-list-indent nil - in-local-list nil)) (setq first-heading-pos (or first-heading-pos (point))) (org-html-level-start level txt umax (and org-export-with-toc (<= level umax)) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8a927db7f..3adf89158 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -175,7 +175,7 @@ determine lists endings. This is the default method." "Non-nil means an empty line ends all plain list levels. This variable only makes sense if `org-list-ending-method' is set -to regexp or both. This is then equivalent to set +to `regexp' or `both'. This is then equivalent to set `org-list-end-regexp' to \"^[ \\t]*$\"." :group 'org-plain-lists :type 'boolean) @@ -294,8 +294,8 @@ of `org-plain-list-ordered-item-terminator'." (defconst org-item-beginning-re (concat "^" (org-item-re)) "Regexp matching the beginning of a plain list item.") -(defun org-list-terminator-between (min max &optional firstp) - "Find the position of a list ender between MIN and MAX, or nil. +(defun org-list-ending-between (min max &optional firstp) + "Find the position of a list ending between MIN and MAX, or nil. This function looks for `org-list-end-re' outside a block. If FIRSTP in non-nil, return the point at the beginning of the @@ -310,7 +310,7 @@ the end of the nearest terminator from MAX." (list-end-p (progn (goto-char start) (funcall search-fun (org-list-end-re) end t)))) - ;; Is there a valid list terminator somewhere ? + ;; Is there a valid list ending somewhere ? (and list-end-p ;; we want to be on the first line of the list ender (match-beginning 0))))) @@ -368,10 +368,9 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in "Is the cursor inside a plain list? Plain lists are considered ending when a non-blank line is less -indented than the previous item within LIMIT. - -Return the position of the previous item, if applicable." +indented than the previous item within LIMIT." (save-excursion + (beginning-of-line) (cond ;; do not start searching inside a block... ((org-list-maybe-skip-block #'re-search-backward limit)) @@ -380,35 +379,24 @@ Return the position of the previous item, if applicable." (skip-chars-backward " \r\t\n") (beginning-of-line))) (beginning-of-line) - (or (and (org-at-item-p) (point-at-bol)) + (or (org-at-item-p) (let* ((case-fold-search t) - (pos (point)) (ind-ref (org-get-indentation)) - ;; Is there an item above? + ;; Ensure there is at least an item above (up-item-p (save-excursion - (goto-char limit) - (org-search-forward-unenclosed - org-item-beginning-re pos t)))) + (org-search-backward-unenclosed + org-item-beginning-re limit t)))) (and up-item-p (catch 'exit (while t (cond - ((looking-at "^[ \t]*:END:") - (throw 'exit nil)) - ((<= (point) limit) - (throw 'exit - (and (org-at-item-p) - (< (org-get-indentation) ind-ref) - (point-at-bol)))) + ((org-at-item-p) + (throw 'exit (< (org-get-indentation) ind-ref))) ((looking-at "^[ \t]*$") (skip-chars-backward " \r\t\n") (beginning-of-line)) ((looking-at "^[ \t]*#\\+end_") (re-search-backward "^[ \t]*#\\+begin_")) - ((looking-at org-item-beginning-re) - (if (< (org-get-indentation) ind-ref) - (throw 'exit (point-at-bol)) - (forward-line -1))) (t (setq ind-ref (min (org-get-indentation) ind-ref)) (forward-line -1)))))))))) @@ -427,84 +415,79 @@ Argument LIMIT specifies the upper-bound of the search." (last-item-start (save-excursion (org-search-backward-unenclosed org-item-beginning-re limit t))) - (list-ender (org-list-terminator-between + (list-ender (org-list-ending-between last-item-start actual-pos))) ;; We are in a list when we are on an item line or when we can ;; find an item before point and there is no valid list ender ;; between it and the point. - (and last-item-start - (not list-ender))))) + (and last-item-start (not list-ender))))) (defun org-list-top-point-with-regexp (limit) - "Return point at the top level item in a list, or nil if not in a list. + "Return point at the top level item in a list. Argument LIMIT specifies the upper-bound of the search. List ending is determined by regexp. See `org-list-ending-method'. for more information." (save-excursion - (and (org-list-in-item-p-with-regexp limit) - (let ((pos (point-at-eol))) - ;; Is there some list above this one ? If so, go to its ending. - ;; Otherwise, go back to the heading above or bob. - (goto-char (or (org-list-terminator-between limit pos) limit)) - ;; From there, search down our list. - (org-search-forward-unenclosed org-item-beginning-re pos t) - (point-at-bol))))) + (let ((pos (point-at-eol))) + ;; Is there some list above this one ? If so, go to its ending. + ;; Otherwise, go back to the heading above or bob. + (goto-char (or (org-list-ending-between limit pos) limit)) + ;; From there, search down our list. + (org-search-forward-unenclosed org-item-beginning-re pos t) + (point-at-bol)))) (defun org-list-bottom-point-with-regexp (limit) - "Return point just before list ending or nil if not in a list. + "Return point just before list ending. Argument LIMIT specifies the lower-bound of the search. List ending is determined by regexp. See `org-list-ending-method'. for more information." (save-excursion - (and (org-in-item-p) - (let ((pos (point))) - ;; The list ending is either first point matching - ;; `org-list-end-re', point at first white-line before next - ;; heading, or eob. - (or (org-list-terminator-between (min pos limit) limit t) limit))))) + (let ((pos (org-get-item-beginning))) + ;; The list ending is either first point matching + ;; `org-list-end-re', point at first white-line before next + ;; heading, or eob. + (or (org-list-ending-between (min pos limit) limit t) limit)))) (defun org-list-top-point-with-indent (limit) - "Return point at the top level in a list, or nil if not in a list. + "Return point at the top level in a list. Argument LIMIT specifies the upper-bound of the search. List ending is determined by indentation of text. See `org-list-ending-method'. for more information." (save-excursion - (let ((prev-p (org-list-in-item-p-with-indent limit)) - (case-fold-search t)) - (and prev-p - (let ((item-ref (goto-char prev-p)) - (ind-ref 10000)) - (forward-line -1) - (catch 'exit - (while t - (let ((ind (org-get-indentation))) - (cond - ((looking-at "^[ \t]*:END:") - (throw 'exit item-ref)) - ((<= (point) limit) - (throw 'exit - (if (and (org-at-item-p) (< ind ind-ref)) - (point-at-bol) - item-ref))) - ((looking-at "^[ \t]*$") - (skip-chars-backward " \r\t\n") - (beginning-of-line)) - ((looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_")) - ((not (looking-at org-item-beginning-re)) - (setq ind-ref (min ind ind-ref)) - (forward-line -1)) - ((>= ind ind-ref) - (throw 'exit item-ref)) - (t - (setq item-ref (point-at-bol) ind-ref 10000) - (forward-line -1))))))))))) + (let ((case-fold-search t)) + (let ((item-ref (goto-char (org-get-item-beginning))) + (ind-ref 10000)) + (forward-line -1) + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((looking-at "^[ \t]*:END:") + (throw 'exit item-ref)) + ((<= (point) limit) + (throw 'exit + (if (and (org-at-item-p) (< ind ind-ref)) + (point-at-bol) + item-ref))) + ((looking-at "^[ \t]*$") + (skip-chars-backward " \r\t\n") + (beginning-of-line)) + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_")) + ((not (org-at-item-p)) + (setq ind-ref (min ind ind-ref)) + (forward-line -1)) + ((>= ind ind-ref) + (throw 'exit item-ref)) + (t + (setq item-ref (point-at-bol) ind-ref 10000) + (forward-line -1)))))))))) (defun org-list-bottom-point-with-indent (limit) "Return point just before list ending or nil if not in a list. @@ -514,36 +497,37 @@ Argument LIMIT specifies the lower-bound of the search. List ending is determined by the indentation of text. See `org-list-ending-method' for more information." (save-excursion - (let* ((beg-item (org-in-item-p)) - (ind-ref (save-excursion - (when beg-item - (goto-char beg-item) - (org-get-indentation)))) - (case-fold-search t)) + (let ((ind-ref (progn + (goto-char (org-get-item-beginning)) + (org-get-indentation))) + (case-fold-search t)) ;; do not start inside a block (org-list-maybe-skip-block #'re-search-forward limit) (beginning-of-line) - (and beg-item - (catch 'exit - (skip-chars-forward " \t") - (while t - (let ((ind (org-get-indentation))) - (cond - ((or (>= (point) limit) - (looking-at ":END:")) - (throw 'exit (point))) - ((= (point) (point-at-eol)) - (skip-chars-forward " \r\t\n") - (beginning-of-line)) - ((org-at-item-p) - (setq ind-ref (min ind ind-ref)) - (forward-line 1)) - ((<= ind ind-ref) - (throw 'exit (point-at-bol))) - ((looking-at "#\\+begin_") - (re-search-forward "[ \t]*#\\+end_") - (forward-line 1)) - (t (forward-line 1)))))))))) + (catch 'exit + (skip-chars-forward " \t") + (while t + (let ((ind (org-get-indentation))) + (cond + ((or (>= (point) limit) + (looking-at ":END:")) + (throw 'exit (progn + ;; Ensure bottom is just after a + ;; non-blank line. + (skip-chars-backward " \r\t\n") + (min (point-max) (1+ (point-at-eol)))))) + ((= (point) (point-at-eol)) + (skip-chars-forward " \r\t\n") + (beginning-of-line)) + ((org-at-item-p) + (setq ind-ref (min ind ind-ref)) + (forward-line 1)) + ((<= ind ind-ref) + (throw 'exit (point-at-bol))) + ((looking-at "#\\+begin_") + (re-search-forward "[ \t]*#\\+end_") + (forward-line 1)) + (t (forward-line 1))))))))) (defun org-list-at-regexp-after-bullet-p (regexp) "Is point at a list item with REGEXP after bullet?" @@ -561,10 +545,8 @@ Search items using function SEARCH-FUN, from POS to LIMIT. It uses PRE-MOVE before search. Return nil if no item was found." (save-excursion (goto-char pos) - (let ((ind (progn - (org-beginning-of-item) - (org-get-indentation))) - (start (point-at-bol))) + (let* ((start (org-get-item-beginning)) + (ind (progn (goto-char start) (org-get-indentation)))) ;; We don't want to match the current line. (funcall pre-move) ;; Skip any sublist on the way @@ -574,6 +556,49 @@ uses PRE-MOVE before search. Return nil if no item was found." (= (org-get-indentation) ind)) (point-at-bol))))) +(defun org-list-separating-blank-lines-number (top bottom) + "Return number of blank lines that should separate items in list. + +TOP and BOTTOM are respectively position of list beginning and +list ending. + +Assume point is at item's beginning. If the item is alone, apply +some heuristics to guess the result." + (save-excursion + (let ((insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + usr-blank) + (cond + ;; Trivial cases where there should be none. + ((or (and (not (eq org-list-ending-method 'indent)) + org-empty-line-terminates-plain-lists) + (not insert-blank-p)) 0) + ;; When `org-blank-before-new-entry' says so, it is 1. + ((eq insert-blank-p t) 1) + ;; plain-list-item is 'auto. Count blank lines separating + ;; neighbours items in list. + (t (let ((next-p (org-get-next-item (point) bottom))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((org-get-previous-item (point) top) + (org-back-over-empty-lines)) + ;; User inserted blank lines, trust him + ((and (> true-pos (org-end-of-item-before-blank bottom)) + (> (save-excursion + (goto-char true-pos) + (skip-chars-backward " \t") + (setq usr-blank (org-back-over-empty-lines))) 0)) + usr-blank) + ;; Are there blank lines inside the item ? + ((save-excursion + (org-search-forward-unenclosed + "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1) + ;; No parent: no blank line. + (t 0)))))))) + (defun org-list-insert-item-generic (pos &optional checkbox after-bullet) "Insert a new list item at POS. @@ -596,7 +621,9 @@ function ends." (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) (end-of-line 0))) (let* ((true-pos (point)) - (bullet (and (org-beginning-of-item) + (top (org-list-top-point)) + (bottom (copy-marker (org-list-bottom-point))) + (bullet (and (goto-char (org-get-item-beginning)) (org-list-bullet-string (org-get-bullet)))) (ind (org-get-indentation)) (before-p (progn @@ -607,60 +634,33 @@ function ends." ;; Otherwise, text starts after bullet. (org-at-item-p)) (<= true-pos (match-end 0)))) - ;; Guess number of blank lines used to separate items. - (blank-lines-nb - (let ((insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry))) - usr-blank) - (cond - ;; Trivial cases where there should be none. - ((or (and (not (eq org-list-ending-method 'indent)) - org-empty-line-terminates-plain-lists) - (not insert-blank-p)) 0) - ;; When `org-blank-before-new-entry' says so, it is 1. - ((eq insert-blank-p t) 1) - ;; plain-list-item is 'auto. Count blank lines separating - ;; neighbours items in list. - (t (let ((next-p (org-get-next-item (point) - (org-list-bottom-point)))) - (cond - ;; Is there a next item? - (next-p (goto-char next-p) - (org-back-over-empty-lines)) - ;; Is there a previous item? - ((not (org-list-first-item-p)) (org-back-over-empty-lines)) - ;; User inserted blank lines, trust him - ((and (> true-pos (org-end-of-item-before-blank)) - (> (save-excursion - (goto-char true-pos) - (skip-chars-backward " \t") - (setq usr-blank (org-back-over-empty-lines))) 0)) - usr-blank) - ;; Item alone: count lines separating it from parent, if any - ((/= (org-list-top-point) (point-at-bol)) - (org-back-over-empty-lines)) - ;; Are there blank lines inside the item ? - ((save-excursion - (org-search-forward-unenclosed - "^[ \t]*$" (org-end-of-item-before-blank) t)) 1) - ;; No parent: no blank line. - (t 0))))))) + (blank-lines-nb (org-list-separating-blank-lines-number top bottom)) (insert-fun (lambda (text) ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. - (org-beginning-of-item) + (goto-char (org-get-item-beginning)) (indent-to-column ind) (insert (concat bullet (when checkbox "[ ] ") after-bullet)) ;; Stay between after-bullet and before text. (save-excursion (insert (concat text (make-string (1+ blank-lines-nb) ?\n)))) - (unless before-p (org-move-item-down)) - (when checkbox (org-update-checkbox-count-maybe))))) + (unless before-p + ;; store bottom: exchanging items doesn't change list + ;; bottom point but will modify marker anyway + (setq bottom (marker-position bottom)) + (let ((col (current-column))) + (org-list-exchange-items + (org-get-item-beginning) (org-get-next-item (point) bottom) + bottom) + ;; recompute next-item: last sexp modified list + (goto-char (org-get-next-item (point) bottom)) + (org-move-to-column col))) + (when checkbox (org-update-checkbox-count-maybe)) + (org-list-repair nil top bottom)))) (goto-char true-pos) (cond - (before-p (funcall insert-fun nil) - (org-list-repair) t) + (before-p (funcall insert-fun nil) t) ;; Can't split item: insert bullet at the end of item. ((not (org-get-alist-option org-M-RET-may-split-line 'item)) (funcall insert-fun nil) t) @@ -670,7 +670,7 @@ function ends." (delete-horizontal-space) ;; Get pos again in case previous command modified line. (let* ((pos (point)) - (end-before-blank (org-end-of-item-before-blank)) + (end-before-blank (org-end-of-item-before-blank bottom)) (after-text (when (< pos end-before-blank) (prog1 @@ -685,7 +685,7 @@ function ends." (defvar org-last-indent-begin-marker (make-marker)) (defvar org-last-indent-end-marker (make-marker)) -(defun org-list-indent-item-generic (arg no-subtree) +(defun org-list-indent-item-generic (arg no-subtree top bottom) "Indent a local list item including its children. When number ARG is a negative, item will be outdented, otherwise @@ -696,6 +696,9 @@ If a region is active, all items inside will be moved. If NO-SUBTREE is non-nil, only indent the item itself, not its children. +TOP and BOTTOM are respectively position at item beginning and at +item ending. + Return t if successful." (let* ((regionp (org-region-active-p)) (rbeg (and regionp (region-beginning))) @@ -709,8 +712,7 @@ Return t if successful." (error "Not on an item")) (t ;; Are we going to move the whole list? - (let* ((top (org-list-top-point)) - (specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules)) (not no-subtree) (= top (point-at-bol))))) ;; Determine begin and end points of zone to indent. If moving @@ -725,13 +727,14 @@ Return t if successful." (set-marker org-last-indent-end-marker (save-excursion (cond - (specialp (org-list-bottom-point)) - (no-subtree (org-end-of-item-or-at-child)) - (t (org-end-of-item))))))) + (specialp bottom) + (no-subtree (org-end-of-item-or-at-child bottom)) + (t (org-get-end-of-item bottom))))))) ;; Get everything ready (let* ((beg (marker-position org-last-indent-begin-marker)) (end (marker-position org-last-indent-end-marker)) - (struct (org-list-struct beg end (< arg 0) top (if specialp end))) + (struct (org-list-struct + beg end top (if specialp end bottom) (< arg 0))) (origins (org-list-struct-origins struct)) (beg-item (assq beg struct))) (cond @@ -751,7 +754,7 @@ Return t if successful." (let ((anc (car struct))) (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct)))) + (org-list-struct-apply-struct struct end)))) ;; Forbidden move ((and (< arg 0) (or (and no-subtree @@ -760,7 +763,7 @@ Return t if successful." (let ((last-item (save-excursion (goto-char end) (skip-chars-backward " \r\t\n") - (org-beginning-of-item) + (goto-char (org-get-item-beginning)) (org-list-struct-assoc-at-point)))) (org-list-struct-get-child last-item struct)))) (error "Cannot outdent an item without its children")) @@ -770,7 +773,7 @@ Return t if successful." (org-list-struct-outdent beg end origins) (org-list-struct-indent beg end origins struct)))) (org-list-struct-fix-struct struct shifted-ori) - (org-list-struct-apply-struct struct)))))))))) + (org-list-struct-apply-struct struct bottom)))))))))) ;;; Predicates @@ -793,14 +796,15 @@ This checks `org-list-ending-method'." (t (and (org-list-in-item-p-with-regexp bound) (org-list-in-item-p-with-indent bound))))))) -(defun org-list-first-item-p () +(defun org-list-first-item-p (top) "Is this item the first item in a plain list? -Assume point is at an item." +Assume point is at an item. + +TOP is the position of list's top-item." (save-excursion (beginning-of-line) (let ((ind (org-get-indentation))) - (or (not (org-search-backward-unenclosed - org-item-beginning-re (org-list-top-point) t)) + (or (not (org-search-backward-unenclosed org-item-beginning-re top t)) (< (org-get-indentation) ind))))) (defun org-at-item-p () @@ -851,8 +855,17 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;;; Navigate +;; Every interactive navigation function is derived from a +;; non-interactive one, which doesn't move point, assumes point is +;; already in a list and doesn't compute list boundaries. + +;; If you plan to use more than one org-list function is some code, +;; you should therefore first compute list boundaries, and then make +;; use of non-interactive forms. + (defun org-list-top-point () - "Return point at the top level in a list, or nil if not in a list." + "Return point at the top level in a list. +Assume point is in a list." (let* ((prev-head (save-excursion (outline-previous-heading))) (bound (if prev-head (or (save-excursion @@ -869,7 +882,8 @@ A checkbox is blocked if all of the following conditions are fulfilled: (org-list-top-point-with-indent (or top-re bound))))))) (defun org-list-bottom-point () - "Return point just before list ending or nil if not in a list." + "Return point just before list ending. +Assume point is in a list." (let* ((next-head (save-excursion (and (let ((outline-regexp org-outline-regexp)) ;; Use default regexp because folding @@ -879,122 +893,148 @@ A checkbox is blocked if all of the following conditions are fulfilled: (and (re-search-forward "^[ \t]*:END:" next-head t) (point-at-bol))) next-head - (point-max))) - (bottom (cond - ((eq org-list-ending-method 'regexp) - (org-list-bottom-point-with-regexp limit)) - ((eq org-list-ending-method 'indent) - (org-list-bottom-point-with-indent limit)) - (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) - (org-list-bottom-point-with-indent (or bottom-re limit))))))) - (when bottom - (save-excursion - (goto-char bottom) - (if (eobp) - (point) - (skip-chars-backward " \r\t\n") - (1+ (point-at-eol))))))) + (point-max)))) + (cond + ((eq org-list-ending-method 'regexp) + (org-list-bottom-point-with-regexp limit)) + ((eq org-list-ending-method 'indent) + (org-list-bottom-point-with-indent limit)) + (t (let ((bottom-re (org-list-bottom-point-with-regexp limit))) + (org-list-bottom-point-with-indent (or bottom-re limit))))))) + +(defun org-get-item-beginning () + "Return position of current item beginning." + (save-excursion + ;; possibly match current line + (end-of-line) + (org-search-backward-unenclosed org-item-beginning-re nil t) + (point-at-bol))) (defun org-beginning-of-item () "Go to the beginning of the current hand-formatted item. -If the cursor is not in an item, throw an error. Return point." +If the cursor is not in an item, throw an error." (interactive) - (if (not (org-in-item-p)) - (error "Not in an item") - ;; Possibly match the current line. - (end-of-line) - (org-search-backward-unenclosed org-item-beginning-re nil t) - (goto-char (point-at-bol)))) + (if (org-in-item-p) + (goto-char (org-get-item-beginning)) + (error "Not in an item"))) + +(defun org-get-beginning-of-list (top) + "Return position of the first item of the current list or sublist. +TOP is the position at list beginning." + (save-excursion + (let (prev-p) + (while (setq prev-p (org-get-previous-item (point) top)) + (goto-char prev-p)) + (point-at-bol)))) + +(defun org-beginning-of-item-list () + "Go to the beginning item of the current list or sublist. +Return an error if not in a list." + (interactive) + (if (org-in-item-p) + (goto-char (org-get-beginning-of-list (org-list-top-point))) + (error "Not in an item"))) + +(defun org-get-end-of-list (bottom) + "Return position at the end of the current list or sublist. +BOTTOM is the position at list ending." + (save-excursion + (goto-char (org-get-item-beginning)) + (let ((ind (org-get-indentation))) + (while (and (/= (point) bottom) + (>= (org-get-indentation) ind)) + (org-search-forward-unenclosed org-item-beginning-re bottom 'move)) + (if (= (point) bottom) bottom (point-at-bol))))) + +(defun org-end-of-item-list () + "Go to the end of the current list or sublist. +If the cursor in not in an item, throw an error." + (interactive) + (if (org-in-item-p) + (goto-char (org-get-end-of-list (org-list-bottom-point))) + (error "Not in an item"))) + +(defun org-get-end-of-item (bottom) + "Return position at the end of the current item. +BOTTOM is the position at list ending." + (let* ((next-p (org-get-next-item (point) bottom))) + (or next-p (org-get-end-of-list bottom)))) (defun org-end-of-item () "Go to the end of the current hand-formatted item. -If the cursor is not in an item, throw an error. Return point." +If the cursor is not in an item, throw an error." (interactive) - (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (if next-p (goto-char next-p) (org-end-of-item-list)))) + (if (org-in-item-p) + (goto-char (org-get-end-of-item (org-list-bottom-point))) + (error "Not in an item"))) -(defun org-end-of-item-or-at-child () - "Move to the end of the item text, stops before the first child if any." - (let ((limit (org-list-bottom-point))) - (end-of-line) - (goto-char - (if (org-search-forward-unenclosed org-item-beginning-re limit t) - (point-at-bol) - limit)))) +(defun org-end-of-item-or-at-child (bottom) + "Move to the end of the item, stops before the first child if any. +BOTTOM is the position at list ending." + (end-of-line) + (goto-char + (if (org-search-forward-unenclosed org-item-beginning-re bottom t) + (point-at-bol) + (org-get-end-of-item bottom)))) -(defun org-end-of-item-before-blank () +(defun org-end-of-item-before-blank (bottom) "Return point at end of item, before any blank line. -Point returned is at eol." +Point returned is at eol. + +BOTTOM is the position at list ending." (save-excursion - (org-end-of-item) + (goto-char (org-get-end-of-item bottom)) (skip-chars-backward " \r\t\n") (point-at-eol))) -(defun org-get-next-item (pos limit) - "Get the point of the next item at the same level as POS. -Stop searching at LIMIT. Return nil if no item is found. This -function does not move point." - (org-list-get-item-same-level - #'org-search-forward-unenclosed pos limit #'end-of-line)) - (defun org-get-previous-item (pos limit) - "Get the point of the previous item at the same level as POS. -Stop searching at LIMIT. Return nil if no item is found. This -function does not move point." + "Return point of the previous item at the same level as POS. +Stop searching at LIMIT. Return nil if no item is found." (org-list-get-item-same-level #'org-search-backward-unenclosed pos limit #'beginning-of-line)) -(defun org-next-item () - "Move to the beginning of the next item. - -Item is at the same level in the current plain list. Error if not -in a plain list, or if this is the last item in the list." - (interactive) - (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) - (if next-p (goto-char next-p) (error "On last item")))) - (defun org-previous-item () "Move to the beginning of the previous item. Item is at the same level in the current plain list. Error if not in a plain list, or if this is the first item in the list." (interactive) - (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) - (if prev-p (goto-char prev-p) (error "On first item")))) + (if (not (org-in-item-p)) + (error "Not in an item") + (let ((prev-p (org-get-previous-item (point) (org-list-top-point)))) + (if prev-p (goto-char prev-p) (error "On first item"))))) -(defun org-beginning-of-item-list () - "Go to the beginning item of the current list or sublist. -Return point." - (interactive) - (let ((limit (org-list-top-point)) - prev-p) - (while (setq prev-p (org-get-previous-item (point) limit)) - (goto-char prev-p)) - (goto-char (point-at-bol)))) +(defun org-get-next-item (pos limit) + "Return point of the next item at the same level as POS. +Stop searching at LIMIT. Return nil if no item is found." + (org-list-get-item-same-level + #'org-search-forward-unenclosed pos limit #'end-of-line)) -(defun org-end-of-item-list () - "Go to the end of the current list or sublist. -Return point." +(defun org-next-item () + "Move to the beginning of the next item. + +Item is at the same level in the current plain list. Error if not +in a plain list, or if this is the last item in the list." (interactive) - (org-beginning-of-item) - (let ((limit (org-list-bottom-point)) - (ind (org-get-indentation))) - (while (and (/= (point) limit) - (>= (org-get-indentation) ind)) - (org-search-forward-unenclosed org-item-beginning-re limit 'move)) - (if (= (point) limit) limit (goto-char (point-at-bol))))) + (if (not (org-in-item-p)) + (error "Not in an item") + (let ((next-p (org-get-next-item (point) (org-list-bottom-point)))) + (if next-p (goto-char next-p) (error "On last item"))))) ;;; Manipulate -(defun org-list-exchange-items (beg-A beg-B) +(defun org-list-exchange-items (beg-A beg-B bottom) "Swap item starting at BEG-A with item starting at BEG-B. -Blank lines at the end of items are left in place. Assumes BEG-A -is lesser than BEG-B." +Blank lines at the end of items are left in place. Assume BEG-A +is lesser than BEG-B. + +BOTTOM is the position at list ending." (save-excursion - (let* ((end-of-item-no-blank (lambda (pos) - (goto-char pos) - (goto-char (org-end-of-item-before-blank)))) + (let* ((end-of-item-no-blank + (lambda (pos) + (goto-char pos) + (goto-char (org-end-of-item-before-blank bottom)))) (end-A-no-blank (funcall end-of-item-no-blank beg-A)) (end-B-no-blank (funcall end-of-item-no-blank beg-B)) (body-A (buffer-substring beg-A end-A-no-blank)) @@ -1010,18 +1050,21 @@ is lesser than BEG-B." Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (let ((pos (point)) - (col (current-column)) - (actual-item (org-beginning-of-item)) - (next-item (org-get-next-item (point) (org-list-bottom-point)))) - (if (not next-item) - (progn - (goto-char pos) - (error "Cannot move this item further down")) - (org-list-exchange-items actual-item next-item) - (org-list-repair) - (org-next-item) - (move-to-column col)))) + (if (not (org-at-item-p)) + (error "Not at an item") + (let* ((pos (point)) + (col (current-column)) + (bottom (org-list-bottom-point)) + (actual-item (goto-char (org-get-item-beginning))) + (next-item (org-get-next-item (point) bottom))) + (if (not next-item) + (progn + (goto-char pos) + (error "Cannot move this item further down")) + (org-list-exchange-items actual-item next-item bottom) + (org-list-repair nil nil bottom) + (goto-char (org-get-next-item (point) bottom)) + (move-to-column col))))) (defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. @@ -1029,17 +1072,21 @@ so this really moves item trees." Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (let ((pos (point)) - (col (current-column)) - (actual-item (org-beginning-of-item)) - (prev-item (org-get-previous-item (point) (org-list-top-point)))) - (if (not prev-item) - (progn - (goto-char pos) - (error "Cannot move this item further up")) - (org-list-exchange-items prev-item actual-item) - (org-list-repair) - (move-to-column col)))) + (if (not (org-at-item-p)) + (error "Not at an item") + (let* ((pos (point)) + (col (current-column)) + (top (org-list-top-point)) + (bottom (org-list-bottom-point)) + (actual-item (goto-char (org-get-item-beginning))) + (prev-item (org-get-previous-item (point) top))) + (if (not prev-item) + (progn + (goto-char pos) + (error "Cannot move this item further up")) + (org-list-exchange-items prev-item actual-item bottom) + (org-list-repair nil top bottom) + (move-to-column col))))) (defun org-insert-item (&optional checkbox) "Insert a new item at the current level. @@ -1054,13 +1101,13 @@ item is invisible." (unless (or (not (org-in-item-p)) (org-invisible-p)) (if (save-excursion - (org-beginning-of-item) + (goto-char (org-get-item-beginning)) (org-at-item-timer-p)) ;; Timer list: delegate to `org-timer-item'. (progn (org-timer-item) t) ;; if we're in a description list, ask for the new term. (let ((desc-text (when (save-excursion - (and (org-beginning-of-item) + (and (goto-char (org-get-item-beginning)) (org-at-item-description-p))) (concat (read-string "Term: ") " :: ")))) ;; Don't insert a checkbox if checkbox rule is applied and it @@ -1077,11 +1124,11 @@ item is invisible." ;; buffer on costly operations like indenting or fixing bullets. ;; It achieves this by taking a snapshot of an interesting part of the -;; list, in the shape of an alist, with `org-list-struct'. +;; list, in the shape of an alist, using `org-list-struct'. -;; It then proceeds to changes directly on the alist. When those are -;; done, `org-list-struct-apply-struct' applies the changes in the -;; buffer. +;; It then proceeds to changes directly on the alist, with the help of +;; and `org-list-struct-origins'. When those are done, +;; `org-list-struct-apply-struct' applies the changes to the buffer. (defun org-list-struct-assoc-at-point () "Return the structure association at point. @@ -1099,7 +1146,7 @@ bullet string and bullet counter, if any." (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") (match-string 1)))))) -(defun org-list-struct (begin end &optional outdent limit-up limit-down) +(defun org-list-struct (begin end top bottom &optional outdent) "Return the structure containing the list between BEGIN and END. A structure is an alist where key is point of item and values @@ -1109,17 +1156,14 @@ has items between BEGIN and END along with their common ancestor. If no such ancestor can be found, the function will add a virtual ancestor at position 0. +TOP and BOTTOM are respectively the position of list beginning +and list ending. + If OUTDENT is non-nil, it will also grab all of the parent list and the grand-parent. Setting OUTDENT to t is mandatory when next -change is an outdent. - -Numbers LIMIT-UP and LIMIT-DOWN are the maximal positions the -structure can extend to. They default respectively to list's top -point and bottom point." +change is an outdent." (save-excursion - (let* ((top (or limit-up (org-list-top-point))) - (bottom (or limit-down (org-list-bottom-point))) - struct + (let* (struct (extend (lambda (struct) (let* ((ind-min (apply 'min (mapcar 'cadr struct))) @@ -1380,8 +1424,11 @@ END." (cdr (assq prev acc))))))))))))) (mapcar ind origins))) -(defun org-list-struct-apply-struct (struct) +(defun org-list-struct-apply-struct (struct bottom) "Apply modifications to list so it mirrors STRUCT. + +BOTTOM is position at list ending. + Initial position is restored after the changes." (let* ((pos (copy-marker (point))) (ancestor (caar struct)) @@ -1398,7 +1445,8 @@ Initial position is restored after the changes." (new-body-ind (+ (length new-bul) new-ind))) ;; 1. Shift item's body (unless (= old-body-ind new-body-ind) - (org-shift-item-indentation (- new-body-ind old-body-ind))) + (org-shift-item-indentation + (- new-body-ind old-body-ind) bottom)) ;; 2. Replace bullet (unless (equal new-bul old-bul) (save-excursion @@ -1432,12 +1480,14 @@ Initial position is restored after the changes." (t (throw 'exit t))))) i)) -(defun org-shift-item-indentation (delta) +(defun org-shift-item-indentation (delta bottom) "Shift the indentation in current item by DELTA. -Sub-items are not moved." +Sub-items are not moved. + +BOTTOM is position at list ending." (save-excursion (let ((beg (point-at-bol)) - (end (org-end-of-item-or-at-child))) + (end (org-end-of-item-or-at-child bottom))) (beginning-of-line (unless (eolp) 0)) (while (> (point) beg) (when (looking-at "[ \t]*\\S-") @@ -1448,24 +1498,36 @@ Sub-items are not moved." (beginning-of-line 0))))) (defun org-outdent-item () - "Outdent a local list item, but not its children." + "Outdent a local list item, but not its children. + +If a region is active, all items inside will be moved." (interactive) - (org-list-indent-item-generic -1 t)) + (org-list-indent-item-generic + -1 t (org-list-top-point) (org-list-bottom-point))) (defun org-indent-item () - "Indent a local list item, but not its children." + "Indent a local list item, but not its children. + +If a region is active, all items inside will be moved." (interactive) - (org-list-indent-item-generic 1 t)) + (org-list-indent-item-generic + 1 t (org-list-top-point) (org-list-bottom-point))) (defun org-outdent-item-tree () - "Outdent a local list item including its children." + "Outdent a local list item including its children. + +If a region is active, all items inside will be moved." (interactive) - (org-list-indent-item-generic -1 nil)) + (org-list-indent-item-generic + -1 nil (org-list-top-point) (org-list-bottom-point))) (defun org-indent-item-tree () - "Indent a local list item including its children." + "Indent a local list item including its children. + +If a region is active, all items inside will be moved." (interactive) - (org-list-indent-item-generic 1 nil)) + (org-list-indent-item-generic + 1 nil (org-list-top-point) (org-list-bottom-point))) (defvar org-tab-ind-state) (defun org-cycle-item-indentation () @@ -1475,40 +1537,42 @@ The first run indent the item, if applicable. Subsequents runs outdent it at meaningful levels in the list. When done, item is put back at its original position with its original bullet. -Return t at each successful move. - -The item must be empty." - (let ((org-adapt-indentation nil)) +Return t at each successful move." + (let ((org-adapt-indentation nil) + (ind (org-get-indentation)) + (bottom (and (org-at-item-p) (org-list-bottom-point)))) (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p)) + ;; Check that item is really empty (>= (match-end 0) (save-excursion - (org-end-of-item-or-at-child) + (org-end-of-item-or-at-child bottom) (skip-chars-backward " \r\t\n") (point)))) (setq this-command 'org-cycle-item-indentation) - ;; When in the middle of the cycle, try to outdent first. If it - ;; fails, and point is still at initial position, indent. Else, - ;; go back to original position. - (if (eq last-command 'org-cycle-item-indentation) + (let ((top (org-list-top-point))) + ;; When in the middle of the cycle, try to outdent first. If it + ;; fails, and point is still at initial position, indent. Else, + ;; go back to original position. + (if (eq last-command 'org-cycle-item-indentation) + (cond + ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) + ((and (= (org-get-indentation) (car org-tab-ind-state)) + (ignore-errors + (org-list-indent-item-generic 1 t top bottom)))) + (t (back-to-indentation) + (indent-to-column (car org-tab-ind-state)) + (end-of-line) + (org-list-repair (cdr org-tab-ind-state)) + ;; Break cycle + (setq this-command 'identity))) + ;; If a cycle is starting, remember indentation and bullet, + ;; then try to indent. If it fails, try to outdent. + (setq org-tab-ind-state (cons ind (org-get-bullet))) (cond - ((ignore-errors (org-outdent-item))) - ((and (= (org-get-indentation) (car org-tab-ind-state)) - (ignore-errors (org-indent-item)))) - (t (back-to-indentation) - (indent-to-column (car org-tab-ind-state)) - (end-of-line) - (org-list-repair (cdr org-tab-ind-state)) - ;; Break cycle - (setq this-command 'identity))) - ;; If a cycle is starting, remember indentation and bullet, - ;; then try to indent. If it fails, try to outdent. - (setq org-tab-ind-state - (cons (org-get-indentation) (org-get-bullet))) - (cond - ((ignore-errors (org-indent-item))) - ((ignore-errors (org-outdent-item))) - (t (error "Cannot move item")))) + ((ignore-errors (org-list-indent-item-generic 1 t top bottom))) + ((ignore-errors (org-list-indent-item-generic -1 t top bottom))) + (t (error "Cannot move item"))))) t))) ;;; Bullets @@ -1544,17 +1608,23 @@ It determines the number of whitespaces to append by looking at nil nil bullet) bullet)) -(defun org-list-repair (&optional force-bullet) +(defun org-list-repair (&optional force-bullet top bottom) "Make sure all items are correctly indented, with the right bullet. This function scans the list at point, along with any sublist. If FORCE-BULLET is a string, ensure all items in list share this bullet, or a logical successor in the case of an ordered list. +When non-nil, TOP and BOTTOM specify respectively position of +list beginning and list ending. + Item's body is not indented, only shifted with the bullet." (interactive) (unless (org-at-item-p) (error "This is not a list")) - (let* ((struct (org-list-struct (point-at-bol) (point-at-eol))) + (let* ((bottom (or bottom (org-list-bottom-point))) + (struct (org-list-struct + (point-at-bol) (point-at-eol) + (or top (org-list-top-point)) bottom)) (origins (org-list-struct-origins struct)) fixed-struct) (if (stringp force-bullet) @@ -1565,7 +1635,7 @@ Item's body is not indented, only shifted with the bullet." (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins)))) (setq fixed-struct (org-list-struct-fix-struct struct origins))) - (org-list-struct-apply-struct fixed-struct))) + (org-list-struct-apply-struct fixed-struct bottom))) (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. @@ -1577,34 +1647,35 @@ If WHICH is a valid string, use that as the new bullet. If WHICH is an integer, 0 means `-', 1 means `+' etc. If WHICH is 'previous, cycle backwards." (interactive "P") - (org-preserve-lc - (let* ((bullet (progn (org-beginning-of-item-list) - (org-get-bullet))) - (current (cond - ((string-match "\\." bullet) "1.") - ((string-match ")" bullet) "1)") - (t bullet))) - (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) - (bullet-list (append '("-" "+" ) - ;; *-bullets are not allowed at column 0 - (unless (and bullet-rule-p - (looking-at "\\S-")) '("*")) - ;; Description items cannot be numbered - (unless (and bullet-rule-p - (or (eq org-plain-list-ordered-item-terminator ?.) - (org-at-item-description-p))) '("1)")) - (unless (and bullet-rule-p - (or (eq org-plain-list-ordered-item-terminator ?\)) - (org-at-item-description-p))) '("1.")))) - (len (length bullet-list)) - (item-index (- len (length (member current bullet-list)))) - (get-value (lambda (index) (nth (mod index len) bullet-list))) - (new (cond - ((member which bullet-list) which) - ((numberp which) (funcall get-value which)) - ((eq 'previous which) (funcall get-value (1- item-index))) - (t (funcall get-value (1+ item-index)))))) - (org-list-repair new)))) + (let* ((top (org-list-top-point)) + (bullet (save-excursion + (goto-char (org-get-beginning-of-list top)) + (org-get-bullet))) + (current (cond + ((string-match "\\." bullet) "1.") + ((string-match ")" bullet) "1)") + (t bullet))) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + (bullet-list (append '("-" "+" ) + ;; *-bullets are not allowed at column 0 + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) + ;; Description items cannot be numbered + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?.) + (org-at-item-description-p))) '("1)")) + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-item-description-p))) '("1.")))) + (len (length bullet-list)) + (item-index (- len (length (member current bullet-list)))) + (get-value (lambda (index) (nth (mod index len) bullet-list))) + (new (cond + ((member which bullet-list) which) + ((numberp which) (funcall get-value which)) + ((eq 'previous which) (funcall get-value (1- item-index))) + (t (funcall get-value (1+ item-index)))))) + (org-list-repair new top))) ;;; Checkboxes @@ -1768,7 +1839,7 @@ the whole buffer." (goto-char startsearch) (if (org-search-forward-unenclosed re-box lim t) (progn - (org-beginning-of-item) + (goto-char (org-get-item-beginning)) (setq curr-ind (org-get-indentation)) (setq next-ind curr-ind) (while (and (bolp) (org-at-item-p) @@ -1801,7 +1872,7 @@ the whole buffer." (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) ;; update items checkbox if it has one (when (org-at-item-p) - (org-beginning-of-item) + (goto-char (org-get-item-beginning)) (when (and (> (+ c-on c-off) 0) (org-search-forward-unenclosed re-box (point-at-eol) t)) (setq beg-cookie (match-beginning 2) @@ -1846,7 +1917,7 @@ Sublists of the list are skipped. Cursor is always at the beginning of the item." (let* ((pos (copy-marker (point))) (end (copy-marker (org-list-bottom-point))) - (next-p (copy-marker (save-excursion (org-beginning-of-item-list)))) + (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point)))) (value init-value)) (while (< next-p end) (goto-char next-p) @@ -1885,8 +1956,10 @@ the sorting key for that record. It will then use COMPARE-FUNC to compare entries." (interactive "P") (let* ((case-func (if with-case 'identity 'downcase)) - (start (org-beginning-of-item-list)) - (end (save-excursion (org-end-of-item-list))) + (top (org-list-top-point)) + (bottom (org-list-bottom-point)) + (start (org-get-beginning-of-list top)) + (end (org-get-end-of-list bottom)) (sorting-type (progn (message @@ -1911,7 +1984,7 @@ compare entries." (skip-chars-forward " \r\t\n") (beginning-of-line))) (end-record (lambda () - (goto-char (org-end-of-item-before-blank)))) + (goto-char (org-end-of-item-before-blank end)))) (value-to-sort (lambda () (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") @@ -1946,7 +2019,7 @@ compare entries." value-to-sort nil sort-func) - (org-list-repair) + (org-list-repair nil top bottom) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) @@ -1968,7 +2041,7 @@ sublevels as a list of strings." (let* ((indent1 (org-get-indentation)) (nextitem (or (org-get-next-item (point) end) end)) (item (org-trim (buffer-substring (point) - (org-end-of-item-or-at-child)))) + (org-end-of-item-or-at-child end)))) (nextindent (if (= (point) end) 0 (org-get-indentation))) (item (if (string-match "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" @@ -2039,7 +2112,7 @@ With argument MAYBE, fail quietly if no transformation is defined for this list." (interactive) (catch 'exit - (unless (org-at-item-p) (error "Not at a list")) + (unless (org-at-item-p) (error "Not at a list item")) (save-excursion (re-search-backward "#\\+ORGLST" nil t) (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") From 86b4d5e69d2f5313c70f2b139b34de2912459a90 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 30 Aug 2010 08:36:13 +0200 Subject: [PATCH 250/348] Keep byte-compiler happy --- lisp/org-list.el | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 3adf89158..17b96511e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -556,9 +556,11 @@ uses PRE-MOVE before search. Return nil if no item was found." (= (org-get-indentation) ind)) (point-at-bol))))) -(defun org-list-separating-blank-lines-number (top bottom) +(defun org-list-separating-blank-lines-number (pos top bottom) "Return number of blank lines that should separate items in list. +POS is the position of point to be considered. + TOP and BOTTOM are respectively position of list beginning and list ending. @@ -586,9 +588,9 @@ some heuristics to guess the result." ((org-get-previous-item (point) top) (org-back-over-empty-lines)) ;; User inserted blank lines, trust him - ((and (> true-pos (org-end-of-item-before-blank bottom)) + ((and (> pos (org-end-of-item-before-blank bottom)) (> (save-excursion - (goto-char true-pos) + (goto-char pos) (skip-chars-backward " \t") (setq usr-blank (org-back-over-empty-lines))) 0)) usr-blank) @@ -634,7 +636,8 @@ function ends." ;; Otherwise, text starts after bullet. (org-at-item-p)) (<= true-pos (match-end 0)))) - (blank-lines-nb (org-list-separating-blank-lines-number top bottom)) + (blank-lines-nb (org-list-separating-blank-lines-number + true-pos top bottom)) (insert-fun (lambda (text) ;; insert bullet above item in order to avoid bothering From 13891fce6e29310ea8e5d49e2bbc815377128789 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 1 Sep 2010 10:47:22 -0700 Subject: [PATCH 251/348] babel: Allow `org-babel-map-src-blocks' to operate on current buffer * ob.el (org-babel-map-src-blocks): If FILE is nil evaluate BODY forms on source blocks in current buffer; restore point in current buffer. --- lisp/ob.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 56005a6d3..753562b4e 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -724,12 +724,14 @@ portions of results lines." 'org-babel-show-result-all 'append 'local))) (defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE." + "Evaluate BODY forms on each source-block in FILE. If FILE is +nil evaluate BODY forms on source blocks in current buffer." (declare (indent 1)) - `(let ((visited-p (get-file-buffer (expand-file-name ,file))) - to-be-removed) + `(let ((visited-p (or (null ,file) + (get-file-buffer (expand-file-name ,file)))) + (point (point)) to-be-removed) (save-window-excursion - (find-file ,file) + (if ,file (find-file ,file)) (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward org-babel-src-block-regexp nil t) @@ -737,7 +739,8 @@ portions of results lines." (save-match-data ,@body) (goto-char (match-end 0)))) (unless visited-p - (kill-buffer to-be-removed)))) + (kill-buffer to-be-removed)) + (goto-char point))) (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) From 398c7bb528766185366bbb05ee430558f1148d40 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 31 Aug 2010 23:28:56 +0200 Subject: [PATCH 252/348] Indent correctly body of source blocks * org.el (org-indent-line-function): indentation of source block is left to `org-edit-src-exit' and shouldn't be modified by `org-indent-line-function'. Indentation of others blocks should be the same as the #+begin line. --- lisp/org.el | 57 ++++++++++++++++++++++++++++++++--------------------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index ff73c225c..d0a2218a3 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18528,40 +18528,53 @@ which make use of the date at the cursor." ;; Find the previous relevant line (beginning-of-line 1) (cond + ;; Comments ((looking-at "#") (setq column 0)) + ;; Headings ((looking-at "\\*+ ") (setq column 0)) + ;; 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)))) - ((and (looking-at "[ \t]+#\\+end_\\([a-z]+\\)") + ;; 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)))) - ;; Are we in a list ? + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-in-regexps-block-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (if (equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation) + (org-get-indentation (match-string 0))))) + ;; Lists ((org-in-item-p) - (org-beginning-of-item) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column)) - bullet (match-string 1) - bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) - (if (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5))) - (if (not itemp) - (setq column tcol) - (beginning-of-line 1) - (goto-char pos) - (if (looking-at "\\S-") - (progn - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") - (setq bullet (match-string 1) - btype (if (string-match "[0-9]" bullet) "n" bullet)) - (setq column (if (equal btype bullet-type) bcol tcol))) - (setq column (org-get-indentation))))) + (org-beginning-of-item) + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") + (setq bpos (match-beginning 1) tpos (match-end 0) + bcol (progn (goto-char bpos) (current-column)) + tcol (progn (goto-char tpos) (current-column)) + bullet (match-string 1) + bullet-type (if (string-match "[0-9]" bullet) "n" bullet)) + (if (> tcol (+ bcol org-description-max-indent)) + (setq tcol (+ bcol 5))) + (if (not itemp) + (setq column tcol) + (beginning-of-line 1) + (goto-char pos) + (if (looking-at "\\S-") + (progn + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*") + (setq bullet (match-string 1) + btype (if (string-match "[0-9]" bullet) "n" bullet)) + (setq column (if (equal btype bullet-type) bcol tcol))) + (setq column (org-get-indentation))))) ;; This line has nothing special, look upside to get a clue about ;; what to do. (t From 15928db323904fe8c892d7289a0cdda89cde8694 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Mon, 30 Aug 2010 13:55:44 +0200 Subject: [PATCH 253/348] Implement new list definition * org-ascii.el (org-export-ascii-preprocess): allow [@start:x] and [@x] syntax for list numbering. * org-capture.el (org-capture-place-item): make use of new tools. * org-capture.el (org-capture-insert-template-here): mark use of new tools. * org-docbook.el (org-export-as-docbook): remove list ending detection as they are now marked explicitely. * org-exp.el (org-export-mark-list-ending): new function. * org-exp.el (org-export-preprocess-string): mark list endings with `org-export-mark-list-ending'. * org-html.el (org-export-as-html): remove list ending detection as they are now marked explicitely. Use value option in list items instead of start when special numbering is needed. * org-latex.el (org-export-latex-lists): make use of new tools. Allow [start:x] and [@x] syntax for list numbering. * org-list.el (org-list-two-spaces-after-bullet-regexp): docstring correction. * org-list.el (org-list-beginning-re): variable removed. * org-list.el (org-list-ending-method): new variable. * org-list.el (org-empty-line-terminates-plain-lists): corrected docstring to match new lists. * org-list.el (org-list-end-regexp): new variable. * org-list.el (org-list-automatic-rules): new variable. * org-list.el (org-provide-checkbox-statistics): variable removed. * org-list.el (org-list-end-re): new function. * org-list.el (org-item-re): allow regexp to properly recognize items with two spaces after bullet. * org-list.el (org-item-beginning-re): pay attention to `org-plain-list-ordered-item-terminator' when defining an item. Replace `org-list-beginning-re'. * org-list.el (org-list-ending-between): new function. * org-list.el (org-list-maybe-skip-block): new function. * org-list.el (org-list-search-unenclosed-generic): new function. * org-list.el (org-search-backward-unenclosed): new function. * org-list.el (org-search-forward-unenclosed): new function. * org-list.el (org-list-in-item-p-with-indent): new function. * org-list.el (org-list-in-item-p-with-regexp): new function. * org-list.el (org-list-top-point-with-regexp): new function. * org-list.el (org-list-bottom-point-with-regexp): new function. * org-list.el (org-list-top-point-with-indent): new function. * org-list.el (org-list-bottom-point-with-indent): new function. * org-list.el (org-list-at-regexp-after-bullet-p): new function. * org-list.el (org-list-get-item-same-level): new function. * org-list.el (org-list-separating-blank-lines-number): new function. * org-list.el (org-list-insert-item-generic): new function. * org-list.el (org-list-indent-item-generic): new function. * org-list.el (org-in-item-p): now depends on `org-list-ending-method'. * org-list.el (org-list-first-item-p): now needs list top item as argument. * org-list.el (org-at-item-timer-p): new function. * org-list.el (org-at-item-description-p): new function. * org-list.el (org-checkbox-blocked-p): make use of new tools. Ignore [@start:x] and [@x] constructs before any checkbox. * org-list.el (org-list-top-point): new function. * org-list.el (org-list-bottom-point): new function. * org-list.el (org-get-item-beginning): new function. * org-list.el (org-beginning-of-item): make use of new tools. * org-list.el (org-get-beginning-of-list): new function. * org-list.el (org-beginning-of-item-list): make use of new list tools. * org-list.el (org-get-end-of-list): new function. * org-list.el (org-end-of-item-list): make use of new tools. * org-list.el (org-get-end-of-item): new function. * org-list.el (org-end-of-item): make use of new tools. * org-list.el (org-end-of-item-text-before-children): function removed. * org-list.el (org-end-of-item-or-at-child): new function. * org-list.el (org-end-of-item-before-blank): new function. * org-list.el (org-get-previous-item): new function. * org-list.el (org-previous-item): make use of new tools. * org-list.el (org-get-next-item): new function. * org-list.el (org-next-item): make use of new tools. * org-list.el (org-list-exchange-items): new function. * org-list.el (org-move-item-down): preserve blank lines when moving items. * org-list.el (org-move-item-up): preserve blank lines when moving items. * org-list.el (org-cycle-list-bullet): Apply rules defined in `org-list-automatic-rules. * org-list.el (org-insert-item): check `org-list-automatic-rules' before inserting a checkbox in an description list. Apply some heuristics to guess correct number of blank lines to insert between items. * org-list.el (org-list-struct-assoc-at-point): new function. * org-list.el (org-list-struct): new function. * org-list.el (org-list-struct-origins): new function. * org-list.el (org-list-struct-get-parent): new function. * org-list.el (org-list-struct-get-child): new function. * org-list.el (org-list-struct-fix-bul): new function. * org-list.el (org-list-struct-fix-ind): new function. * org-list.el (org-list-struct-fix-struct): new function. * org-list.el (org-list-struct-outdent): new function. * org-list.el (org-list-struct-indent): new function. * org-list.el (org-list-struct-apply-struct): new function. * org-list.el (org-shift-item-indentation): now needs bottom position of list as second argument. * org-list.el (org-item-indent-positions): function removed. * org-list.el (org-outdent-item): make use of new tools. Document region handling. * org-list.el (org-indent-item): make use of new tools. Document region handling. * org-list.el (org-outdent-item-tree): make use of new tools. Document region handling. * org-list.el (org-indent-item-tree): make use of new tools. Document region handling. * org-list.el (org-suppress-item-indentation): variable removed. * org-list.el (org-cycle-item-indentation): only cycle to meaningful positions in the list. * org-list.el (org-list-bullet-string): new function. * org-list.el (org-get-bullet): remove dependence to `org-list-item-beginning'. * org-list.el (org-list-inc-bullet-maybe): new function. * org-list.el (org-maybe-renumber-ordered-list): function removed. * org-list.el (org-maybe-renumber-ordered-list): function removed. * org-list.el (org-renumber-ordered-list): function removed. * org-list.el (org-fix-bullet-type): function removed. * org-list.el (org-list-repair): replace both `org-renumber-ordered-list' and `org-fix-bullet-type'. * org-list.el (org-toggle-checkbox): make use of new tools. Handle [@start:x] and [@x] constructs. Check `org-list-automatic-rules' when inserting a checkbox in a description list. * org-list.el (org-update-checkbox-count): make use of new tools. * org-list.el (org-apply-on-list): new function. * org-list.el (org-sort-list): new function. * org-list.el (org-list-item-beginning): function removed. * org-list.el (org-list-goto-true-beginning): function removed. * org-list.el (org-list-end): function removed. * org-list.el (org-list-parse-list): make use of new tools. Handle [@start:x] and [@x] constructs. * org-list.el (org-list-send-list): make use of new tools. * org-list.el (org-list-to-generic): correctly transform description items. * org-timer.el (org-timer): added one optional argument to return the string instead of inserting it in the buffer. * org-timer.el (org-timer-item): insert timer item at correct column. Return an error when inserting such item in a list of another type. * org.el (org-set-font-lock-defaults): correctly fontify [@start:x] and [@x] structures. * org.el (org-cycle-internal-local): correctly cycle visibility of items * org.el (org-sort): now sort timer items. * org.el (org-sort-entries-or-items): function removed. * org.el (org-sort-entries-sort): New function. Replace `org-sort-entries-or-items'. List sorting code has been moved to `org-sort-list'. * org.el (org-add-log-setup): removed extra &optional in arguments. * org.el (org-store-log-note): make use of new tools. Indent correctly before inserting an item. * org.el (org-ctrl-c-ctrl-c): make use of new tools. Unconditionally repair list when function is called. * org.el (org-toggle-item): check `org-list-two-spaces-after-bullet-regexp' when toggling items. * org.el (org-in-regexps-block-p): allow string and form returning string as END-RE argument. * org.el (org-indent-line-function): documented code. Correctly indent item body and text after a list. Indentation of source code is left to `org-edit-src-exit'. Indentation of others blocks should be the same as the #+begin line. --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 17b96511e..0421928e2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1932,7 +1932,7 @@ beginning of the item." (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) "Sort plain list items. The cursor may be at any item of the list that should be sorted. -Sublists are not sorted. Checkboxes, if any, are ignored. +Sublists are not sorted. Checkboxes, if any, are ignored. Sorting can be alphabetically, numerically, by date/time as given by a time stamp, by a property or by priority. From d9ca67496fedbb43b2f4be6057c3a2692428302e Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 1 Sep 2010 15:06:21 -0700 Subject: [PATCH 254/348] babel: Make `org-babel-execute-subtree' support prefix arg * ob.el (org-babel-execute-subtree): Pass prefix arg through to `org-babel-execute-src-block' --- lisp/ob.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index 753562b4e..e4a094431 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -583,7 +583,7 @@ the current subtree." (save-restriction (save-excursion (org-narrow-to-subtree) - (org-babel-execute-buffer) + (org-babel-execute-buffer arg) (widen)))) ;;;###autoload From 02e6ee37d337fe56f2c5e23f2577b77578813381 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 1 Sep 2010 18:08:26 -0600 Subject: [PATCH 255/348] ob-ditaa: now expands tildas in org-ditaa-jar-path Thanks to John Hendy for pointing out the bad behavior and to Juan Pechiar for pointing out the problem in the code * lisp/ob-ditaa.el (org-babel-execute:ditaa): now expanding org-ditaa-jar-path with expand-file-name --- lisp/ob-ditaa.el | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/lisp/ob-ditaa.el b/lisp/ob-ditaa.el index cc95765d2..20cc19284 100644 --- a/lisp/ob-ditaa.el +++ b/lisp/ob-ditaa.el @@ -50,15 +50,18 @@ (defun org-babel-execute:ditaa (body params) "Execute a block of Ditaa code with org-babel. This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (cmdline (cdr (assoc :cmdline params))) - (in-file (org-babel-temp-file "ditaa-"))) + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "ditaa-")) + (cmd (concat "java -jar " + (shell-quote-argument + (expand-file-name org-ditaa-jar-path)) + " " cmdline " " in-file " " out-file))) (unless (file-exists-p org-ditaa-jar-path) (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) (with-temp-file in-file (insert body)) - (message (concat "java -jar " org-ditaa-jar-path " " cmdline " " in-file " " out-file)) - (shell-command (concat "java -jar " (shell-quote-argument org-ditaa-jar-path) " " cmdline " " in-file " " out-file)) + (message cmd) (shell-command cmd) out-file)) (defun org-babel-prep-session:ditaa (session params) From e0d9a280eabc22cc89273a6cba90965ad23e0f47 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 1 Sep 2010 21:10:54 -0700 Subject: [PATCH 256/348] babel: docstring improvement * ob.el (org-babel-execute-src-block): Document prefix argument in docstring. --- lisp/ob.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/lisp/ob.el b/lisp/ob.el index e4a094431..eb3946079 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -323,6 +323,10 @@ Insert the results of execution into the buffer. Source code execution and the collection and formatting of results can be controlled through a variety of header arguments. +With prefix argument ARG, force re-execution even if a an +existing result cached in the buffer would otherwise have been +returned. + Optionally supply a value for INFO in the form returned by `org-babel-get-src-block-info'. From 49d63185cc5212f8c968ed86d32ef168d5e5aea3 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 1 Sep 2010 21:16:15 -0700 Subject: [PATCH 257/348] babel: Docstring improvement * org-src.el (org-edit-src-code): Improve docstring Patch from Richard Riley --- lisp/org-src.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 7ed7606df..12d874e5a 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -196,11 +196,14 @@ There is a mode hook, and keybindings for `org-edit-src-exit' and (defun org-edit-src-code (&optional context code edit-buffer-name quietp) "Edit the source code example at point. -The example is copied to a separate buffer, and that buffer is switched -to the correct language mode. When done, exit with \\[org-edit-src-exit]. -This will remove the original code in the Org buffer, and replace it with -the edited version. Optional argument CONTEXT is used by -\\[org-edit-src-save] when calling this function." +The example is copied to a separate buffer, and that buffer is +switched to the correct language mode. When done, exit with +\\[org-edit-src-exit]. This will remove the original code in the +Org buffer, and replace it with the edited version. Optional +argument CONTEXT is used by \\[org-edit-src-save] when calling +this function. See \\[org-src-window-setup] to configure the +display of windows containing the Org buffer and the code +buffer." (interactive) (unless (eq context 'save) (setq org-edit-src-saved-temp-window-config (current-window-configuration))) From 57bc4f672b046a74e07888af566a097cec51d755 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 1 Sep 2010 23:26:47 -0600 Subject: [PATCH 258/348] Babel: tiny tweak * lisp/ob.el (org-babel-map-src-blocks): prefer `when' to `if' --- lisp/ob.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index eb3946079..f35eaef62 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -735,7 +735,7 @@ nil evaluate BODY forms on source blocks in current buffer." (get-file-buffer (expand-file-name ,file)))) (point (point)) to-be-removed) (save-window-excursion - (if ,file (find-file ,file)) + (when ,file (find-file ,file)) (setq to-be-removed (current-buffer)) (goto-char (point-min)) (while (re-search-forward org-babel-src-block-regexp nil t) From d8498a40e815d8604311e9844e6c75bbf074d026 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Thu, 2 Sep 2010 11:34:26 +0200 Subject: [PATCH 259/348] Fix read-only issue with capture * lisp/org-capture.el (org-capture): Remove read-only text properties from capture text. (org-capture-set-target-location): Throw an error if file+headline target does not point into a file which is in Org mode. Richard Riley writes: > If I select a region in, in this case, an erc (emacs irc client) > buffer in the read only section and then use my global keys to create > a new item using the following "j" template while the text is still > selected > > ("j" "Journal" entry > (file+datetree "journal.org") > "* %T %?\n %i\n %a") > > then I get the following backtrace :- > > Debugger entered--Lisp error: (error "Capture abort: (text-read-only)") > signal(error ("Capture abort: (text-read-only)")) > error("Capture abort: %s" (text-read-only)) > byte-code("\301\302!\203\n --- lisp/org-capture.el | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 3bc30eb4c..4cf887e42 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -383,6 +383,10 @@ bypassed." (initial (and (org-region-active-p) (buffer-substring (point) (mark)))) (entry (org-capture-select-template keys))) + (when initial + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (when annotation + (remove-text-properties 0 (length initial) '(read-only t) annotation)) (cond ((equal entry "C") (customize-variable 'org-capture-templates)) @@ -590,6 +594,8 @@ already gone." (set-buffer (org-capture-target-buffer (nth 1 target))) (let ((hd (nth 2 target))) (goto-char (point-min)) + (unless (org-mode-p) + (error "Target buffer for file+headline should be in Org mode")) (if (re-search-forward (format org-complex-heading-regexp-format (regexp-quote hd)) nil t) From f5ff5dbe5a374c3e2260cec1f6928bad4f6ca6c4 Mon Sep 17 00:00:00 2001 From: Noorul Islam <noorul@noorul.com> Date: Thu, 2 Sep 2010 14:57:15 +0000 Subject: [PATCH 260/348] Fix compiler warning org.el : Fix compiler warning. * lisp/org.el (org-insert-subheading) : Fix compiler warning (org-insert-todo-subheading) : Fix compiler warning TINYCHANGE Thanks and Regards Noorul --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index d0a2218a3..67ed452b0 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -6834,7 +6834,7 @@ Works for outline headings and for plain lists alike." (org-insert-heading arg) (cond ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) + ((org-at-item-p) (org-indent-item)))) (defun org-insert-todo-subheading (arg) "Insert a new subheading with TODO keyword or checkbox and demote it. @@ -6843,7 +6843,7 @@ Works for outline headings and for plain lists alike." (org-insert-todo-heading arg) (cond ((org-on-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item 1)))) + ((org-at-item-p) (org-indent-item)))) ;;; Promotion and Demotion From fbf89f0ecc9d56cf54de920fdba4adf0eacd1857 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 15:21:30 +0200 Subject: [PATCH 261/348] org-agenda.el: Fixed a problem when computing time-grid. Memnon Anon reported that this setting yields a bug: ,---- | (setq org-agenda-time-grid (quote | ((daily weekly today require-timed) "----------------" | ( 000 200 400 600 800 1000 1200 1400 1600 1800 2000 2200 2359)))) `---- --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 3f667254e..90c693536 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5118,7 +5118,7 @@ The modified list may contain inherited tags, and tags matched by (throw 'exit list)) (while (setq time (pop gridtimes)) (unless (and remove (member time have)) - (setq time (int-to-string time)) + (setq time (format "%2d" time)) (push (org-format-agenda-item nil string "" nil (concat (substring time 0 -2) ":" (substring time -2))) From 35c2b7b1c8027ec0b39dd043066c3b3a3992f639 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 15:36:46 +0200 Subject: [PATCH 262/348] Deleted EXPERIMENTAL/find-links-to-local.el. This was requested by Ethan <ethan.glasser.camp@gmail.com>. --- EXPERIMENTAL/find-links-to-local.el | 3 --- 1 file changed, 3 deletions(-) delete mode 100644 EXPERIMENTAL/find-links-to-local.el diff --git a/EXPERIMENTAL/find-links-to-local.el b/EXPERIMENTAL/find-links-to-local.el deleted file mode 100644 index d9a94c1bd..000000000 --- a/EXPERIMENTAL/find-links-to-local.el +++ /dev/null @@ -1,3 +0,0 @@ -(defun org-find-links () - (let* ((file (buffer-file-name)) - (tname (file-truename file))) From 0307f8e81b980533d1e29bf5b7711aa99af63076 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 15:43:45 +0200 Subject: [PATCH 263/348] contrib/lisp/org-wikinodes.el: fix tiny typo. s/org-find-exact-headling-in-buffer/org-find-exact-headline-in-buffer This was spotted by Jambunathan K. --- contrib/lisp/org-wikinodes.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/contrib/lisp/org-wikinodes.el b/contrib/lisp/org-wikinodes.el index 0a000521e..85c32f6ce 100644 --- a/contrib/lisp/org-wikinodes.el +++ b/contrib/lisp/org-wikinodes.el @@ -119,10 +119,10 @@ setting of `org-wikinodes-create-targets'." (let ((create org-wikinodes-create-targets) visiting buffer m pos file rpl) (setq pos - (or (org-find-exact-headling-in-buffer target (current-buffer)) + (or (org-find-exact-headline-in-buffer target (current-buffer)) (and (eq org-wikinodes-scope 'directory) (setq file (org-wikinodes-which-file target)) - (org-find-exact-headling-in-buffer + (org-find-exact-headline-in-buffer target (or (get-file-buffer file) (find-file-noselect file)))))) (if pos @@ -288,7 +288,7 @@ with working links." (delete-region (match-beginning 0) (match-end 0)) (save-match-data (cond - ((org-find-exact-headling-in-buffer link (current-buffer)) + ((org-find-exact-headline-in-buffer link (current-buffer)) ;; Found in current buffer (insert (format "[[#%s][%s]]" link link))) ((eq org-wikinodes-scope 'file) From 11e7a573a5c0d443eedfa9aa5716d5616e89a229 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 16:01:51 +0200 Subject: [PATCH 264/348] org-publish.el: allow :base-directory to omit the ending slash. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This was spotted by Łukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl>. --- lisp/org-publish.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-publish.el b/lisp/org-publish.el index cae7be6a3..de52410ee 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -472,7 +472,8 @@ matching filenames." (unless (plist-get (cdr prj) :components) ;; [[info:org:Selecting%20files]] shows how this is supposed to work: (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (plist-get (cdr prj) :base-directory))) + (b (expand-file-name (file-name-as-directory + (plist-get (cdr prj) :base-directory)))) (x (or (plist-get (cdr prj) :base-extension) "org")) (e (plist-get (cdr prj) :exclude)) (i (plist-get (cdr prj) :include)) From fc49c1ec96b2c789f573ae1ba936b930a8494402 Mon Sep 17 00:00:00 2001 From: Sebastian Rose <sebastian_rose@gmx.de> Date: Wed, 1 Sep 2010 05:15:48 +0000 Subject: [PATCH 265/348] org-protocol default template should be nil Hi Carsten, this little patch fixes an issue Richard brought up. We always used the "w" template as the default for `org-remember' and also used it for `org-capture' for historical reasons. Unfortunately, this breaks, if the user has no "w" template defined. The patch below simply set's the custom variable `org-protocol-default-template-key' to nil, so the interactive template selection is used by default. This works for both, remember an capture. I will adjust the docs, once the patch is applied. Thanks, Sebastian --- lisp/org-protocol.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 3f240fd08..21f28e7ff 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -260,7 +260,7 @@ Here is an example: :group 'org-protocol :type '(alist)) -(defcustom org-protocol-default-template-key "w" +(defcustom org-protocol-default-template-key nil "The default org-remember-templates key to use." :group 'org-protocol :type 'string) From bd1b57f92a33485c90db1efc407c8b7c7450993a Mon Sep 17 00:00:00 2001 From: Noorul Islam <noorul@noorul.com> Date: Thu, 2 Sep 2010 11:35:43 +0000 Subject: [PATCH 266/348] html-export mangels mailto: links Achim Gratz <Stromeko@nexgo.de> writes: > HTML export removes the "mailto:" from a link, which will then be > interpreted as a local link by the browser. > > For an example, see the link to this mailing list in > ORGWEBPAGE/index.org and the corresponding HTML export on orgmode-org > (or just the local file). > org-html.el : Fix exporting file, mailto, news and ftp protocols. * lisp/org-html.el (org-html-make-link): (expand-file-name ) removes one "/" from "///path-to-file", so add one. Anything other than 'file' type should be exported along with the type. TINYCHANGE Thanks and Regards Noorul --- lisp/org-html.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index df55de02f..022b87c06 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -720,7 +720,7 @@ MAY-INLINE-P allows inlining it as an image." ;;Substitute just if original path was absolute. ;;(Otherwise path must remain relative) (if (file-name-absolute-p path) - (expand-file-name path) + (concat "/" (expand-file-name path)) path))) ((string= type "") (list nil path)) @@ -756,8 +756,7 @@ MAY-INLINE-P allows inlining it as an image." (setq thefile (let ((str (org-export-html-format-href thefile))) - (if (and type (not (string= "file" type)) - (org-string-match-p "^//" str)) + (if (and type (not (string= "file" type))) (concat type ":" str) str))) From 2d6238ae551baee92fcecfb0fbfcb76c7537c93c Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 2 Sep 2010 09:03:08 -0600 Subject: [PATCH 267/348] ob-ruby: only require inf-ruby when absolutely necessary * lisp/ob-ruby.el (org-babel-expand-body:ruby): removed requirement of inf-ruby --- lisp/ob-ruby.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/ob-ruby.el b/lisp/ob-ruby.el index f2363df33..87df8d10a 100644 --- a/lisp/ob-ruby.el +++ b/lisp/ob-ruby.el @@ -54,7 +54,6 @@ (defun org-babel-expand-body:ruby (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." - (require 'inf-ruby) (let ((vars (nth 1 (or processed-params (org-babel-process-params params))))) (concat (mapconcat ;; define any variables From 73957b8fbfa8d0ed12f6548662eb46f28a88ea65 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Thu, 2 Sep 2010 08:12:58 -0700 Subject: [PATCH 268/348] Fontify code in code blocks. * org.el (org-fontify-meta-lines-and-blocks): Alter main regexp to match code blocks with switches and header args. Call `org-src-font-lock-fontify-block' for automatic fontification of code in code blocks, controlled by variable `org-src-fontify-natively'. (org-src-fontify-natively): New variable * org-src.el (org-src-font-lock-fontify-block): New function called during font-lock (org-src-fontify-block): New function for manual fontification of code block at point. (org-src-fontify-buffer): New function to manually fontify all code blocks in buffer (org-src-get-lang-mode): New utility function to map language name as a string to major mode symbol Based on an initial fontification patch by David O'Toole and suggestions from Carsten Dominik. --- lisp/org-src.el | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ lisp/org.el | 11 ++++++++++- 2 files changed, 58 insertions(+), 1 deletion(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index 12d874e5a..ace2714b0 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -715,6 +715,54 @@ Org-babel commands." (call-interactively (lookup-key org-babel-map key))))) +(defun org-src-font-lock-fontify-block (lang start end) + "Fontify code block. +This function is called by emacs automatic fontification, as long +as `org-src-fontify-natively' is non-nil. For manual +fontification of code blocks see `org-src-fontify-block' and +`org-src-fontify-buffer'" + (let* ((lang-mode (org-src-get-lang-mode lang)) + (string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-temp-buffer + (insert string) + (funcall lang-mode) + (font-lock-fontify-buffer) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (put-text-property + (+ start (1- pos)) (+ start next) 'face + (get-text-property pos 'face) org-buffer) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified)) + t) ;; Tell `org-fontify-meta-lines-and-blocks' that we fontified + +(defun org-src-fontify-block () + "Fontify code block at point." + (interactive) + (save-excursion + (let ((org-src-fontify-natively t) + (info (org-edit-src-find-region-and-lang))) + (font-lock-fontify-region (nth 0 info) (nth 1 info))))) + +(defun org-src-fontify-buffer () + "Fontify all code blocks in the current buffer" + (interactive) + (org-babel-map-src-blocks nil + (org-src-fontify-block))) + +(defun org-src-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (intern + (concat + ((lambda (l) (if (symbolp l) (symbol-name l) l)) + (or (cdr (assoc lang org-src-lang-modes)) lang)) "-mode"))) (provide 'org-src) diff --git a/lisp/org.el b/lisp/org.el index d0a2218a3..fc44fc767 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5022,13 +5022,19 @@ will be prompted for." '(display t invisible t intangible t)) t))) +(defvar org-src-fontify-natively t + "When non-nil, fontify code in code blocks.") + (defun org-fontify-meta-lines-and-blocks (limit) "Fontify #+ lines and blocks, in the correct ways." (let ((case-fold-search t)) (if (re-search-forward - "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)\\(.*\\)\\)" + "^\\([ \t]*#\\+\\(\\([a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" limit t) (let ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) (beg1 (line-beginning-position 2)) (dc1 (downcase (match-string 2))) (dc3 (downcase (match-string 3))) @@ -5053,6 +5059,7 @@ will be prompted for." (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") nil t) ;; on purpose, we look further than LIMIT (setq end (match-end 0) end1 (1- (match-beginning 0))) + (setq block-end (match-beginning 0)) (when quoting (remove-text-properties beg end '(display t invisible t intangible t))) @@ -5063,6 +5070,8 @@ will be prompted for." (add-text-properties end1 (+ end 1) '(face org-meta-line)) ; for end_src (cond + ((and lang org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end)) (quoting (add-text-properties beg1 (+ end1 1) '(face org-block))) From abfc2cc30ebc74a03d90437ba1bf48c297b249d4 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 1 Sep 2010 21:39:38 -0700 Subject: [PATCH 269/348] Re-use hidden language major mode buffers during code fontification * org-src.el (org-src-font-lock-fontify-block): Re-use hidden language major mode buffers during fontification --- lisp/org-src.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index ace2714b0..6c09cbd6f 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -726,9 +726,12 @@ fontification of code blocks see `org-src-fontify-block' and (modified (buffer-modified-p)) (org-buffer (current-buffer)) pos next) (remove-text-properties start end '(face nil)) - (with-temp-buffer + (with-current-buffer + (get-buffer-create + (concat " org-src-fontification:" (symbol-name lang-mode))) + (delete-region (point-min) (point-max)) (insert string) - (funcall lang-mode) + (unless (eq major-mode lang-mode) (funcall lang-mode)) (font-lock-fontify-buffer) (setq pos (point-min)) (while (setq next (next-single-property-change pos 'face)) From 330fb5409eb50a9ee8e25c7ae463a6a3574e08d2 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 17:33:00 +0200 Subject: [PATCH 270/348] Fix handling of absolute filenames' conversion to HTML links. --- lisp/org-html.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 022b87c06..5da2a5fd1 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -720,7 +720,7 @@ MAY-INLINE-P allows inlining it as an image." ;;Substitute just if original path was absolute. ;;(Otherwise path must remain relative) (if (file-name-absolute-p path) - (concat "/" (expand-file-name path)) + (concat "file://" (expand-file-name path)) path))) ((string= type "") (list nil path)) From 7b188f7da5797da7ae225b89239f87adf0135959 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 17:48:24 +0200 Subject: [PATCH 271/348] Second fix for the time-grid problem. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 90c693536..e036b18a4 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5118,7 +5118,7 @@ The modified list may contain inherited tags, and tags matched by (throw 'exit list)) (while (setq time (pop gridtimes)) (unless (and remove (member time have)) - (setq time (format "%2d" time)) + (setq time (format "%4d" time)) (push (org-format-agenda-item nil string "" nil (concat (substring time 0 -2) ":" (substring time -2))) From ebad875b122e6e39bc29967bc2ef8c9ee5d5c641 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 2 Sep 2010 12:47:54 -0600 Subject: [PATCH 272/348] ob-plantuml: explicitly check `org-plantuml-jar-path' before use * lisp/ob-plantuml.el (org-babel-execute:plantuml): explicitly check `org-plantuml-jar-path' before use --- lisp/ob-plantuml.el | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index c5045de6d..cb5ca129b 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -57,12 +57,14 @@ This function is called by `org-babel-execute-src-block'." (out-file (cdr (assoc :file params))) (cmdline (cdr (assoc :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) - (cmd (concat "java -jar " - (shell-quote-argument org-plantuml-jar-path) - " -p " cmdline " < " - (shell-quote-argument in-file) - " > " - (shell-quote-argument out-file)))) + (cmd (if (not org-plantuml-jar-path) + (error "`org-plantuml-jar-path' is not set") + (concat "java -jar " + (shell-quote-argument org-plantuml-jar-path) + " -p " cmdline " < " + (shell-quote-argument in-file) + " > " + (shell-quote-argument out-file))))) (unless (file-exists-p org-plantuml-jar-path) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) From 0d5791e7b7324bfd7b9893f3a752dbe8aedd1aeb Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Thu, 2 Sep 2010 11:57:03 -0700 Subject: [PATCH 273/348] Allow language-native TAB command in code blocks. * org-src.el (org-src-tab-indents-natively): New variable controlling whether language-native TAB action should be performed (org-src-native-tab-command-maybe): New function to perform language-native TAB action. (org-tab-first-hook): Add `org-src-native-tab-command-maybe' --- lisp/org-src.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/lisp/org-src.el b/lisp/org-src.el index 6c09cbd6f..d1948cc54 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -715,6 +715,19 @@ Org-babel commands." (call-interactively (lookup-key org-babel-map key))))) +(defvar org-src-tab-acts-natively nil + "If non-nil, the effect of TAB in a code block is as if it were +issued in the language major mode buffer.") + +(defun org-src-native-tab-command-maybe () + "Perform language-specific TAB action. +Alter code block according to effect of TAB in the language major +mode." + (and org-src-tab-acts-natively + (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB")))) + +(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe) + (defun org-src-font-lock-fontify-block (lang start end) "Fontify code block. This function is called by emacs automatic fontification, as long From f1d19d5e75b37b7d35db63f21ddde1dc70366702 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 22:32:32 +0200 Subject: [PATCH 274/348] org-timer: Fix the docstring. --- lisp/org-timer.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 33c4c0bb0..53a2679e3 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -149,8 +149,7 @@ With prefix arg STOP, stop it entirely." "Insert a H:MM:SS string from the timer into the buffer. The first time this command is used, the timer is started. When used with a \\[universal-argument] prefix, force restarting the timer. -When used with a double prefix argument \ -\\[universal-argument] \\universal-argument], change all the timer string +When used with a double prefix argument \\[universal-argument], change all the timer string in the region by a fixed amount. This can be used to recalibrate a timer that was not started at the correct moment. From 58a49d173957198755939246618f08d11e37b9a1 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 23:40:44 +0200 Subject: [PATCH 275/348] `org-timer-set-timer': display a countdown in the modeline for. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This was requested long time ago by Frederic Couchet and more recently by Łukasz Stelmach. --- lisp/org-timer.el | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 53a2679e3..7519d8575 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -165,9 +165,13 @@ it in the buffer." (defun org-timer-value-string () (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds))))) +(defvar org-timer-timer-is-countdown nil) (defun org-timer-seconds () - (- (org-float-time (or org-timer-pause-time (current-time))) - (org-float-time org-timer-start-time))) + (if org-timer-timer-is-countdown + (- (org-float-time org-timer-start-time) + (org-float-time (current-time))) + (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time org-timer-start-time)))) ;;;###autoload (defun org-timer-change-times-in-region (beg end delta) @@ -377,8 +381,14 @@ replace any running timer." secs nil `(lambda () (setq org-timer-current-timer nil) (org-notify ,(format "%s: time out" hl) t) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off) (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook)) + (run-hooks 'org-timer-set-hook) + (setq org-timer-timer-is-countdown t + org-timer-start-time + (time-add (current-time) (seconds-to-time (* mins 60)))) + (org-timer-set-mode-line 'on)) (message "No timer set")))))) (provide 'org-timer) From fea907285c4f37e2ceb724616732bac7a66c1e2e Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Thu, 2 Sep 2010 23:51:22 +0200 Subject: [PATCH 276/348] org-show-notification: use notifications.el when available. notifications.el is a new package from Julien Danjou, available in Emacs 24.1. From etc/NEWS: ,---- | ** notifications.el provides an implementation of the Desktop | Notifications API. It requires D-Bus for communication. `---- --- lisp/org-clock.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index a0757c753..3328609fe 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -557,6 +557,13 @@ use libnotify if available, or fall back on a message." ((stringp org-show-notification-handler) (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) + ((featurep 'notifications) + (notifications-notify + :title "Org-mode message" + :body notification + ;; FIXME how to link to the Org icon? + ;; :app-icon "~/.emacs.d/icons/mail.png" + :urgency 'low)) ((org-program-exists "notify-send") (start-process "emacs-timer-notification" nil "notify-send" notification)) From 0c67513e7dbc260ba24552ae71d4cac40e5cec2a Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 01:47:28 +0200 Subject: [PATCH 277/348] `org-get-refile-targets': don't include [/] cookies in targets. This was requested by Marcel van der Boom <marcel@hsdev.com>. --- lisp/org.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org.el b/lisp/org.el index fc44fc767..d07c41dcf 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -9899,6 +9899,7 @@ on the system \"/user@host:\"." (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) txt (org-link-display-format (match-string 4)) + txt (replace-regexp-in-string " *\[[0-9]+/[0-9]+\]$" "" txt) re (format org-complex-heading-regexp-format (regexp-quote (match-string 4)))) (when org-refile-use-outline-path From b0dce5a074c13945f4cb747e76986f4df4f9eb1f Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 2 Sep 2010 17:58:08 -0600 Subject: [PATCH 278/348] ob-plantuml: now expanding file names before shell quoting * lisp/ob-plantuml.el (org-babel-execute:plantuml): now expanding file names before shell quoting --- lisp/ob-plantuml.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index cb5ca129b..cf1d9cc43 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -60,11 +60,14 @@ This function is called by `org-babel-execute-src-block'." (cmd (if (not org-plantuml-jar-path) (error "`org-plantuml-jar-path' is not set") (concat "java -jar " - (shell-quote-argument org-plantuml-jar-path) + (shell-quote-argument + (expand-file-name org-plantuml-jar-path)) " -p " cmdline " < " - (shell-quote-argument in-file) + (shell-quote-argument + (expand-file-name in-file)) " > " - (shell-quote-argument out-file))))) + (shell-quote-argument + (expand-file-name out-file)))))) (unless (file-exists-p org-plantuml-jar-path) (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) From 538cf4e07c189b89a57db0e7ccdb63428ba2181e Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 02:43:22 +0200 Subject: [PATCH 279/348] Fix docstring. --- lisp/org-agenda.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index e036b18a4..3a6434475 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4002,8 +4002,7 @@ The remainder is either a list of TODO keywords, or a state symbol "Create agenda view for projects that are stuck. Stuck projects are project that have no next actions. For the definitions of what a project is and how to check if it stuck, customize the variable -`org-stuck-projects'. -MATCH is being ignored." +`org-stuck-projects'." (interactive) (let* ((org-agenda-skip-function 'org-agenda-skip-entry-when-regexp-matches-in-subtree) From 8302e2b0d81e4570ddb6345f76f91d77ec35c5e1 Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Fri, 3 Sep 2010 07:09:18 +0200 Subject: [PATCH 280/348] Fix read-only property removal bug * lisp/org-capture.el (org-capture): Compute the length of the correct string when removing properties. --- lisp/org-capture.el | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 4cf887e42..eafc9c607 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -383,10 +383,11 @@ bypassed." (initial (and (org-region-active-p) (buffer-substring (point) (mark)))) (entry (org-capture-select-template keys))) - (when initial + (when (stringp initial) (remove-text-properties 0 (length initial) '(read-only t) initial)) - (when annotation - (remove-text-properties 0 (length initial) '(read-only t) annotation)) + (when (stringp annotation) + (remove-text-properties 0 (length annotation) + '(read-only t) annotation)) (cond ((equal entry "C") (customize-variable 'org-capture-templates)) From ba4bf2c96e23e7490ba726b462f4628ab5f37e7e Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 10:43:09 +0200 Subject: [PATCH 281/348] `org-get-refile-targets': also trim [%] cookies from refile targets. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 865ccd945..e7391d8fd 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -9899,7 +9899,7 @@ on the system \"/user@host:\"." (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) txt (org-link-display-format (match-string 4)) - txt (replace-regexp-in-string " *\[[0-9]+/[0-9]+\]$" "" txt) + txt (replace-regexp-in-string " *\[[0-9]+/?[0-9]*%?\]$" "" txt) re (format org-complex-heading-regexp-format (regexp-quote (match-string 4)))) (when org-refile-use-outline-path From f4143ddf1bd300004a1d1f245427a66a4d079677 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 10:57:51 +0200 Subject: [PATCH 282/348] org.texi: be explicit on which agenda views support `org-agenda-skip-function'. --- doc/org.texi | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 4ce32ce47..71d182360 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -13781,10 +13781,11 @@ written in a way such that it does nothing in buffers that are not in @section Special agenda views @cindex agenda views, user-defined -Org provides a special hook that can be used to narrow down the -selection made by any of the agenda views. You may specify a function -that is used at each match to verify if the match should indeed be part -of the agenda view, and if not, how much should be skipped. +Org provides a special hook that can be used to narrow down the selection +made by these agenda views: @code{todo}, @code{alltodo}, @code{tags}, @code{tags-todo}, +@code{tags-tree}. You may specify a function that is used at each match to verify +if the match should indeed be part of the agenda view, and if not, how +much should be skipped. Let's say you want to produce a list of projects that contain a WAITING tag anywhere in the project tree. Let's further assume that you have From 00fadebf9c274424794de6b1bb0846d61ce2dc3e Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 15:08:47 +0200 Subject: [PATCH 283/348] `org-get-refile-targets': trim multiple [%] and [/] cookies. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index e7391d8fd..7a5cbf8ac 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -9899,7 +9899,7 @@ on the system \"/user@host:\"." (setq level (org-reduced-level (- (match-end 1) (match-beginning 1))) txt (org-link-display-format (match-string 4)) - txt (replace-regexp-in-string " *\[[0-9]+/?[0-9]*%?\]$" "" txt) + txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt) re (format org-complex-heading-regexp-format (regexp-quote (match-string 4)))) (when org-refile-use-outline-path From 8f173ce8434a540adbddd9cd81cf380a18894767 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 15:26:47 +0200 Subject: [PATCH 284/348] Make `org-timer-cancel-timer' turn off the modeline countdown. Also bind `org-timer-cancel-timer' to `C-c C-x :' in org-mode. We may want to bind this command in org-agenda-mode as well but I don't have any good idea of a keybinding now. --- lisp/org-timer.el | 4 +++- lisp/org.el | 1 + 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 7519d8575..80b8cd9bf 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -303,7 +303,9 @@ VALUE can be `on', `off', or `pause'." (when (eval org-timer-current-timer) (run-hooks 'org-timer-cancel-hook) (cancel-timer org-timer-current-timer) - (setq org-timer-current-timer nil)) + (setq org-timer-current-timer nil) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off)) (message "Last timer canceled")) (defun org-timer-show-remaining-time () diff --git a/lisp/org.el b/lisp/org.el index 7a5cbf8ac..26acc6917 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -16380,6 +16380,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) (org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) (org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) +(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer) (org-defkey org-mode-map "\C-c\C-x." 'org-timer) (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) From 4f95c5469c214169b0b0f37dceacdf0a1b785add Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Fri, 3 Sep 2010 15:35:15 +0200 Subject: [PATCH 285/348] `org-timer-set-timer': allow to run even before the first heading. In this case, the notification will tell the user in what file the timer was set. --- lisp/org-timer.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 80b8cd9bf..313d4f01e 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -366,9 +366,11 @@ replace any running timer." (widen) (goto-char pos) (org-show-entry) - (org-get-heading)))) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))))) ((eq major-mode 'org-mode) - (org-get-heading)) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))) (t (error "Not in an Org buffer")))) timer-set) (if (or (and org-timer-current-timer From 48114acd2a9755e16840f16b42e0257c3f1b6bb2 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 3 Sep 2010 07:51:13 -0600 Subject: [PATCH 286/348] ob-tangle: adding pre-tangle hook for customization of tangle preparation * lisp/ob-tangle.el (org-babel-pre-tangle-hook): defines new tangle hook (org-babel-tangle): calls new tangle hook --- lisp/ob-tangle.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index adc054aad..a87ee4496 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -53,6 +53,11 @@ then the name of the language is used." :group 'org-babel :type 'hook) +(defcustom org-babel-pre-tangle-hook '(save-buffer) + "Hook run at the beginning of `org-babel-tangle'." + :group 'org-babel + :type 'hook) + (defun org-babel-find-file-noselect-refresh (file) "Find file ensuring that the latest changes on disk are represented in the file." @@ -127,7 +132,7 @@ TARGET-FILE can be used to specify a default export file for all source blocks. Optional argument LANG can be used to limit the exported source code blocks by language." (interactive) - (save-buffer) + (run-hooks 'org-babel-pre-tangle-hook) (save-excursion (let ((block-counter 0) (org-babel-default-header-args From c881fa076060e647fc9f24ce68bd1aea5853016d Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Sat, 4 Sep 2010 08:39:19 -0600 Subject: [PATCH 287/348] ob-tangle: :comments header argument can now tangle surrounding text This commit introduces a new set of :comments header arguments - no :: retains its behavior of not tangling any comments - yes :: retains its behavior of wrapping the code in links back to the original org-mode file - link :: is synonymous with "yes" - org :: does not wrap the code in links back to the original org file, but does include preceding text from the org-mode file as a comment before the code block - both :: turns on both the "link" and "org" options * lisp/ob-tangle.el (org-babel-tangle-pad-newline): can be used to control the amount of extra newlines inserted into tangled code (org-babel-tangle-collect-blocks): now conditionally collects information to be used for "org" style comments (org-babel-spec-to-string): now inserts "org" style comments, and obeys the newline configuration variable when inserting whitespace * doc/org.texi (comments): documenting the new :comments header arguments --- doc/org.texi | 21 ++++++++--- lisp/ob-tangle.el | 90 +++++++++++++++++++++++++++++------------------ 2 files changed, 72 insertions(+), 39 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 71d182360..3b0334fd3 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11894,10 +11894,23 @@ basename}. @subsubsection @code{:comments} By default code blocks are tangled to source-code files without any insertion of comments beyond those which may already exist in the body of the code -block. The @code{:comments} header argument can be set to ``yes'' -e.g. @code{:comments yes} to enable the insertion of comments around code -blocks during tangling. The inserted comments contain pointers back to the -original Org file from which the comment was tangled. +block. The @code{:comments} header argument can be set as follows to control +the insertion of extra comments into the tangled code file. + +@itemize @bullet +@item @code{no} +The default. No extra comments are inserted during tangling. +@item @code{link} +The code block is wrapped in comments which contain pointers back to the +original Org file from which the code was tangled. +@item @code{yes} +A synonym for ``link'' to maintain backwards compatibility. +@item @code{org} +Include text from the original org-mode file which preceded the code block as +a comment which precedes the tangled code. +@item @code{both} +Turns on both the ``link'' and ``org'' comment options. +@end itemize @node no-expand, session, comments, Specific header arguments @subsubsection @code{:no-expand} diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index a87ee4496..70291514c 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -34,6 +34,7 @@ (declare-function org-link-escape "org" (text &optional table)) (declare-function org-heading-components "org" ()) +(declare-function org-back-to-heading "org" (invisible-ok)) (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) @@ -58,6 +59,11 @@ then the name of the language is used." :group 'org-babel :type 'hook) +(defcustom org-babel-tangle-pad-newline t + "Switch indicating whether to pad tangled code with newlines." + :group 'org-babel + :type 'boolean) + (defun org-babel-find-file-noselect-refresh (file) "Find file ensuring that the latest changes on disk are represented in the file." @@ -246,39 +252,45 @@ code blocks by language." (org-babel-clean-text-properties (car (pop org-stored-links))))) (info (org-babel-get-src-block-info)) + (params (nth 2 info)) (source-name (intern (or (nth 4 info) (format "%s:%d" current-heading block-counter)))) - (src-lang (nth 0 info)) + (src-lang (nth 0 info)) (expand-cmd (intern (concat "org-babel-expand-body:" src-lang))) - (params (nth 2 info)) + (body ((lambda (body) + (if (assoc :no-expand params) + body + (funcall (if (fboundp expand-cmd) + expand-cmd + 'org-babel-expand-body:generic) + body params))) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (comment (when (or (string= "both" (cdr (assoc :comments params))) + (string= "org" (cdr (assoc :comments params)))) + ;; from the previous heading or code-block end + (buffer-substring + (max (condition-case nil + (save-excursion + (org-back-to-heading t) (point)) + (error 0)) + (save-excursion (re-search-backward + org-babel-src-block-regexp nil t) + (match-end 0))) + (point)))) by-lang) (unless (string= (cdr (assoc :tangle params)) "no") ;; skip (unless (and lang (not (string= lang src-lang))) ;; limit by language ;; add the spec for this block to blocks under it's language (setq by-lang (cdr (assoc src-lang blocks))) (setq blocks (delq (assoc src-lang blocks) blocks)) - (setq blocks - (cons - (cons src-lang - (cons (list link source-name params - ((lambda (body) - (if (assoc :no-expand params) - body - (funcall - (if (fboundp expand-cmd) - expand-cmd - 'org-babel-expand-body:generic) - body - params))) - (if (and (cdr (assoc :noweb params)) - (string= - "yes" - (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info) - (nth 1 info)))) - by-lang)) blocks)))))) + (setq blocks (cons + (cons src-lang + (cons (list link source-name params body comment) + by-lang)) blocks)))))) ;; ensure blocks in the correct order (setq blocks (mapcar @@ -293,22 +305,30 @@ source code file. This function uses `comment-region' which assumes that the appropriate major-mode is set. SPEC has the form - (link source-name params body)" - (let ((link (nth 0 spec)) - (source-name (nth 1 spec)) - (body (nth 3 spec)) - (commentable (string= (cdr (assoc :comments (nth 2 spec))) "yes"))) + (link source-name params body comment)" + (let* ((link (org-link-escape (nth 0 spec))) + (source-name (nth 1 spec)) + (body (nth 3 spec)) + (comment (nth 4 spec)) + (comments (cdr (assoc :comments (nth 2 spec)))) + (link-p (or (string= comments "both") (string= comments "link") + (string= comments "yes")))) (flet ((insert-comment (text) - (when commentable - (insert "\n") + (when (and comments (not (string= comments "no"))) + (when org-babel-tangle-pad-newline + (insert "\n")) (comment-region (point) - (progn (insert text) (point))) + (progn + (insert (org-babel-trim text)) + (point))) (end-of-line nil) (insert "\n")))) - (insert-comment (format "[[%s][%s]]" (org-link-escape link) source-name)) - (insert (format "\n%s\n" (replace-regexp-in-string - "^," "" (org-babel-chomp body)))) - (insert-comment (format "%s ends here" source-name))))) + (when comment (insert-comment comment)) + (when link-p (insert-comment (format "[[%s][%s]]" link source-name))) + (when org-babel-tangle-pad-newline (insert "\n")) + (insert (format "%s\n" (replace-regexp-in-string + "^," "" (org-babel-trim body)))) + (when link-p (insert-comment (format "%s ends here" source-name)))))) (provide 'ob-tangle) From 798a78fe06daf75bdbc2031a8f49edadd30612e1 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Sat, 4 Sep 2010 13:36:48 -0400 Subject: [PATCH 288/348] Protect against errors when operating in temporary code edit buffer * ob.el (org-babel-do-in-edit-buffer): Use unwind-protect to ensure that edit buffer is exited --- lisp/ob.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index f35eaef62..20b0c9a41 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -511,9 +511,9 @@ with a prefix argument then this is passed on to Return t if a code block was found at point, nil otherwise." `(let ((org-src-window-setup 'switch-invisibly)) (when (org-edit-src-code nil nil nil 'quietly) - ,@body - (if (org-bound-and-true-p org-edit-src-from-org-mode) - (org-edit-src-exit)) + (unwind-protect (progn ,@body) + (if (org-bound-and-true-p org-edit-src-from-org-mode) + (org-edit-src-exit))) t))) (defun org-babel-do-key-sequence-in-edit-buffer (key) From a581ee00a61eb5c7e7f42bc2299eb284c035223c Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Sun, 5 Sep 2010 17:41:23 +0200 Subject: [PATCH 289/348] ob-R.el: Bugfix: explicitely set variables to `nil'. --- lisp/ob-R.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ob-R.el b/lisp/ob-R.el index 76e83e8f3..64bbba4c6 100644 --- a/lisp/ob-R.el +++ b/lisp/ob-R.el @@ -153,7 +153,7 @@ This function is called by `org-babel-execute-src-block'." (if rownames-p "1" "NULL"))) (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) -(defvar ess-ask-for-ess-directory) +(defvar ess-ask-for-ess-directory nil) (defun org-babel-R-initiate-session (session params) "If there is not a current R process then create one." (unless (string= session "none") @@ -172,7 +172,7 @@ This function is called by `org-babel-execute-src-block'." (buffer-name)))) (current-buffer)))))) -(defvar ess-local-process-name) +(defvar ess-local-process-name nil) (defun org-babel-R-associate-session (session) "Associate R code buffer with an R session. Make SESSION be the inferior ESS process associated with the From 045e3aea280da14a4db36d7b81d959efde4b593a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sat, 4 Sep 2010 10:52:05 +0200 Subject: [PATCH 290/348] Fix checkbox statistics * org-list.el (org-toggle-checkbox): Ignore items in drawers when used from an heading. Send an error when no item is in region. * org-list.el (org-update-checkbox-count): Correctly handle argument ALL. Speed optimization. --- lisp/org-list.el | 225 +++++++++++++++++++++++++---------------------- 1 file changed, 119 insertions(+), 106 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 0421928e2..11aa85b6a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1689,12 +1689,12 @@ With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With double prefix, set checkbox to [-]. When there is an active region, toggle status or presence of the -checkbox in the first line, and make every item in the region -have the same status or presence, respectively. +first checkbox there, and make every item inside have the +same status or presence, respectively. If the cursor is in a headline, apply this to all checkbox items in the text below the heading, taking as reference the first item -in subtree." +in subtree, ignoring drawers." (interactive "P") ;; Bounds is a list of type (beg end single-p) where single-p is t ;; when `org-toggle-checkbox' is applied to a single item. Only @@ -1702,22 +1702,34 @@ in subtree." (let* ((bounds (cond ((org-region-active-p) - (list (region-beginning) (region-end) nil)) + (let ((rbeg (region-beginning)) + (rend (region-end))) + (save-excursion + (goto-char rbeg) + (if (org-search-forward-unenclosed org-item-beginning-re rend 'move) + (list (point-at-bol) rend nil) + (error "No item in region"))))) ((org-on-heading-p) - ;; In this case, reference line is the first item in subtree - (let ((limit (save-excursion (outline-next-heading) (point)))) + ;; In this case, reference line is the first item in + ;; subtree outside drawers + (let ((pos (point)) + (limit (save-excursion (outline-next-heading) (point)))) (save-excursion + (goto-char limit) + (org-search-backward-unenclosed ":END:" pos 'move) (org-search-forward-unenclosed org-item-beginning-re limit 'move) (list (point) limit nil)))) ((org-at-item-p) (list (point-at-bol) (point-at-eol) t)) (t (error "Not at an item or heading, and no active region")))) - ;; marker is needed because deleting checkboxes will change END + (beg (car bounds)) + ;; marker is needed because deleting or inserting checkboxes + ;; will change bottom point (end (copy-marker (nth 1 bounds))) (single-p (nth 2 bounds)) (ref-presence (save-excursion - (goto-char (car bounds)) + (goto-char beg) (org-at-item-checkbox-p))) (ref-status (equal (match-string 1) "[X]")) (act-on-item @@ -1751,7 +1763,7 @@ in subtree." (t "[X]")) t t nil 1)))))))) (save-excursion - (beginning-of-line) + (goto-char beg) (while (< (point) end) (funcall act-on-item ref-presence ref-status) (org-search-forward-unenclosed org-item-beginning-re end 'move))) @@ -1792,104 +1804,105 @@ with the current numbers. With optional prefix argument ALL, do this for the whole buffer." (interactive "P") (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (org-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - (re-find (concat re "\\|" re-box)) - beg-cookie end-cookie is-percent c-on c-off lim new - eline curr-ind next-ind continue-from startsearch - (recursive - (or (not org-hierarchical-checkbox-statistics) - (string-match "\\<recursive\\>" - (or (ignore-errors - (org-entry-get nil "COOKIE_DATA")) - "")))) - (cstat 0)) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char end) - ;; find each statistics cookie - (while (and (org-search-backward-unenclosed re-find beg t) - (not (save-match-data - (and (org-on-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get - nil "COOKIE_DATA") - ""))))))) - (setq beg-cookie (match-beginning 1) - end-cookie (match-end 1) - cstat (+ cstat (if end-cookie 1 0)) - startsearch (point-at-eol) - continue-from (match-beginning 0) - is-percent (match-beginning 2) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 - c-off 0) - (when lim - ;; find first checkbox for this cookie and gather - ;; statistics from all that are at this indentation level - (goto-char startsearch) - (if (org-search-forward-unenclosed re-box lim t) - (progn - (goto-char (org-get-item-beginning)) - (setq curr-ind (org-get-indentation)) - (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) - (if recursive - (<= curr-ind next-ind) - (= curr-ind next-ind))) - (setq eline (point-at-eol)) - (if (org-search-forward-unenclosed re-box eline t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) - (if (not recursive) - ;; org-get-next-item goes through list-enders - ;; with proper limit. - (goto-char (or (org-get-next-item (point) lim) lim)) - (end-of-line) - (when (org-search-forward-unenclosed - org-item-beginning-re lim t) - (beginning-of-line))) - (setq next-ind (org-get-indentation))))) - (goto-char continue-from) - ;; update cookie - (when end-cookie - (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) - (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (goto-char beg-cookie) - (insert new) - (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) - ;; update items checkbox if it has one - (when (org-at-item-p) - (goto-char (org-get-item-beginning)) - (when (and (> (+ c-on c-off) 0) - (org-search-forward-unenclosed re-box (point-at-eol) t)) - (setq beg-cookie (match-beginning 2) - end-cookie (match-end 2)) - (delete-region beg-cookie end-cookie) - (goto-char beg-cookie) - (cond ((= c-off 0) (insert "[X]")) - ((= c-on 0) (insert "[ ]")) - (t (insert "[-]"))) - ))) - (goto-char continue-from)) + (let ((cstat 0)) + (catch 'exit + (while t + (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 + (beg (condition-case nil + (progn (org-back-to-heading) (point)) + (error (point-min)))) + (end (copy-marker (save-excursion + (outline-next-heading) (point)))) + (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + beg-cookie end-cookie is-percent c-on c-off lim new + curr-ind next-ind continue-from startsearch list-beg list-end + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (ignore-errors + (org-entry-get nil "COOKIE_DATA")) + ""))))) + (goto-char end) + ;; find each statistics cookie + (while (and (org-search-backward-unenclosed re-cookie beg 'move) + (not (save-match-data + (and (org-on-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))))) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1) + cstat (+ cstat (if end-cookie 1 0)) + startsearch (point-at-eol) + continue-from (match-beginning 0) + is-percent (match-beginning 2) + lim (cond + ((org-on-heading-p) (outline-next-heading) (point)) + ;; Ensure many cookies in the same list won't imply + ;; computing list boundaries as many times. + ((org-at-item-p) + (unless (and list-beg (>= (point) list-beg)) + (setq list-beg (org-list-top-point) + list-end (copy-marker + (org-list-bottom-point)))) + (org-get-end-of-item list-end)) + (t nil)) + c-on 0 + c-off 0) + (when lim + ;; find first checkbox for this cookie and gather + ;; statistics from all that are at this indentation level + (goto-char startsearch) + (if (org-search-forward-unenclosed re-box lim t) + (progn + (beginning-of-line) + (setq curr-ind (org-get-indentation)) + (setq next-ind curr-ind) + (while (and (bolp) (org-at-item-p) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) + (when (org-at-item-checkbox-p) + (if (member (match-string 1) '("[ ]" "[-]")) + (setq c-off (1+ c-off)) + (setq c-on (1+ c-on)))) + (if (not recursive) + ;; org-get-next-item goes through list-enders + ;; with proper limit. + (goto-char (or (org-get-next-item (point) lim) lim)) + (end-of-line) + (when (org-search-forward-unenclosed + org-item-beginning-re lim t) + (beginning-of-line))) + (setq next-ind (org-get-indentation))))) + (goto-char continue-from) + ;; update cookie + (when end-cookie + (setq new (if is-percent + (format "[%d%%]" (/ (* 100 c-on) + (max 1 (+ c-on c-off)))) + (format "[%d/%d]" c-on (+ c-on c-off)))) + (goto-char beg-cookie) + (insert new) + (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) + ;; update items checkbox if it has one + (when (and (org-at-item-checkbox-p) + (> (+ c-on c-off) 0)) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1)) + (delete-region beg-cookie end-cookie) + (goto-char beg-cookie) + (cond ((= c-off 0) (insert "[X]")) + ((= c-on 0) (insert "[ ]")) + (t (insert "[-]"))))) + (goto-char continue-from))) + (unless (and all (outline-next-heading)) (throw 'exit nil)))) (when (interactive-p) - (message "Checkbox statistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) + (message "Checkbox statistics updated %s (%d places)" + (if all "in entire file" "in current outline entry") cstat))))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. From 3ece67cc1327083e4fa111f98c4e61a26a63487d Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Sun, 5 Sep 2010 17:58:30 +0200 Subject: [PATCH 291/348] org-list.el: Declare functions and variables to fix compiler warning * org-list.el (org-outline-regexp, org-ts-regexp) (org-ts-regexp-both, org-in-regexps-block-p) (org-level-increment, org-at-heading-p) (outline-previous-heading, org-icompleting-read) (org-time-string-to-seconds): Declare to fix compiler warning. --- lisp/org-list.el | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/lisp/org-list.el b/lisp/org-list.el index 11aa85b6a..b58a23d96 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -40,6 +40,9 @@ (defvar org-M-RET-may-split-line) (defvar org-complex-heading-regexp) (defvar org-odd-levels-only) +(defvar org-outline-regexp) +(defvar org-ts-regexp) +(defvar org-ts-regexp-both) (declare-function org-invisible-p "org" ()) (declare-function org-on-heading-p "org" (&optional invisible-ok)) @@ -55,6 +58,13 @@ (pom property &optional inherit literal-nil)) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-show-subtree "org" ()) +(declare-function org-in-regexps-block-p "org" + (start-re end-re &optional bound)) +(declare-function org-level-increment "org" ()) +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function outline-previous-heading "outline" ()) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-time-string-to-seconds "org" (s)) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." From e72fa4dcc57f2c01242ceccb66a66d226f0a467d Mon Sep 17 00:00:00 2001 From: aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local> Date: Sun, 5 Sep 2010 16:25:08 +0200 Subject: [PATCH 292/348] Honor special link formatting of custom links for ASCII export --- lisp/org-ascii.el | 22 ++++++++++++++-------- lisp/org.el | 6 ++++-- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index c05d4fb67..8bb8b5aa2 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -311,7 +311,7 @@ publishing directory." :add-text (plist-get opt-plist :text)) "\n")) thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link desc desc0 rpl wrap) + table-open table-buffer link-buffer link desc desc0 rpl wrap fnc) (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) @@ -446,12 +446,17 @@ publishing directory." (setq rpl (concat "[" (or (match-string 3 line) (match-string 1 line)) "]")) - (when (and desc0 (not (equal desc0 link))) - (if org-export-ascii-links-to-notes - (push (cons desc0 link) link-buffer) - (setq rpl (concat rpl " (" link ")") - wrap (+ (length line) (- (length (match-string 0 line))) - (length desc))))) + (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) + (setq rpl (or (save-match-data + (funcall fnc (org-link-unescape path) + desc0 'ascii)) + rpl)) + (when (and desc0 (not (equal desc0 link))) + (if org-export-ascii-links-to-notes + (push (cons desc0 link) link-buffer) + (setq rpl (concat rpl " (" link ")") + wrap (+ (length line) (- (length (match-string 0 line))) + (length desc)))))) (setq line (replace-match rpl t t line)))) (when custom-times (setq line (org-translate-time line))) @@ -482,7 +487,8 @@ publishing directory." (org-format-table-ascii table-buffer) "\n") "\n"))) (t - (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" line) + (if (string-match "^\\([ \t]*\\)\\([-+*][ \t]+\\)\\(.*?\\)\\( ::\\)" + line) (setq line (replace-match "\\1\\3:" t nil line))) (setq line (org-fix-indentation line org-ascii-current-indentation)) ;; Remove forced line breaks diff --git a/lisp/org.el b/lisp/org.el index e7391d8fd..f67c8b003 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8141,11 +8141,13 @@ It should be a function accepting three arguments: path the path of the link, the text after the prefix (like \"http:\") desc the description of the link, if any, nil if there was no description - format the export format, a symbol like `html' or `latex'. + format the export format, a symbol like `html' or `latex' or `ascii'.. The function may use the FORMAT information to return different values depending on the format. The return value will be put literally into -the exported file. +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + Org-mode has a built-in default for exporting links. If you are happy with this default, there is no need to define an export function for the link type. For a simple example of an export function, see `org-bbdb.el'." From 373224ecdbd32a6e7ed523e28b581f637a7b1621 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Sun, 5 Sep 2010 20:42:52 +0200 Subject: [PATCH 293/348] org-icalendar.el: exclude tags from the summary of the ical entry. This was reported by Guy Wiener <wiener.guy@gmail.com>. http://article.gmane.org/gmane.emacs.orgmode/29819 --- lisp/org-icalendar.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el index 4f307c487..5faea0eb3 100644 --- a/lisp/org-icalendar.el +++ b/lisp/org-icalendar.el @@ -311,7 +311,9 @@ When COMBINE is non nil, add the category to each line." inc t hd (condition-case nil (org-icalendar-cleanup-string - (org-get-heading)) + (replace-regexp-in-string + ":[[:alnum:]_@#%:]+:[ \t]*$" "" + (org-get-heading))) (error (throw :skip nil))) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) From 1a34708ade9934ec303f02e447f124e202b05ff3 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Sun, 5 Sep 2010 13:04:58 -0600 Subject: [PATCH 294/348] Babel: org-babel-map-src-blocks now sets a variety of local variables * lisp/ob.el (org-babel-map-src-blocks): now exposes much information about the code block in the form of let-bound local variables. --- lisp/ob.el | 39 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 20b0c9a41..c232da8d2 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -728,8 +728,26 @@ portions of results lines." 'org-babel-show-result-all 'append 'local))) (defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE. If FILE is -nil evaluate BODY forms on source blocks in current buffer." + "Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body" (declare (indent 1)) `(let ((visited-p (or (null ,file) (get-file-buffer (expand-file-name ,file)))) @@ -740,7 +758,22 @@ nil evaluate BODY forms on source blocks in current buffer." (goto-char (point-min)) (while (re-search-forward org-babel-src-block-regexp nil t) (goto-char (match-beginning 0)) - (save-match-data ,@body) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-beginning 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + (save-match-data ,@body)) (goto-char (match-end 0)))) (unless visited-p (kill-buffer to-be-removed)) From 3ec475027162b6f42c33dfd8ccbacc1a07071e87 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Sun, 5 Sep 2010 21:09:50 +0200 Subject: [PATCH 295/348] Third fix for the time-grid problem. Hopefully the last one. See commit 7b188f7d. Reported by Memnon Anon <gegendosenfleisch@googlemail.com>. --- lisp/org-agenda.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 3a6434475..32c65dbef 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -5117,7 +5117,7 @@ The modified list may contain inherited tags, and tags matched by (throw 'exit list)) (while (setq time (pop gridtimes)) (unless (and remove (member time have)) - (setq time (format "%4d" time)) + (setq time (replace-regexp-in-string " " "0" (format "%4s" time))) (push (org-format-agenda-item nil string "" nil (concat (substring time 0 -2) ":" (substring time -2))) From dbe5c6031a0c82742b30d97021b8bded2514bdd5 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Sun, 5 Sep 2010 21:13:03 +0200 Subject: [PATCH 296/348] Revert "org-icalendar.el: exclude tags from the summary of the ical entry." This reverts commit 373224ecdbd32a6e7ed523e28b581f637a7b1621. --- lisp/org-icalendar.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el index 5faea0eb3..4f307c487 100644 --- a/lisp/org-icalendar.el +++ b/lisp/org-icalendar.el @@ -311,9 +311,7 @@ When COMBINE is non nil, add the category to each line." inc t hd (condition-case nil (org-icalendar-cleanup-string - (replace-regexp-in-string - ":[[:alnum:]_@#%:]+:[ \t]*$" "" - (org-get-heading))) + (org-get-heading)) (error (throw :skip nil))) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) From 108f2f28579f46b1535252f94faac456a4d5b757 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Sun, 5 Sep 2010 21:18:36 +0200 Subject: [PATCH 297/348] Exclude tags from the summary of ical entries * org-icalendar.el (org-print-icalendar-entries): Exclude tags from summary of non-TODO ical entries. (org-print-icalendar-entries): Use `org-complex-heading-regexp' to exclude tags from summary of TODO ical entries. --- lisp/org-icalendar.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el index 4f307c487..c374e2eed 100644 --- a/lisp/org-icalendar.el +++ b/lisp/org-icalendar.el @@ -311,7 +311,7 @@ When COMBINE is non nil, add the category to each line." inc t hd (condition-case nil (org-icalendar-cleanup-string - (org-get-heading)) + (org-get-heading t)) (error (throw :skip nil))) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) @@ -439,7 +439,7 @@ END:VEVENT\n" (when org-icalendar-include-todo (setq prefix "TODO-") (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) + (while (re-search-forward org-complex-heading-regexp nil t) (catch :skip (org-agenda-skip) (when org-icalendar-verify-function @@ -471,7 +471,7 @@ END:VEVENT\n" ((eq org-icalendar-include-todo t) ;; include everything that is not done (member state org-not-done-keywords)))) - (setq hd (match-string 3) + (setq hd (match-string 4) summary (org-icalendar-cleanup-string (org-entry-get nil "SUMMARY")) desc (org-icalendar-cleanup-string From 0bb2e3005c5e0a28eb8795538bace74a429037f1 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Sun, 5 Sep 2010 14:21:58 -0600 Subject: [PATCH 298/348] tangling documentation -- Thanks to Jambunathan K. for new wording * doc/org.texi (comments): improved wording --- doc/org.texi | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 3b0334fd3..30cf301b9 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11906,8 +11906,10 @@ original Org file from which the code was tangled. @item @code{yes} A synonym for ``link'' to maintain backwards compatibility. @item @code{org} -Include text from the original org-mode file which preceded the code block as -a comment which precedes the tangled code. +Include text from the org-mode file as a comment. + +The text is picked from the leading context of the tangled code and is +limited by the nearest headline or source block as the case may be. @item @code{both} Turns on both the ``link'' and ``org'' comment options. @end itemize From 872d401fb375695ad53c9762a08d3be65df7c616 Mon Sep 17 00:00:00 2001 From: Bastien <bastien.guerry@wikimedia.fr> Date: Fri, 3 Sep 2010 01:19:35 +0000 Subject: [PATCH 299/348] Use `C-c C-x _' for interactively calling `org-timer-stop' Unless I missed something, `org-timer-stop' has no keybinding yet. I propose to use `C-c C-x _'. Is that okay for everyone? --- lisp/org.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org.el b/lisp/org.el index 26acc6917..a814cf4da 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -16385,6 +16385,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-c\C-x." 'org-timer) (org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) (org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) +(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop) (org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) (define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) From bd8a0a6f395d83fb8c15a5c0feeb4ee60093ff40 Mon Sep 17 00:00:00 2001 From: Achim Gratz <Stromeko@stromeko.net> Date: Fri, 27 Aug 2010 22:56:43 +0000 Subject: [PATCH 300/348] inside table, delete-backward-char must not insert spaces when overwrite mode is on * lisp/org.el (org-delete-backward-char): check for nil overwrite-mode before inserting spaces. TINYCHANGE There's probably a different/better way to do this, but this seemed the least intrusive. This patch is in the public domain. --- lisp/org.el | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index a814cf4da..09281cccd 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -16574,9 +16574,11 @@ because, in this case the deletion might narrow the column." (noalign (looking-at "[^|\n\r]* |")) (c org-table-may-need-update)) (backward-delete-char N) - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)) + (if (not overwrite-mode) + (progn + (skip-chars-forward "^|") + (insert " ") + (goto-char (1- pos)))) ;; noalign: if there were two spaces at the end, this field ;; does not determine the width of the column. (if noalign (setq org-table-may-need-update c))) From e13843ef6516f72bc0a322792bf3368643e72af9 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Sun, 5 Sep 2010 22:59:07 +0200 Subject: [PATCH 301/348] Keep byte compiler happy. --- lisp/org-clock.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 3328609fe..aecea4e93 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -35,6 +35,7 @@ (require 'cl)) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) +(declare-function notifications-notify "notifications" ()) (defvar org-time-stamp-formats) (defgroup org-clock nil @@ -558,6 +559,7 @@ use libnotify if available, or fall back on a message." (start-process "emacs-timer-notification" nil org-show-notification-handler notification)) ((featurep 'notifications) + (require 'notifications) (notifications-notify :title "Org-mode message" :body notification From ee801fd88cd77e8e2cb9415560ed6dcc17d4349d Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Sun, 5 Sep 2010 15:12:43 -0600 Subject: [PATCH 302/348] ob-tangle: customizable link formats in tangled comments * lisp/ob-tangle.el (org-babel-tangle-comment-format-beg): format string specifying the link-comment preceding a code block (org-babel-tangle-comment-format-end): format string specifying the link-comment following a code block (org-babel-tangle-collect-blocks): storing more information in the spec of a tangling code block (org-babel-spec-to-string): now makes use of customizable link-comment formats --- lisp/ob-tangle.el | 78 ++++++++++++++++++++++++++++++++++------------- 1 file changed, 57 insertions(+), 21 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 70291514c..567490919 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -35,6 +35,7 @@ (declare-function org-link-escape "org" (text &optional table)) (declare-function org-heading-components "org" ()) (declare-function org-back-to-heading "org" (invisible-ok)) +(declare-function org-fill-template "org" (template alist)) (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) @@ -64,6 +65,28 @@ then the name of the language is used." :group 'org-babel :type 'boolean) +(defcustom org-babel-tangle-comment-format-beg "[[%link][%sourcename]]" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block" + :group 'org-babel + :type 'string) + +(defcustom org-babel-tangle-comment-format-end "%sourcename ends here" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block" + :group 'org-babel + :type 'string) + (defun org-babel-find-file-noselect-refresh (file) "Find file ensuring that the latest changes on disk are represented in the file." @@ -163,7 +186,7 @@ exported source code blocks by language." (mapc (lambda (spec) (flet ((get-spec (name) - (cdr (assoc name (nth 2 spec))))) + (cdr (assoc name (nth 4 spec))))) (let* ((tangle (get-spec :tangle)) (she-bang ((lambda (sheb) (when (> (length sheb) 0) sheb)) (get-spec :shebang))) @@ -248,7 +271,10 @@ code blocks by language." (condition-case nil (nth 4 (org-heading-components)) (error (buffer-file-name))))) - (let* ((link (progn (call-interactively 'org-store-link) + (let* ((start-line (save-restriction (widen) + (+ 1 (line-number-at-pos (point))))) + (file (buffer-file-name)) + (link (progn (call-interactively 'org-store-link) (org-babel-clean-text-properties (car (pop org-stored-links))))) (info (org-babel-get-src-block-info)) @@ -289,7 +315,8 @@ code blocks by language." (setq blocks (delq (assoc src-lang blocks) blocks)) (setq blocks (cons (cons src-lang - (cons (list link source-name params body comment) + (cons (list start-line file link + source-name params body comment) by-lang)) blocks)))))) ;; ensure blocks in the correct order (setq blocks @@ -305,30 +332,39 @@ source code file. This function uses `comment-region' which assumes that the appropriate major-mode is set. SPEC has the form - (link source-name params body comment)" - (let* ((link (org-link-escape (nth 0 spec))) - (source-name (nth 1 spec)) - (body (nth 3 spec)) - (comment (nth 4 spec)) - (comments (cdr (assoc :comments (nth 2 spec)))) + (start-line file link source-name params body comment)" + (let* ((start-line (nth 0 spec)) + (file (nth 1 spec)) + (link (org-link-escape (nth 2 spec))) + (source-name (nth 3 spec)) + (body (nth 5 spec)) + (comment (nth 6 spec)) + (comments (cdr (assoc :comments (nth 4 spec)))) (link-p (or (string= comments "both") (string= comments "link") - (string= comments "yes")))) + (string= comments "yes"))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + ((lambda (le) + (if (stringp le) le (format "%S" le))) + (eval el)))) + '(start-line file link source-name)))) (flet ((insert-comment (text) - (when (and comments (not (string= comments "no"))) - (when org-babel-tangle-pad-newline - (insert "\n")) - (comment-region (point) - (progn - (insert (org-babel-trim text)) - (point))) - (end-of-line nil) - (insert "\n")))) + (let ((text (org-babel-trim text))) + (when (and comments (not (string= comments "no")) + (> (length text) 0)) + (when org-babel-tangle-pad-newline (insert "\n")) + (comment-region (point) (progn (insert text) (point))) + (end-of-line nil) (insert "\n"))))) (when comment (insert-comment comment)) - (when link-p (insert-comment (format "[[%s][%s]]" link source-name))) + (when link-p + (insert-comment + (org-fill-template org-babel-tangle-comment-format-beg link-data))) (when org-babel-tangle-pad-newline (insert "\n")) (insert (format "%s\n" (replace-regexp-in-string "^," "" (org-babel-trim body)))) - (when link-p (insert-comment (format "%s ends here" source-name)))))) + (when link-p + (insert-comment + (org-fill-template org-babel-tangle-comment-format-end link-data)))))) (provide 'ob-tangle) From 07250ec74af3e47121776da4aee045eb650ba9f6 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Sun, 5 Sep 2010 19:29:28 -0600 Subject: [PATCH 303/348] tangle: rename `lang' variable to `language' so it is not overridden - this is required due to recent changes to org-babel-map-src-blocks - thanks to Dan for pointing this out * lisp/ob-tangle.el (org-babel-tangle-collect-blocks): rename `lang' to `language' --- lisp/ob-tangle.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index 567490919..de9109450 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -253,7 +253,7 @@ references." (save-excursion (end-of-line 1) (forward-char 1) (point))))) (defvar org-stored-links) -(defun org-babel-tangle-collect-blocks (&optional lang) +(defun org-babel-tangle-collect-blocks (&optional language) "Collect source blocks in the current Org-mode file. Return an association list of source-code block specifications of the form used by `org-babel-spec-to-string' grouped by language. @@ -308,8 +308,8 @@ code blocks by language." (match-end 0))) (point)))) by-lang) - (unless (string= (cdr (assoc :tangle params)) "no") ;; skip - (unless (and lang (not (string= lang src-lang))) ;; limit by language + (unless (string= (cdr (assoc :tangle params)) "no") + (unless (and language (not (string= language src-lang))) ;; add the spec for this block to blocks under it's language (setq by-lang (cdr (assoc src-lang blocks))) (setq blocks (delq (assoc src-lang blocks) blocks)) From 86f4ef6d1925cb482462c76ef62af6a6ce358550 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Mon, 6 Sep 2010 13:14:36 +0200 Subject: [PATCH 304/348] Fix bug in ASCII export: correctly set the `type' variable. * org-ascii.el (org-export-as-ascii): Fix bug in ASCII export: use `org-bracket-link-analytic-regexp++' to match the link type. --- lisp/org-ascii.el | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index 8bb8b5aa2..a7b8801cb 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -311,7 +311,7 @@ publishing directory." :add-text (plist-get opt-plist :text)) "\n")) thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link desc desc0 rpl wrap fnc) + table-open table-buffer link-buffer link type desc desc0 rpl wrap fnc) (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) @@ -347,7 +347,7 @@ publishing directory." (if (and (or author email) org-export-author-info) - (insert(concat (nth 1 lang-words) ": " (or author "") + (insert (concat (nth 1 lang-words) ": " (or author "") (if (and org-export-email-info email (string-match "\\S-" email)) (concat " <" email ">") "") @@ -431,10 +431,11 @@ publishing directory." ;; Remove the quoted HTML tags. (setq line (org-html-expand-for-ascii line)) ;; Replace links with the description when possible - (while (string-match org-bracket-link-regexp line) - (setq link (match-string 1 line) - desc0 (match-string 3 line) - desc (or desc0 (match-string 1 line))) + (while (string-match org-bracket-link-analytic-regexp++ line) + (setq link (concat (match-string 1 line) (match-string 3 line)) + type (match-string 1 line) + desc0 (match-string 5 line) + desc (or desc0 link)) (if (and (> (length link) 8) (equal (substring link 0 8) "coderef:")) (setq line (replace-match @@ -443,9 +444,7 @@ publishing directory." (substring link 8) org-export-code-refs))) t t line)) - (setq rpl (concat "[" - (or (match-string 3 line) (match-string 1 line)) - "]")) + (setq rpl (concat "[" desc "]")) (if (functionp (setq fnc (nth 2 (assoc type org-link-protocols)))) (setq rpl (or (save-match-data (funcall fnc (org-link-unescape path) From 7c73bf1f74872725e6684d07e51908d8edf9769a Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Mon, 6 Sep 2010 22:20:46 +0200 Subject: [PATCH 305/348] Remove bzg-test function. --- lisp/org-timer.el | 4 ---- 1 file changed, 4 deletions(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 313d4f01e..0ffe67de9 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -322,10 +322,6 @@ VALUE can be `on', `off', or `pause'." (message "%d minute(s) %d seconds left before next time out" rmins rsecs)))) -(defun bzg-test (&optional test) - (interactive "P") - test) - ;;;###autoload (defun org-timer-set-timer (&optional opt) "Prompt for a duration and set a timer. From 413caacfd7ccfdcfad7980a87312b9c00ab96891 Mon Sep 17 00:00:00 2001 From: Bastien Guerry <bzg@altern.org> Date: Tue, 7 Sep 2010 02:28:06 +0200 Subject: [PATCH 306/348] Require org-clock.el where needed. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also declare org-notify instead of org-show-notification. This was reported by Łukasz Stelmach <lukasz.stelmach@iem.pw.edu.pl> See http://article.gmane.org/gmane.emacs.orgmode/29900 --- lisp/org-timer.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 0ffe67de9..b3fd6bfa2 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -31,7 +31,7 @@ (require 'org) -(declare-function org-show-notification "org-clock" (parameters)) +(declare-function org-notify "org-clock" (notification &optional play-sound)) (declare-function org-agenda-error "org-agenda" ()) (defvar org-timer-start-time nil @@ -374,6 +374,7 @@ replace any running timer." (y-or-n-p "Replace current timer? "))) (not org-timer-current-timer)) (progn + (require 'org-clock) (when org-timer-current-timer (cancel-timer org-timer-current-timer)) (setq org-timer-current-timer From 569ba0eee847406b70b345cae6e3e696f027a621 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Tue, 7 Sep 2010 12:42:15 -0400 Subject: [PATCH 307/348] Turn off code fontification by default; supply customize interface * org.el (org-src-fontify-natively): Set to nil by default. Supply cutomize interface. --- lisp/org.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 36b329c83..dfd6d79ac 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5022,8 +5022,11 @@ will be prompted for." '(display t invisible t intangible t)) t))) -(defvar org-src-fontify-natively t - "When non-nil, fontify code in code blocks.") +(defcustom org-src-fontify-natively nil + "When non-nil, fontify code in code blocks." + :type 'boolean + :group 'org-appearance + :group 'org-babel) (defun org-fontify-meta-lines-and-blocks (limit) "Fontify #+ lines and blocks, in the correct ways." From 7e8aec9c09d86b8a88238235689e51810882ee20 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 7 Sep 2010 18:55:46 +0200 Subject: [PATCH 308/348] Fix `org-list-insert-item-generic' when checkboxes are updated * org-list.el (org-list-insert-item-generic): Updating checkboxes can modifiy bottom point of a list, so make it a marker before calling `org-update-checkbox-count-maybe'. --- lisp/org-list.el | 3 +++ 1 file changed, 3 insertions(+) diff --git a/lisp/org-list.el b/lisp/org-list.el index b58a23d96..a5160c179 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -669,6 +669,9 @@ function ends." ;; recompute next-item: last sexp modified list (goto-char (org-get-next-item (point) bottom)) (org-move-to-column col))) + ;; checkbox update might modify bottom point, so use a + ;; marker here + (setq bottom (copy-marker bottom)) (when checkbox (org-update-checkbox-count-maybe)) (org-list-repair nil top bottom)))) (goto-char true-pos) From 0f44a6652360116424e3b88dcf6508e2b2472729 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 7 Sep 2010 19:06:03 +0200 Subject: [PATCH 309/348] Don't insert item when tree is folded * org-list.el (org-insert-item): check invisibility of point at a meaningful location. --- lisp/org-list.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a5160c179..ff6b80bfe 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1115,7 +1115,9 @@ If CHECKBOX is non-nil, add a checkbox next to the bullet. Return t when things worked, nil when we are not in an item, or item is invisible." (unless (or (not (org-in-item-p)) - (org-invisible-p)) + (save-excursion + (goto-char (org-get-item-beginning)) + (org-invisible-p))) (if (save-excursion (goto-char (org-get-item-beginning)) (org-at-item-timer-p)) From 82b7d0bf0786cb74dc3309f53d307e9b215e1d99 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Tue, 7 Sep 2010 19:55:30 +0200 Subject: [PATCH 310/348] Properly declare function to silence byte compiler * org-clock.el (notifications-notify): Properly declare function to silence byte compiler. --- lisp/org-clock.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index aecea4e93..8979396fe 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -35,7 +35,7 @@ (require 'cl)) (declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) -(declare-function notifications-notify "notifications" ()) +(declare-function notifications-notify "notifications" (&rest params)) (defvar org-time-stamp-formats) (defgroup org-clock nil From 510ada442ed65e1e8f65a54849036e19bbbd023a Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Tue, 7 Sep 2010 20:04:35 +0200 Subject: [PATCH 311/348] Bind and set link path for link type specific markup function * org-ascii.el (org-export-as-ascii): Bind and set link path for link type specific markup function. --- lisp/org-ascii.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index a7b8801cb..997870871 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -311,7 +311,7 @@ publishing directory." :add-text (plist-get opt-plist :text)) "\n")) thetoc have-headings first-heading-pos - table-open table-buffer link-buffer link type desc desc0 rpl wrap fnc) + table-open table-buffer link-buffer link type path desc desc0 rpl wrap fnc) (let ((inhibit-read-only t)) (org-unmodified (remove-text-properties (point-min) (point-max) @@ -432,7 +432,8 @@ publishing directory." (setq line (org-html-expand-for-ascii line)) ;; Replace links with the description when possible (while (string-match org-bracket-link-analytic-regexp++ line) - (setq link (concat (match-string 1 line) (match-string 3 line)) + (setq path (match-string 3 line) + link (concat (match-string 1 line) path) type (match-string 1 line) desc0 (match-string 5 line) desc (or desc0 link)) From 1ebb9131ef0b0dbecdf08f88fdafbf6136952016 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 7 Sep 2010 16:58:39 -0600 Subject: [PATCH 312/348] Babel: remove existing results when nil results are returned MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Thanks to Sébastien Vauban for making the case for this behavior * lisp/ob.el (org-babel-insert-result): remove existing results when nil results are returned --- lisp/ob.el | 136 ++++++++++++++++++++++++++--------------------------- 1 file changed, 68 insertions(+), 68 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index c232da8d2..9c0338302 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1275,76 +1275,76 @@ code ---- the results are extracted in the syntax of the source (when (member "file" result-params) (setq result (org-babel-result-to-file result)))) (unless (listp result) (setq result (format "%S" result)))) - (if (= (length result) 0) - (if (member "value" result-params) - (message "No result returned by source block") - (message "Source block produced no output")) - (if (and result-params (member "silent" result-params)) - (progn - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) - result) - (when (and (stringp result) ;; ensure results end in a newline - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) - (save-excursion - (let ((existing-result (org-babel-where-is-src-block-result - t info hash indent)) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - beg end) - (if (not existing-result) - (setq beg (point)) - (goto-char existing-result) - (save-excursion - (re-search-forward "#" nil t) - (setq indent (- (current-column) 1))) - (forward-line 1) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (when (and (stringp result) ;; ensure results end in a newline + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (save-excursion + (let ((existing-result (org-babel-where-is-src-block-result + t info hash indent)) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + beg end) + (if (not existing-result) (setq beg (point)) - (cond - ((member "replace" result-params) - (delete-region (point) (org-babel-result-end))) - ((member "append" result-params) - (goto-char (org-babel-result-end)) (setq beg (point))) - ((member "prepend" result-params) ;; already there - ))) - (setq results-switches - (if results-switches (concat " " results-switches) "")) + (goto-char existing-result) + (save-excursion + (re-search-forward "#" nil t) + (setq indent (- (current-column) 1))) + (forward-line 1) + (setq beg (point)) (cond - ;; assume the result is a table if it's not a string - ((not (stringp result)) - (insert (concat (orgtbl-to-orgtbl - (if (or (eq 'hline (car result)) - (and (listp (car result)) - (listp (cdr (car result))))) - result (list result)) - '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((member "file" result-params) - (insert result)) - ((member "html" result-params) - (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" - results-switches result))) - ((member "latex" result-params) - (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" - results-switches result))) - ((member "code" result-params) - (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" - (or lang "none") results-switches result))) - ((member "org" result-params) - (insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result))) - ((member "raw" result-params) - (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) - (t - (org-babel-examplize-region - (point) (progn (insert result) (point)) results-switches))) - ;; possibly indent the results to match the #+results line - (setq end (if (listp result) (org-table-end) (point))) - (when (and indent (> indent 0) - ;; in this case `table-align' does the work for us - (not (and (listp result) - (member "append" result-params)))) - (indent-rigidly beg end indent)))) + ((member "replace" result-params) + (delete-region (point) (org-babel-result-end))) + ((member "append" result-params) + (goto-char (org-babel-result-end)) (setq beg (point))) + ((member "prepend" result-params) ;; already there + ))) + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (cond + ;; assume the result is a table if it's not a string + ((not (stringp result)) + (insert (concat (orgtbl-to-orgtbl + (if (or (eq 'hline (car result)) + (and (listp (car result)) + (listp (cdr (car result))))) + result (list result)) + '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) + (goto-char beg) (when (org-at-table-p) (org-table-align))) + ((member "file" result-params) + (insert result)) + ((member "html" result-params) + (insert (format "#+BEGIN_HTML%s\n%s#+END_HTML\n" + results-switches result))) + ((member "latex" result-params) + (insert (format "#+BEGIN_LaTeX%s\n%s#+END_LaTeX\n" + results-switches result))) + ((member "code" result-params) + (insert (format "#+BEGIN_SRC %s%s\n%s#+END_SRC\n" + (or lang "none") results-switches result))) + ((member "org" result-params) + (insert (format "#+BEGIN_SRC org\n%s#+END_SRC\n" result))) + ((member "raw" result-params) + (save-excursion (insert result)) (if (org-at-table-p) (org-cycle))) + (t + (org-babel-examplize-region + (point) (progn (insert result) (point)) results-switches))) + ;; possibly indent the results to match the #+results line + (setq end (if (listp result) (org-table-end) (point))) + (when (and indent (> indent 0) + ;; in this case `table-align' does the work for us + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)))) + (if (= (length result) 0) + (if (member "value" result-params) + (message "No result returned by source block") + (message "Source block produced no output")) (message "finished")))) (defun org-babel-remove-result (&optional info) From dd9d42f5159c3f0d5c0dce4885f6e47a2801a382 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 7 Sep 2010 18:47:11 -0600 Subject: [PATCH 313/348] ob-org: evaluates body to latex ascii or html respecting :results header arg * lisp/ob-org.el (org-babel-execute:org): evaluates body to latex ascii or html respecting :results header arg (org-babel-org-export): exports a string of text to an output format --- lisp/ob-org.el | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/lisp/ob-org.el b/lisp/ob-org.el index a3e77302e..26000afab 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -30,6 +30,9 @@ ;;; Code: (require 'ob) +(declare-function org-load-modules-maybe "org" (&optional force)) +(declare-function org-get-local-variables "org" ()) + (defvar org-babel-default-header-args:org '((:results . "raw silent") (:exports . "results")) "Default arguments for evaluating a org source block.") @@ -40,7 +43,27 @@ (defun org-babel-execute:org (body params) "Execute a block of Org code with. This function is called by `org-babel-execute-src-block'." - body) + (let ((result-params (split-string (or (cdr (assoc :results params)) "")))) + (cond + ((member "latex" result-params) (org-babel-org-export body "latex")) + ((member "html" result-params) (org-babel-org-export body "html")) + ((member "ascii" result-params) (org-babel-org-export body "ascii")) + (t body)))) + +(defvar org-local-vars) +(defun org-babel-org-export (body fmt) + "Export BODY to FMT using Org-mode's export facilities. " + (let ((tmp-file (org-babel-temp-file "org-"))) + (with-temp-buffer + (insert body) + (write-file tmp-file) + (org-load-modules-maybe) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) + (eval ;; convert to fmt -- mimicing `org-run-like-in-org-mode' + (list 'let org-local-vars + (list (intern (concat "org-export-as-" fmt)) + nil nil nil ''string t)))))) (defun org-babel-prep-session:org (session params) "Return an error because org does not support sessions." From 7127eb44c1848c8942d13eff8f96ba78359c7230 Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Tue, 7 Sep 2010 21:58:58 -0400 Subject: [PATCH 314/348] babel: python: refactor `org-babel-python-evaluate' * ob-python.el (org-babel-python-evaluate): Refactor as call to either `org-babel-python-evaluate-external-process' or `org-babel-python-evaluate-session'. (org-babel-python-evaluate-external-process): New function to handle evaluation in external process. (org-babel-python-evaluate-session): New function to handle evaluation in emacs inferior process. --- lisp/ob-python.el | 148 +++++++++++++++++++++++++--------------------- 1 file changed, 81 insertions(+), 67 deletions(-) diff --git a/lisp/ob-python.el b/lisp/ob-python.el index a96840380..1d2e8f577 100644 --- a/lisp/ob-python.el +++ b/lisp/ob-python.el @@ -194,73 +194,87 @@ def main(): open('%s', 'w').write( pprint.pformat(main()) )") (defun org-babel-python-evaluate - (buffer body &optional result-type result-params) - "Pass BODY to the Python process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY, as elisp." - (if (not buffer) - ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-python-command body)) - (value (let ((tmp-file (org-babel-temp-file "python-results-"))) - (org-babel-eval org-babel-python-command - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - tmp-file)) - ((lambda (raw) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-python-table-or-string raw))) - (org-babel-eval-read-file tmp-file))))) - ;; comint session evaluation - (flet ((dump-last-value (tmp-file pp) - (mapc - (lambda (statement) (insert statement) (comint-send-input)) - (if pp - (list - "import pp" - (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file)) - (list (format "open('%s', 'w').write(str(_))" tmp-file))))) - (input-body (body) - (mapc (lambda (statement) (insert statement) (comint-send-input)) - (split-string (org-babel-trim body) "[\r\n]+")) - (comint-send-input) (comint-send-input))) - (case result-type - (output - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (buffer org-babel-python-eoe-indicator t body) - (let ((comint-process-echoes nil)) - (input-body body) - (insert org-babel-python-eoe-indicator) - (comint-send-input))) 2) "\n")) - (value - ((lambda (results) - (if (or (member "code" result-params) (member "pp" result-params)) - results - (org-babel-python-table-or-string results))) - (let ((tmp-file (org-babel-temp-file "python-results-"))) - (org-babel-comint-with-output - (buffer org-babel-python-eoe-indicator t body) - (let ((comint-process-echoes nil)) - (input-body body) - (dump-last-value tmp-file (member "pp" result-params)) - (comint-send-input) (comint-send-input) - (insert org-babel-python-eoe-indicator) - (comint-send-input))) - (org-babel-eval-read-file tmp-file)))))))) + (session body &optional result-type result-params) + "Evaluate BODY as python code." + (if session + (org-babel-python-evaluate-session + session body result-type result-params) + (org-babel-python-evaluate-external-process + body result-type result-params))) + +(defun org-babel-python-evaluate-external-process + (body &optional result-type result-params) + "Evaluate BODY in external python process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (output (org-babel-eval org-babel-python-command body)) + (value (let ((tmp-file (org-babel-temp-file "python-results-"))) + (org-babel-eval org-babel-python-command + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + tmp-file)) + ((lambda (raw) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-python-table-or-string raw))) + (org-babel-eval-read-file tmp-file)))))) + +(defun org-babel-python-evaluate-session + (session body &optional result-type result-params) + "Pass BODY to the Python process in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (flet ((dump-last-value + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (comint-send-input)) + (if pp + (list + "import pp" + (format "open('%s', 'w').write(pprint.pformat(_))" tmp-file)) + (list (format "open('%s', 'w').write(str(_))" tmp-file))))) + (input-body (body) + (mapc (lambda (statement) (insert statement) (comint-send-input)) + (split-string (org-babel-trim body) "[\r\n]+")) + (comint-send-input) (comint-send-input))) + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) 2) "\n")) + (value + ((lambda (results) + (if (or (member "code" result-params) (member "pp" result-params)) + results + (org-babel-python-table-or-string results))) + (let ((tmp-file (org-babel-temp-file "python-results-"))) + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (let ((comint-process-echoes nil)) + (input-body body) + (dump-last-value tmp-file (member "pp" result-params)) + (comint-send-input) (comint-send-input) + (insert org-babel-python-eoe-indicator) + (comint-send-input))) + (org-babel-eval-read-file tmp-file))))))) (defun org-babel-python-read-string (string) "Strip 's from around python string" From 5bdea686ed69c7dc14e512f13bff344f1378370a Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 7 Sep 2010 23:23:08 -0600 Subject: [PATCH 315/348] ob-plantuml: raises an error when the :file header argument is not set * lisp/ob-plantuml.el (org-babel-execute:plantuml): --- lisp/ob-plantuml.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob-plantuml.el b/lisp/ob-plantuml.el index cf1d9cc43..b1814cfe6 100644 --- a/lisp/ob-plantuml.el +++ b/lisp/ob-plantuml.el @@ -54,7 +54,8 @@ "Execute a block of plantuml code with org-babel. This function is called by `org-babel-execute-src-block'." (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) + (out-file (or (cdr (assoc :file params)) + (error "plantuml requires a \":file\" header argument"))) (cmdline (cdr (assoc :cmdline params))) (in-file (org-babel-temp-file "plantuml-")) (cmd (if (not org-plantuml-jar-path) From 58fe37129900a6a34e19df504f63a83cdcdee0ee Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 7 Sep 2010 23:50:27 -0600 Subject: [PATCH 316/348] org-exp-blocks now expands blocks *after* including files * lisp/org-exp-blocks.el (org-export-preprocess-after-include-files-hook): now using this hook instead of `org-export-preprocess-hook' --- lisp/org-exp-blocks.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el index b9c6fc1ab..430d7d56a 100644 --- a/lisp/org-exp-blocks.el +++ b/lisp/org-exp-blocks.el @@ -201,7 +201,8 @@ which defaults to the value of `org-export-blocks-witheld'." (interblock start (point-max)) (run-hooks 'org-export-blocks-postblock-hook))))) -(add-hook 'org-export-preprocess-hook 'org-export-blocks-preprocess) +(add-hook 'org-export-preprocess-after-include-files-hook + 'org-export-blocks-preprocess) ;;================================================================================ ;; type specific functions From e92a4b08138b929a7ba1be7553ea73d4117acbe9 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Tue, 7 Sep 2010 23:59:04 -0600 Subject: [PATCH 317/348] ob: better error messages when searches for code blocks fail * lisp/ob.el (org-babel-next-src-block): now raising more informative error when no further code blocks can be found (org-babel-previous-src-block): now raising more informative error when no previous code blocks can be found --- lisp/ob.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 9c0338302..f7d705041 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1097,7 +1097,9 @@ buffer or nil if no such result exists." With optional prefix argument ARG, jump forward ARG many source blocks." (interactive "P") (when (looking-at org-babel-src-block-regexp) (forward-char 1)) - (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (condition-case nil + (re-search-forward org-babel-src-block-regexp nil nil (or arg 1)) + (error (error "No further code blocks"))) (goto-char (match-beginning 0)) (org-show-context)) ;;;###autoload @@ -1105,7 +1107,9 @@ With optional prefix argument ARG, jump forward ARG many source blocks." "Jump to the previous source block. With optional prefix argument ARG, jump backward ARG many source blocks." (interactive "P") - (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (condition-case nil + (re-search-backward org-babel-src-block-regexp nil nil (or arg 1)) + (error (error "No previous code blocks"))) (goto-char (match-beginning 0)) (org-show-context)) (defvar org-babel-lob-one-liner-regexp) From 7dd72699a932fb93de28ee902b7f48b15606ba87 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 00:13:12 -0600 Subject: [PATCH 318/348] a new function for jumping to the head of the current code block * lisp/ob-keys.el (org-babel-key-bindings): adding key-binding for `org-babel-goto-src-block-head' * lisp/ob.el (org-babel-goto-src-block-head): jump to the head of the current code block --- lisp/ob-keys.el | 2 ++ lisp/ob.el | 8 ++++++++ 2 files changed, 10 insertions(+) diff --git a/lisp/ob-keys.el b/lisp/ob-keys.el index 5ed8967ac..ff730c674 100644 --- a/lisp/ob-keys.el +++ b/lisp/ob-keys.el @@ -58,6 +58,8 @@ functions which are assigned key bindings, and see ("\C-o" . org-babel-open-src-block-result) ("\C-v" . org-babel-expand-src-block) ("v" . org-babel-expand-src-block) + ("u" . org-babel-goto-src-block-head) + ("\C-u" . org-babel-goto-src-block-head) ("g" . org-babel-goto-named-src-block) ("r" . org-babel-goto-named-result) ("\C-r" . org-babel-goto-named-result) diff --git a/lisp/ob.el b/lisp/ob.el index f7d705041..f367f5250 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1021,6 +1021,14 @@ If the point is not on a source block then return nil." (looking-at org-babel-src-block-regexp)) (point)))))) +;;;###autoload +(defun org-babel-goto-src-block-head () + "Go to the beginning of the current code block." + (interactive) + ((lambda (head) + (if head (goto-char head) (error "not currently in a code block"))) + (org-babel-where-is-src-block-head))) + ;;;###autoload (defun org-babel-goto-named-src-block (name) "Go to a named source-code block." From 14fc5cc1b9335cbc4fce0a619faaa4a70f5159b5 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 00:21:46 -0600 Subject: [PATCH 319/348] adding new Babel key sequences to the org refcard * doc/orgcard.tex: adding new Babel key sequences to the org refcard --- doc/orgcard.tex | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/orgcard.tex b/doc/orgcard.tex index 810850e9d..2430c3366 100644 --- a/doc/orgcard.tex +++ b/doc/orgcard.tex @@ -480,8 +480,10 @@ formula, \kbd{:=} a field formula. \key{view expanded body of code block at point}{C-c C-v v} \key{go to named code block}{C-c C-v g} \key{go to named result}{C-c C-v r} +\key{go to the head of the current code block}{C-c C-v u} \key{go to the next code block}{C-c C-v n} \key{go to the previous code block}{C-c C-v p} +\key{execute the next key sequence in the code edit buffer}{C-c C-v x} \key{execute all code blocks in current buffer}{C-c C-v b} \key{execute all code blocks in current subtree}{C-c C-v s} \key{tangle code blocks in current file}{C-c C-v t} From 0e1ff9ddbc3ef16f8f1186cc14fcda18948c4dca Mon Sep 17 00:00:00 2001 From: Dan Davison <davison@stats.ox.ac.uk> Date: Wed, 8 Sep 2010 13:25:56 -0400 Subject: [PATCH 320/348] `org-babel-do-in-edit-buffer': more lightweight test of context * ob.el (org-babel-do-in-edit-buffer): Use `org-babel-where-is-src-block-head' to test for source block at point. --- lisp/ob.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index f367f5250..c57e10d80 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -510,7 +510,8 @@ with a prefix argument then this is passed on to "Evaluate BODY in edit buffer if there is a code block at point. Return t if a code block was found at point, nil otherwise." `(let ((org-src-window-setup 'switch-invisibly)) - (when (org-edit-src-code nil nil nil 'quietly) + (when (and (org-babel-where-is-src-block-head) + (org-edit-src-code nil nil nil 'quietly)) (unwind-protect (progn ,@body) (if (org-bound-and-true-p org-edit-src-from-org-mode) (org-edit-src-exit))) From 207390dfa8e1eb1f9a76dad6db832965ab7f3ae6 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 11:33:24 -0600 Subject: [PATCH 321/348] autoload org-babel-tangle-lang-exts from ob-tangle * lisp/ob-tangle.el: autoload org-babel-tangle-lang-exts from ob-tangle --- lisp/ob-tangle.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/ob-tangle.el b/lisp/ob-tangle.el index de9109450..88a6a5670 100644 --- a/lisp/ob-tangle.el +++ b/lisp/ob-tangle.el @@ -37,6 +37,7 @@ (declare-function org-back-to-heading "org" (invisible-ok)) (declare-function org-fill-template "org" (template alist)) +;;;###autoload (defcustom org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "Alist mapping languages to their file extensions. From 8ca802166b1635cd15e399d6f5395331600e6618 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 11:50:44 -0600 Subject: [PATCH 322/348] Babel no longer throws error when inserting an empty result MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Thanks to Sébastien Vauban for pointing this out * lisp/ob.el (org-babel-insert-result): no longer throws error when inserting an empty result --- lisp/ob.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ob.el b/lisp/ob.el index c57e10d80..cdc4f28a7 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1293,6 +1293,7 @@ code ---- the results are extracted in the syntax of the source (message (replace-regexp-in-string "%" "%%" (format "%S" result))) result) (when (and (stringp result) ;; ensure results end in a newline + (> (length result) 0) (not (or (string-equal (substring result -1) "\n") (string-equal (substring result -1) "\r")))) (setq result (concat result "\n"))) @@ -1320,6 +1321,8 @@ code ---- the results are extracted in the syntax of the source (setq results-switches (if results-switches (concat " " results-switches) "")) (cond + ;; do nothing for an empty result + ((= (length result) 0)) ;; assume the result is a table if it's not a string ((not (stringp result)) (insert (concat (orgtbl-to-orgtbl @@ -1412,7 +1415,7 @@ file's directory then expand relative links." (let ((size (count-lines beg end))) (save-excursion (cond ((= size 0) - (error (concat "This should be impossible:" + (error (concat "This should not be impossible:" "a newline was appended to result if missing"))) ((< size org-babel-min-lines-for-block-output) (goto-char beg) From 3c8dc1eb52f0066a57ea4b47b15a9d7e757c2793 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 12:23:31 -0600 Subject: [PATCH 323/348] updating documentation to mention inline code block syntax * doc/org.texi (Structure of code blocks): updating documentation to mention inline code block syntax --- doc/org.texi | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/doc/org.texi b/doc/org.texi index 30cf301b9..3bfd187e2 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11050,6 +11050,18 @@ The structure of code blocks is as follows: #+end_src @end example +Code blocks can also be embedded in text as follows: + +@example +src_<language>@{<body>@} +@end example + +or + +@example +src_<language>[<header arguments>]@{<body>@} +@end example + @table @code @item <name> This name is associated with the code block. This is similar to the From f4fe989add020710584540233e895d9b9150b5fe Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 12:30:06 -0600 Subject: [PATCH 324/348] documentation tweak * doc/org.texi (Structure of code blocks): documentation tweak --- doc/org.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/org.texi b/doc/org.texi index 3bfd187e2..ee5515432 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11050,7 +11050,7 @@ The structure of code blocks is as follows: #+end_src @end example -Code blocks can also be embedded in text as follows: +code blocks can also be embedded in text as @example src_<language>@{<body>@} From 0c6f14f17d7dd0688d68d5c20cf571fdc138de13 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 14:28:49 -0600 Subject: [PATCH 325/348] another documentation tweak suggested by Rainer M Krug * doc/org.texi (Structure of code blocks): another documentation tweak --- doc/org.texi | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/doc/org.texi b/doc/org.texi index ee5515432..3aff2536e 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -11050,7 +11050,7 @@ The structure of code blocks is as follows: #+end_src @end example -code blocks can also be embedded in text as +code blocks can also be embedded in text as so called inline code blocks as @example src_<language>@{<body>@} From 24efe784d5758a29ead4ab33a3145a8934900dc7 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Thu, 9 Sep 2010 00:37:18 -0600 Subject: [PATCH 326/348] ob-org: no longer drop first line when exporting org code block * lisp/ob-org.el (org-babel-org-default-header): used to insert a dummy first line into code blocks before export so that the first line is not interpreted as a title (org-babel-org-export): use new dummy code block prefix --- lisp/ob-org.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/lisp/ob-org.el b/lisp/ob-org.el index 26000afab..4d42246f8 100644 --- a/lisp/ob-org.el +++ b/lisp/ob-org.el @@ -37,6 +37,10 @@ '((:results . "raw silent") (:exports . "results")) "Default arguments for evaluating a org source block.") +(defvar org-babel-org-default-header + "#+TITLE: default empty header\n" + "Default header inserted during export of org blocks.") + (defun org-babel-expand-body:org (body params &optional processed-params) "Expand BODY according to PARAMS, return the expanded body." body) @@ -55,6 +59,7 @@ This function is called by `org-babel-execute-src-block'." "Export BODY to FMT using Org-mode's export facilities. " (let ((tmp-file (org-babel-temp-file "org-"))) (with-temp-buffer + (insert org-babel-org-default-header) (insert body) (write-file tmp-file) (org-load-modules-maybe) From 87d0950f69902ec80f1f16f9790d08aa7140de02 Mon Sep 17 00:00:00 2001 From: aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local> Date: Thu, 9 Sep 2010 09:52:29 +0200 Subject: [PATCH 327/348] Get rid of TABs in menu lines, fix copyright line --- doc/org.texi | 1016 +++++++++++++++++++++++++------------------------- 1 file changed, 509 insertions(+), 507 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index 3aff2536e..d655e05e5 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -69,7 +69,8 @@ e.g., @copying This manual is for Org version @value{VERSION}. -Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation +Copyright @copyright{} 2004, 2005, 2006, 2007, 2008, 2009, 2010 +Free Software Foundation, Inc. @quotation Permission is granted to copy, distribute and/or modify this document @@ -119,409 +120,409 @@ with contributions by David O'Toole, Bastien Guerry, Philip Rooke, Dan Davison, @end ifnottex @menu -* Introduction:: Getting started -* Document Structure:: A tree works like your brain -* Tables:: Pure magic for quick formatting -* Hyperlinks:: Notes in context -* TODO Items:: Every tree branch can be a TODO item -* Tags:: Tagging headlines and matching sets of tags -* Properties and Columns:: Storing information about an entry -* Dates and Times:: Making items useful for planning -* Capture - Refile - Archive:: The ins and outs for projects -* Agenda Views:: Collecting information into views -* Markup:: Prepare text for rich export -* Exporting:: Sharing and publishing of notes -* Publishing:: Create a web site of linked Org files -* Working With Source Code:: Export, evaluate, and tangle code blocks -* Miscellaneous:: All the rest which did not fit elsewhere -* Hacking:: How to hack your way around -* MobileOrg:: Viewing and capture on a mobile device -* History and Acknowledgments:: How Org came into being -* Main Index:: An index of Org's concepts and features -* Key Index:: Key bindings and where they are described -* Command and Function Index:: Command names and some internal functions -* Variable Index:: Variables mentioned in the manual +* Introduction:: Getting started +* Document Structure:: A tree works like your brain +* Tables:: Pure magic for quick formatting +* Hyperlinks:: Notes in context +* TODO Items:: Every tree branch can be a TODO item +* Tags:: Tagging headlines and matching sets of tags +* Properties and Columns:: Storing information about an entry +* Dates and Times:: Making items useful for planning +* Capture - Refile - Archive:: The ins and outs for projects +* Agenda Views:: Collecting information into views +* Markup:: Prepare text for rich export +* Exporting:: Sharing and publishing of notes +* Publishing:: Create a web site of linked Org files +* Working With Source Code:: Export, evaluate, and tangle code blocks +* Miscellaneous:: All the rest which did not fit elsewhere +* Hacking:: How to hack your way around +* MobileOrg:: Viewing and capture on a mobile device +* History and Acknowledgments:: How Org came into being +* Main Index:: An index of Org's concepts and features +* Key Index:: Key bindings and where they are described +* Command and Function Index:: Command names and some internal functions +* Variable Index:: Variables mentioned in the manual @detailmenu --- The Detailed Node Listing --- Introduction -* Summary:: Brief summary of what Org does -* Installation:: How to install a downloaded version of Org -* Activation:: How to activate Org for certain buffers -* Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Summary:: Brief summary of what Org does +* Installation:: How to install a downloaded version of Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Type-setting conventions in the manual Document structure -* Outlines:: Org is based on Outline mode -* Headlines:: How to typeset Org tree headlines -* Visibility cycling:: Show and hide, much simplified -* Motion:: Jumping to other headlines -* Structure editing:: Changing sequence and level of headlines -* Sparse trees:: Matches embedded in context -* Plain lists:: Additional structure within an entry -* Drawers:: Tucking stuff away -* Blocks:: Folding blocks -* Footnotes:: How footnotes are defined in Org's syntax -* Orgstruct mode:: Structure editing outside Org +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org Tables -* Built-in table editor:: Simple tables -* Column width and alignment:: Overrule the automatic settings -* Column groups:: Grouping to trigger vertical lines -* Orgtbl mode:: The table editor as minor mode -* The spreadsheet:: The table editor has spreadsheet capabilities -* Org-Plot:: Plotting from org tables +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables The spreadsheet -* References:: How to refer to another field or range -* Formula syntax for Calc:: Using Calc to compute stuff -* Formula syntax for Lisp:: Writing formulas in Emacs Lisp -* Field formulas:: Formulas valid for a single field -* Column formulas:: Formulas valid for an entire column +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Field formulas:: Formulas valid for a single field +* Column formulas:: Formulas valid for an entire column * Editing and debugging formulas:: Fixing formulas -* Updating the table:: Recomputing all dependent fields -* Advanced features:: Field names, parameters and automatic recalc +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field names, parameters and automatic recalc Hyperlinks -* Link format:: How links in Org are formatted -* Internal links:: Links to other places in the current file -* External links:: URL-like links to the world -* Handling links:: Creating, inserting and following -* Using links outside Org:: Linking from my C source code? -* Link abbreviations:: Shortcuts for writing complex links -* Search options:: Linking to a specific location -* Custom searches:: When the default search is not enough +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough Internal links -* Radio targets:: Make targets trigger links in plain text +* Radio targets:: Make targets trigger links in plain text TODO items -* TODO basics:: Marking and displaying TODO entries -* TODO extensions:: Workflow and assignments -* Progress logging:: Dates and notes for progress -* Priorities:: Some things are more important than others -* Breaking down tasks:: Splitting a task into manageable pieces -* Checkboxes:: Tick-off lists +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists Extended use of TODO keywords -* Workflow states:: From TODO to DONE in steps -* TODO types:: I do this, Fred does the rest -* Multiple sets in one file:: Mixing it all, and still finding your way -* Fast access to TODO states:: Single letter selection of a state -* Per-file keywords:: Different files, different requirements -* Faces for TODO keywords:: Highlighting states -* TODO dependencies:: When one task needs to wait for others +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others Progress logging -* Closing items:: When was this entry marked DONE? -* Tracking TODO state changes:: When did the status change? -* Tracking your habits:: How consistent have you been? +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? Tags -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags Properties and columns -* Property syntax:: How properties are spelled out -* Special properties:: Access to other Org-mode features -* Property searches:: Matching property values -* Property inheritance:: Passing values down the tree -* Column view:: Tabular viewing and editing -* Property API:: Properties for Lisp programmers +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers Column view -* Defining columns:: The COLUMNS format property -* Using column view:: How to create and use column view -* Capturing column view:: A dynamic block for column view +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view Defining columns -* Scope of column definitions:: Where defined, where valid? -* Column attributes:: Appearance and content of a column +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column Dates and times -* Timestamps:: Assigning a time to a tree entry -* Creating timestamps:: Commands which insert timestamps -* Deadlines and scheduling:: Planning your work -* Clocking work time:: Tracking how long you spend on a task -* Resolving idle time:: Resolving time if you've been idle -* Effort estimates:: Planning work effort in advance -* Relative timer:: Notes with a running timer +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Resolving idle time:: Resolving time if you've been idle +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer Creating timestamps -* The date/time prompt:: How Org-mode helps you entering date and time -* Custom time format:: Making dates look different +* The date/time prompt:: How Org-mode helps you entering date and time +* Custom time format:: Making dates look different Deadlines and scheduling -* Inserting deadline/schedule:: Planning items -* Repeated tasks:: Items that show up again and again +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again Capture - Refile - Archive -* Capture:: Capturing new stuff -* Attachments:: Add files to tasks -* RSS Feeds:: Getting input from RSS feeds -* Protocols:: External (e.g. Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another -* Archiving:: What to do with finished projects +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g. Browser) access to Emacs and Org +* Refiling notes:: Moving a tree from one place to another +* Archiving:: What to do with finished projects Capture -* Setting up capture:: Where notes will be stored -* Using capture:: Commands to invoke and terminate capture -* Capture templates:: Define the outline of different note types +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types Capture templates -* Template elements:: What is needed for a complete template entry -* Template expansion:: Filling in information about time and context +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context Archiving -* Moving subtrees:: Moving a tree to an archive file -* Internal archiving:: Switch off a tree but keep it in the file +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file Agenda views -* Agenda files:: Files being searched for agenda information -* Agenda dispatcher:: Keyboard access to agenda views -* Built-in agenda views:: What is available out of the box? -* Presentation and sorting:: How agenda items are prepared for display -* Agenda commands:: Remote editing of Org trees -* Custom agenda views:: Defining special searches and views -* Exporting Agenda Views:: Writing a view to a file -* Agenda column view:: Using column view for collected entries +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries The built-in agenda views -* Weekly/daily agenda:: The calendar page with current tasks -* Global TODO list:: All unfinished action items +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items * Matching tags and properties:: Structured information with fine-tuned search -* Timeline:: Time-sorted view for single file -* Search view:: Find entries by searching for text -* Stuck projects:: Find projects you need to review +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review Presentation and sorting -* Categories:: Not all tasks are equal -* Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting of agenda items:: The order of things Custom agenda views -* Storing searches:: Type once, use often -* Block agenda:: All the stuff you need in a single buffer -* Setting Options:: Changing the rules +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules Markup for rich export -* Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included -* Literal examples:: Source code examples with special formatting -* Include files:: Include additional files into a document -* Index entries:: Making an index -* Macro replacement:: Use macros to create complex output -* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Tables and Images will be included +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create complex output +* Embedded LaTeX:: LaTeX can be freely used inside Org documents Structural markup elements -* Document title:: Where the title is taken from -* Headings and sections:: The document structure as seen by the exporter -* Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? -* Lists:: Lists -* Paragraphs:: Paragraphs -* Footnote markup:: Footnotes -* Emphasis and monospace:: Bold, italic, etc. -* Horizontal rules:: Make a line -* Comment lines:: What will *not* be exported +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Initial text:: Text before the first heading? +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported Embedded La@TeX{} -* Special symbols:: Greek letters and other symbols -* Subscripts and superscripts:: Simple syntax for raising/lowering text -* LaTeX fragments:: Complex formulas made easy -* Previewing LaTeX fragments:: What will this snippet look like? -* CDLaTeX mode:: Speed up entering of formulas +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas Exporting -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands -* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding -* HTML export:: Exporting to HTML -* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* Selective export:: Using tags to select and exclude trees +* Export options:: Per-file export settings +* The export dispatcher:: How to access exporter commands +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF +* DocBook export:: Exporting to DocBook +* TaskJuggler export:: Exporting to TaskJuggler +* Freemind export:: Exporting to Freemind mind maps +* XOXO export:: Exporting to XOXO +* iCalendar export:: Exporting in iCalendar format HTML export -* HTML Export commands:: How to invoke HTML export -* Quoting HTML tags:: Using direct HTML in Org-mode -* Links in HTML export:: How links will be interpreted and formatted -* Tables in HTML export:: How to modify the formatting of tables -* Images in HTML export:: How to insert figures into HTML output +* HTML Export commands:: How to invoke HTML export +* Quoting HTML tags:: Using direct HTML in Org-mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output * Math formatting in HTML export:: Beautiful math also on the web -* Text areas in HTML export:: An alternative way to show an example -* CSS support:: Changing the appearance of the output -* JavaScript support:: Info and Folding in a web browser +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser La@TeX{} and PDF export -* LaTeX/PDF export commands:: Which key invokes which commands -* Header and sectioning:: Setting up the export file structure -* Quoting LaTeX code:: Incorporating literal La@TeX{} code -* Tables in LaTeX export:: Options for exporting tables to La@TeX{} -* Images in LaTeX export:: How to insert figures into La@TeX{} output -* Beamer class export:: Turning the file into a presentation +* LaTeX/PDF export commands:: Which key invokes which commands +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal La@TeX{} code +* Tables in LaTeX export:: Options for exporting tables to La@TeX{} +* Images in LaTeX export:: How to insert figures into La@TeX{} output +* Beamer class export:: Turning the file into a presentation DocBook export -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* DocBook export commands:: How to invoke DocBook export +* Quoting DocBook code:: Incorporating DocBook code in Org files +* Recursive sections:: Recursive sections in DocBook +* Tables in DocBook export:: Tables are exported as HTML tables +* Images in DocBook export:: How to insert figures into DocBook output +* Special characters:: How to handle special characters Publishing -* Configuration:: Defining projects -* Uploading files:: How to get files up on the server -* Sample configuration:: Example projects -* Triggering publication:: Publication commands +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands Configuration -* Project alist:: The central configuration variable -* Sources and destinations:: From here to there -* Selecting files:: What files are part of the project? -* Publishing action:: Setting the function doing the publishing -* Publishing options:: Tweaking HTML export -* Publishing links:: Which links keep working after publishing? -* Sitemap:: Generating a list of all pages -* Generating an index:: An index that reaches across pages +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages Sample configuration -* Simple example:: One-component publishing -* Complex example:: A multi-component publishing example +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example Working with source code -* Structure of code blocks:: Code block syntax described -* Editing source code:: Language major-mode editing -* Exporting code blocks:: Export contents and/or results -* Extracting source code:: Create pure source code files -* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer -* Library of Babel:: Use and contribute to a library of useful code blocks -* Languages:: List of supported code block languages -* Header arguments:: Configure code block functionality -* Results of evaluation:: How evaluation results are handled -* Noweb reference syntax:: Literate programming in Org-mode +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org-mode * Key bindings and useful functions:: Work quickly with code blocks -* Batch execution:: Call functions from the command line +* Batch execution:: Call functions from the command line Header arguments -* Using header arguments:: Different ways to set header arguments -* Specific header arguments:: List of header arguments +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments Using header arguments * System-wide header arguments:: Set global default values -* Language-specific header arguments:: Set default values by language +* Language-specific header arguments:: Set default values by language * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values Specific header arguments -* var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will be collected and handled -* file:: Specify a path for file output -* dir:: Specify the default (possibly remote) +* file:: Specify a path for file output +* dir:: Specify the default (possibly remote) directory for code block execution -* exports:: Export code and/or results -* tangle:: Toggle tangling and specify file name -* comments:: Toggle insertion of comments in tangled +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* comments:: Toggle insertion of comments in tangled code files -* no-expand:: Turn off variable assignment and noweb +* no-expand:: Turn off variable assignment and noweb expansion during tangling -* session:: Preserve the state of code evaluation -* noweb:: Toggle expansion of noweb references -* cache:: Avoid re-evaluating unchanged code blocks -* hlines:: Handle horizontal lines in tables -* colnames:: Handle column names in tables -* rownames:: Handle row names in tables -* shebang:: Make tangled files executable -* eval:: Limit evaluation of specific code blocks +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable +* eval:: Limit evaluation of specific code blocks Miscellaneous -* Completion:: M-TAB knows what you need -* Easy Templates:: Quick insertion of structural elements -* Speed keys:: Electric commands at the beginning of a headline -* Code evaluation security:: Org mode files evaluate inline code -* Customization:: Adapting Org to your taste -* In-buffer settings:: Overview of the #+KEYWORDS -* The very busy C-c C-c key:: When in doubt, press C-c C-c -* Clean view:: Getting rid of leading stars in the outline -* TTY keys:: Using Org on a tty -* Interaction:: Other Emacs packages +* Completion:: M-TAB knows what you need +* Easy Templates:: Quick insertion of structural elements +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages Interaction with other packages -* Cooperation:: Packages Org cooperates with -* Conflicts:: Packages that lead to conflicts +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts Hacking -* Hooks:: Who to reach into Org's internals -* Add-on packages:: Available extensions -* Adding hyperlink types:: New custom link types -* Context-sensitive commands:: How to add functionality to such commands -* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs -* Dynamic blocks:: Automatically filled blocks -* Special agenda views:: Customized views +* Hooks:: Who to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views * Extracting agenda information:: Postprocessing of agenda information -* Using the property API:: Writing programs that use entry properties -* Using the mapping API:: Mapping over all or selected entries +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries Tables and lists in arbitrary syntax -* Radio tables:: Sending and receiving radio tables -* A LaTeX example:: Step by step, almost a tutorial -* Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Doing the same for lists MobileOrg -* Setting up the staging area:: Where to interact with the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items @end detailmenu @end menu @@ -531,11 +532,11 @@ MobileOrg @cindex introduction @menu -* Summary:: Brief summary of what Org does -* Installation:: How to install a downloaded version of Org -* Activation:: How to activate Org for certain buffers -* Feedback:: Bug reports, ideas, patches etc. -* Conventions:: Type-setting conventions in the manual +* Summary:: Brief summary of what Org does +* Installation:: How to install a downloaded version of Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Type-setting conventions in the manual @end menu @node Summary, Installation, Introduction, Introduction @@ -825,17 +826,17 @@ Org is based on Outline mode and provides flexible commands to edit the structure of the document. @menu -* Outlines:: Org is based on Outline mode -* Headlines:: How to typeset Org tree headlines -* Visibility cycling:: Show and hide, much simplified -* Motion:: Jumping to other headlines -* Structure editing:: Changing sequence and level of headlines -* Sparse trees:: Matches embedded in context -* Plain lists:: Additional structure within an entry -* Drawers:: Tucking stuff away -* Blocks:: Folding blocks -* Footnotes:: How footnotes are defined in Org's syntax -* Orgstruct mode:: Structure editing outside Org +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org @end menu @node Outlines, Headlines, Document Structure, Document Structure @@ -1624,12 +1625,12 @@ calculator). @end ifnotinfo @menu -* Built-in table editor:: Simple tables -* Column width and alignment:: Overrule the automatic settings -* Column groups:: Grouping to trigger vertical lines -* Orgtbl mode:: The table editor as minor mode -* The spreadsheet:: The table editor has spreadsheet capabilities -* Org-Plot:: Plotting from org tables +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables @end menu @node Built-in table editor, Column width and alignment, Tables, Tables @@ -2003,14 +2004,14 @@ fields in the table corresponding to the references at the point in the formula, moving these references by arrow keys @menu -* References:: How to refer to another field or range -* Formula syntax for Calc:: Using Calc to compute stuff -* Formula syntax for Lisp:: Writing formulas in Emacs Lisp -* Field formulas:: Formulas valid for a single field -* Column formulas:: Formulas valid for an entire column +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Field formulas:: Formulas valid for a single field +* Column formulas:: Formulas valid for an entire column * Editing and debugging formulas:: Fixing formulas -* Updating the table:: Recomputing all dependent fields -* Advanced features:: Field names, parameters and automatic recalc +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field names, parameters and automatic recalc @end menu @node References, Formula syntax for Calc, The spreadsheet, The spreadsheet @@ -2714,14 +2715,14 @@ Like HTML, Org provides links inside a file, external links to other files, Usenet articles, emails, and much more. @menu -* Link format:: How links in Org are formatted -* Internal links:: Links to other places in the current file -* External links:: URL-like links to the world -* Handling links:: Creating, inserting and following -* Using links outside Org:: Linking from my C source code? -* Link abbreviations:: Shortcuts for writing complex links -* Search options:: Linking to a specific location -* Custom searches:: When the default search is not enough +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough @end menu @node Link format, Internal links, Hyperlinks, Hyperlinks @@ -2804,7 +2805,7 @@ several times in direct succession goes back to positions recorded earlier. @menu -* Radio targets:: Make targets trigger links in plain text +* Radio targets:: Make targets trigger links in plain text @end menu @node Radio targets, , Internal links, Internal links @@ -3259,12 +3260,12 @@ throughout your notes file. Org-mode compensates for this by providing methods to give you an overview of all the things that you have to do. @menu -* TODO basics:: Marking and displaying TODO entries -* TODO extensions:: Workflow and assignments -* Progress logging:: Dates and notes for progress -* Priorities:: Some things are more important than others -* Breaking down tasks:: Splitting a task into manageable pieces -* Checkboxes:: Tick-off lists +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists @end menu @node TODO basics, TODO extensions, TODO Items, TODO Items @@ -3356,13 +3357,13 @@ Note that @i{tags} are another way to classify headlines in general and TODO items in particular (@pxref{Tags}). @menu -* Workflow states:: From TODO to DONE in steps -* TODO types:: I do this, Fred does the rest -* Multiple sets in one file:: Mixing it all, and still finding your way -* Fast access to TODO states:: Single letter selection of a state -* Per-file keywords:: Different files, different requirements -* Faces for TODO keywords:: Highlighting states -* TODO dependencies:: When one task needs to wait for others +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others @end menu @node Workflow states, TODO types, TODO extensions, TODO extensions @@ -3653,9 +3654,9 @@ information on how to clock working time for a task, see @ref{Clocking work time}. @menu -* Closing items:: When was this entry marked DONE? -* Tracking TODO state changes:: When did the status change? -* Tracking your habits:: How consistent have you been? +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? @end menu @node Closing items, Tracking TODO state changes, Progress logging, Progress logging @@ -4117,9 +4118,9 @@ You may specify special faces for specific tags using the variable (@pxref{Faces for TODO keywords}). @menu -* Tag inheritance:: Tags use the tree structure of the outline -* Setting tags:: How to assign tags to a headline -* Tag searches:: Searching for combinations of tags +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag searches:: Searching for combinations of tags @end menu @node Tag inheritance, Setting tags, Tags, Tags @@ -4406,12 +4407,12 @@ Properties can be conveniently edited and viewed in column view (@pxref{Column view}). @menu -* Property syntax:: How properties are spelled out -* Special properties:: Access to other Org-mode features -* Property searches:: Matching property values -* Property inheritance:: Passing values down the tree -* Column view:: Tabular viewing and editing -* Property API:: Properties for Lisp programmers +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org-mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers @end menu @node Property syntax, Special properties, Properties and Columns, Properties and Columns @@ -4647,9 +4648,9 @@ Column view also works in agenda buffers (@pxref{Agenda Views}) where queries have collected selected items, possibly from a number of files. @menu -* Defining columns:: The COLUMNS format property -* Using column view:: How to create and use column view -* Capturing column view:: A dynamic block for column view +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view @end menu @node Defining columns, Using column view, Column view, Column view @@ -4661,8 +4662,8 @@ Setting up a column view first requires defining the columns. This is done by defining a column format line. @menu -* Scope of column definitions:: Where defined, where valid? -* Column attributes:: Appearance and content of a column +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column @end menu @node Scope of column definitions, Column attributes, Defining columns, Defining columns @@ -4761,7 +4762,7 @@ values. @example :COLUMNS: %25ITEM %9Approved(Approved?)@{X@} %Owner %11Status \@footnote{Please note that the COLUMNS definition must be on a single line---it is wrapped here only because of formatting constraints.} - %10Time_Estimate@{:@} %CLOCKSUM + %10Time_Estimate@{:@} %CLOCKSUM :Owner_ALL: Tammy Mark Karl Lisa Don :Status_ALL: "In progress" "Not started yet" "Finished" "" :Approved_ALL: "[ ]" "[X]" @@ -4961,13 +4962,13 @@ something was created or last changed. However, in Org-mode this term is used in a much wider sense. @menu -* Timestamps:: Assigning a time to a tree entry -* Creating timestamps:: Commands which insert timestamps -* Deadlines and scheduling:: Planning your work -* Clocking work time:: Tracking how long you spend on a task -* Resolving idle time:: Resolving time if you've been idle -* Effort estimates:: Planning work effort in advance -* Relative timer:: Notes with a running timer +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Resolving idle time:: Resolving time if you've been idle +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer @end menu @@ -5123,8 +5124,8 @@ the following column). @menu -* The date/time prompt:: How Org-mode helps you entering date and time -* Custom time format:: Making dates look different +* The date/time prompt:: How Org-mode helps you entering date and time +* Custom time format:: Making dates look different @end menu @node The date/time prompt, Custom time format, Creating timestamps, Creating timestamps @@ -5366,8 +5367,8 @@ late warnings. However, it will show the item on each day where the sexp entry matches. @menu -* Inserting deadline/schedule:: Planning items -* Repeated tasks:: Items that show up again and again +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again @end menu @node Inserting deadline/schedule, Repeated tasks, Deadlines and scheduling, Deadlines and scheduling @@ -5888,12 +5889,12 @@ system, tasks and projects need to be moved around. Moving completed project trees to an archive file keeps the system compact and fast. @menu -* Capture:: Capturing new stuff -* Attachments:: Add files to tasks -* RSS Feeds:: Getting input from RSS feeds -* Protocols:: External (e.g. Browser) access to Emacs and Org -* Refiling notes:: Moving a tree from one place to another -* Archiving:: What to do with finished projects +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g. Browser) access to Emacs and Org +* Refiling notes:: Moving a tree from one place to another +* Archiving:: What to do with finished projects @end menu @node Capture, Attachments, Capture - Refile - Archive, Capture - Refile - Archive @@ -5921,9 +5922,9 @@ flow. The basic process of capturing is very similar to remember, but Org does enhance it with templates and more. @menu -* Setting up capture:: Where notes will be stored -* Using capture:: Commands to invoke and terminate capture -* Capture templates:: Define the outline of different note types +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types @end menu @node Setting up capture, Using capture, Capture, Capture @@ -6017,8 +6018,8 @@ place where you started the capture process. @menu -* Template elements:: What is needed for a complete template entry -* Template expansion:: Filling in information about time and context +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context @end menu @node Template elements, Template expansion, Capture templates, Capture templates @@ -6329,8 +6330,8 @@ information. Here is just an example: @example (setq org-feed-alist '(("Slashdot" - "http://rss.slashdot.org/Slashdot/slashdot" - "~/txt/org/feeds.org" "Slashdot Entries"))) + "http://rss.slashdot.org/Slashdot/slashdot" + "~/txt/org/feeds.org" "Slashdot Entries"))) @end example @noindent @@ -6443,8 +6444,8 @@ Archive the current entry using the command specified in the variable @end table @menu -* Moving subtrees:: Moving a tree to an archive file -* Internal archiving:: Switch off a tree but keep it in the file +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file @end menu @node Moving subtrees, Internal archiving, Archiving, Archiving @@ -6621,14 +6622,14 @@ window configuration is restored when the agenda exits: @code{org-agenda-restore-windows-after-quit}. @menu -* Agenda files:: Files being searched for agenda information -* Agenda dispatcher:: Keyboard access to agenda views -* Built-in agenda views:: What is available out of the box? -* Presentation and sorting:: How agenda items are prepared for display -* Agenda commands:: Remote editing of Org trees -* Custom agenda views:: Defining special searches and views -* Exporting Agenda Views:: Writing a view to a file -* Agenda column view:: Using column view for collected entries +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries @end menu @node Agenda files, Agenda dispatcher, Agenda Views, Agenda Views @@ -6770,12 +6771,12 @@ a number of special tags matches. @xref{Custom agenda views}. In this section we describe the built-in views. @menu -* Weekly/daily agenda:: The calendar page with current tasks -* Global TODO list:: All unfinished action items +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items * Matching tags and properties:: Structured information with fine-tuned search -* Timeline:: Time-sorted view for single file -* Search view:: Find entries by searching for text -* Stuck projects:: Find projects you need to review +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review @end menu @node Weekly/daily agenda, Global TODO list, Built-in agenda views, Built-in agenda views @@ -7240,9 +7241,9 @@ The prefix is followed by a cleaned-up version of the outline headline associated with the item. @menu -* Categories:: Not all tasks are equal -* Time-of-day specifications:: How the agenda knows the time -* Sorting of agenda items:: The order of things +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting of agenda items:: The order of things @end menu @node Categories, Time-of-day specifications, Presentation and sorting, Presentation and sorting @@ -7637,12 +7638,12 @@ Internet, and outside of business hours, with something like this: @group (defun org-my-auto-exclude-function (tag) (and (cond - ((string= tag "Net") - (/= 0 (call-process "/sbin/ping" nil nil nil - "-c1" "-q" "-t1" "mail.gnu.org"))) - ((or (string= tag "Errand") (string= tag "Call")) - (let ((hour (nth 2 (decode-time)))) - (or (< hour 8) (> hour 21))))) + ((string= tag "Net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((or (string= tag "Errand") (string= tag "Call")) + (let ((hour (nth 2 (decode-time)))) + (or (< hour 8) (> hour 21))))) (concat "-" tag))) (setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) @@ -7972,9 +7973,9 @@ agenda buffers. Custom agenda commands will be accessible through the dispatcher (@pxref{Agenda dispatcher}), just like the default commands. @menu -* Storing searches:: Type once, use often -* Block agenda:: All the stuff you need in a single buffer -* Setting Options:: Changing the rules +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules @end menu @node Storing searches, Block agenda, Custom agenda views, Custom agenda views @@ -8359,29 +8360,29 @@ Org-mode has rules on how to prepare text for rich export. This section summarizes the markup rules used in an Org-mode buffer. @menu -* Structural markup elements:: The basic structure as seen by the exporter -* Images and tables:: Tables and Images will be included -* Literal examples:: Source code examples with special formatting -* Include files:: Include additional files into a document -* Index entries:: Making an index -* Macro replacement:: Use macros to create complex output -* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Tables and Images will be included +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create complex output +* Embedded LaTeX:: LaTeX can be freely used inside Org documents @end menu @node Structural markup elements, Images and tables, Markup, Markup @section Structural markup elements @menu -* Document title:: Where the title is taken from -* Headings and sections:: The document structure as seen by the exporter -* Table of contents:: The if and where of the table of contents -* Initial text:: Text before the first heading? -* Lists:: Lists -* Paragraphs:: Paragraphs -* Footnote markup:: Footnotes -* Emphasis and monospace:: Bold, italic, etc. -* Horizontal rules:: Make a line -* Comment lines:: What will *not* be exported +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Initial text:: Text before the first heading? +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported @end menu @node Document title, Headings and sections, Structural markup elements, Structural markup elements @@ -8807,11 +8808,11 @@ code, and because it can be readily processed to produce pretty output for a number of export backends. @menu -* Special symbols:: Greek letters and other symbols -* Subscripts and superscripts:: Simple syntax for raising/lowering text -* LaTeX fragments:: Complex formulas made easy -* Previewing LaTeX fragments:: What will this snippet look like? -* CDLaTeX mode:: Speed up entering of formulas +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas @end menu @node Special symbols, Subscripts and superscripts, Embedded LaTeX, Embedded LaTeX @@ -9079,17 +9080,17 @@ Org supports export of selected regions when @code{transient-mark-mode} is enabled (default in Emacs 23). @menu -* Selective export:: Using tags to select and exclude trees -* Export options:: Per-file export settings -* The export dispatcher:: How to access exporter commands -* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding -* HTML export:: Exporting to HTML -* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF -* DocBook export:: Exporting to DocBook -* TaskJuggler export:: Exporting to TaskJuggler -* Freemind export:: Exporting to Freemind mind maps -* XOXO export:: Exporting to XOXO -* iCalendar export:: Exporting in iCalendar format +* Selective export:: Using tags to select and exclude trees +* Export options:: Per-file export settings +* The export dispatcher:: How to access exporter commands +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to La@TeX{}, and processing to PDF +* DocBook export:: Exporting to DocBook +* TaskJuggler export:: Exporting to TaskJuggler +* Freemind export:: Exporting to Freemind mind maps +* XOXO export:: Exporting to XOXO +* iCalendar export:: Exporting in iCalendar format @end menu @node Selective export, Export options, Exporting, Exporting @@ -9342,15 +9343,15 @@ HTML formatting, in ways similar to John Gruber's @emph{markdown} language, but with additional support for tables. @menu -* HTML Export commands:: How to invoke HTML export -* Quoting HTML tags:: Using direct HTML in Org-mode -* Links in HTML export:: How links will be interpreted and formatted -* Tables in HTML export:: How to modify the formatting of tables -* Images in HTML export:: How to insert figures into HTML output +* HTML Export commands:: How to invoke HTML export +* Quoting HTML tags:: Using direct HTML in Org-mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output * Math formatting in HTML export:: Beautiful math also on the web -* Text areas in HTML export:: An alternative way to show an example -* CSS support:: Changing the appearance of the output -* JavaScript support:: Info and Folding in a web browser +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser @end menu @node HTML Export commands, Quoting HTML tags, HTML export, HTML export @@ -9731,12 +9732,12 @@ implement links and cross references, the PDF output file will be fully linked. @menu -* LaTeX/PDF export commands:: Which key invokes which commands -* Header and sectioning:: Setting up the export file structure -* Quoting LaTeX code:: Incorporating literal La@TeX{} code -* Tables in LaTeX export:: Options for exporting tables to La@TeX{} -* Images in LaTeX export:: How to insert figures into La@TeX{} output -* Beamer class export:: Turning the file into a presentation +* LaTeX/PDF export commands:: Which key invokes which commands +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal La@TeX{} code +* Tables in LaTeX export:: Options for exporting tables to La@TeX{} +* Images in LaTeX export:: How to insert figures into La@TeX{} output +* Beamer class export:: Turning the file into a presentation @end menu @node LaTeX/PDF export commands, Header and sectioning, LaTeX and PDF export, LaTeX and PDF export @@ -10061,12 +10062,12 @@ tools and stylesheets. Currently DocBook exporter only supports DocBook V5.0. @menu -* DocBook export commands:: How to invoke DocBook export -* Quoting DocBook code:: Incorporating DocBook code in Org files -* Recursive sections:: Recursive sections in DocBook -* Tables in DocBook export:: Tables are exported as HTML tables -* Images in DocBook export:: How to insert figures into DocBook output -* Special characters:: How to handle special characters +* DocBook export commands:: How to invoke DocBook export +* Quoting DocBook code:: Incorporating DocBook code in Org files +* Recursive sections:: Recursive sections in DocBook +* Tables in DocBook export:: Tables are exported as HTML tables +* Images in DocBook export:: How to insert figures into DocBook output +* Special characters:: How to handle special characters @end menu @node DocBook export commands, Quoting DocBook code, DocBook export, DocBook export @@ -10495,10 +10496,10 @@ conversion so that files are available in both formats on the server. Publishing has been contributed to Org by David O'Toole. @menu -* Configuration:: Defining projects -* Uploading files:: How to get files up on the server -* Sample configuration:: Example projects -* Triggering publication:: Publication commands +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands @end menu @node Configuration, Uploading files, Publishing, Publishing @@ -10508,14 +10509,14 @@ Publishing needs significant configuration to specify files, destination and many other properties of a project. @menu -* Project alist:: The central configuration variable -* Sources and destinations:: From here to there -* Selecting files:: What files are part of the project? -* Publishing action:: Setting the function doing the publishing -* Publishing options:: Tweaking HTML export -* Publishing links:: Which links keep working after publishing? -* Sitemap:: Generating a list of all pages -* Generating an index:: An index that reaches across pages +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages @end menu @node Project alist, Sources and destinations, Configuration, Configuration @@ -10889,8 +10890,8 @@ project publishing only a set of Org files. The second example is more complex, with a multi-component project. @menu -* Simple example:: One-component publishing -* Complex example:: A multi-component publishing example +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example @end menu @node Simple example, Complex example, Sample configuration, Sample configuration @@ -11019,18 +11020,18 @@ Schulte and Dan Davison, and was originally named Org-babel. The following sections describe Org-mode's code block handling facilities. @menu -* Structure of code blocks:: Code block syntax described -* Editing source code:: Language major-mode editing -* Exporting code blocks:: Export contents and/or results -* Extracting source code:: Create pure source code files -* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer -* Library of Babel:: Use and contribute to a library of useful code blocks -* Languages:: List of supported code block languages -* Header arguments:: Configure code block functionality -* Results of evaluation:: How evaluation results are handled -* Noweb reference syntax:: Literate programming in Org-mode +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org-mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org-mode * Key bindings and useful functions:: Work quickly with code blocks -* Batch execution:: Call functions from the command line +* Batch execution:: Call functions from the command line @end menu @comment node-name, next, previous, up @@ -11336,8 +11337,8 @@ section provides an overview of the use of header arguments, and then describes each header argument in detail. @menu -* Using header arguments:: Different ways to set header arguments -* Specific header arguments:: List of header arguments +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments @end menu @node Using header arguments, Specific header arguments, Header arguments, Header arguments @@ -11347,7 +11348,7 @@ The values of header arguments can be set in five different ways, each more specific (and having higher priority) than the last. @menu * System-wide header arguments:: Set global default values -* Language-specific header arguments:: Set default values by language +* Language-specific header arguments:: Set default values by language * Buffer-wide header arguments:: Set default values for a specific buffer * Header arguments in Org-mode properties:: Set default values for a buffer or heading * Code block specific header arguments:: The most common way to set values @@ -11484,26 +11485,26 @@ Header arguments for ``Library of Babel'' or function call lines can be set as s The following header arguments are defined: @menu -* var:: Pass arguments to code blocks -* results:: Specify the type of results and how they will +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will be collected and handled -* file:: Specify a path for file output -* dir:: Specify the default (possibly remote) +* file:: Specify a path for file output +* dir:: Specify the default (possibly remote) directory for code block execution -* exports:: Export code and/or results -* tangle:: Toggle tangling and specify file name -* comments:: Toggle insertion of comments in tangled +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* comments:: Toggle insertion of comments in tangled code files -* no-expand:: Turn off variable assignment and noweb +* no-expand:: Turn off variable assignment and noweb expansion during tangling -* session:: Preserve the state of code evaluation -* noweb:: Toggle expansion of noweb references -* cache:: Avoid re-evaluating unchanged code blocks -* hlines:: Handle horizontal lines in tables -* colnames:: Handle column names in tables -* rownames:: Handle row names in tables -* shebang:: Make tangled files executable -* eval:: Limit evaluation of specific code blocks +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable +* eval:: Limit evaluation of specific code blocks @end menu @node var, results, Specific header arguments, Specific header arguments @@ -12372,16 +12373,16 @@ emacsclient \ @chapter Miscellaneous @menu -* Completion:: M-TAB knows what you need -* Easy Templates:: Quick insertion of structural elements -* Speed keys:: Electric commands at the beginning of a headline -* Code evaluation security:: Org mode files evaluate inline code -* Customization:: Adapting Org to your taste -* In-buffer settings:: Overview of the #+KEYWORDS -* The very busy C-c C-c key:: When in doubt, press C-c C-c -* Clean view:: Getting rid of leading stars in the outline -* TTY keys:: Using Org on a tty -* Interaction:: Other Emacs packages +* Completion:: M-TAB knows what you need +* Easy Templates:: Quick insertion of structural elements +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages @end menu @@ -13042,8 +13043,8 @@ Org lives in the world of GNU Emacs and interacts in various ways with other code out there. @menu -* Cooperation:: Packages Org cooperates with -* Conflicts:: Packages that lead to conflicts +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts @end menu @node Cooperation, Conflicts, Interaction, Interaction @@ -13191,9 +13192,9 @@ fixed this problem: @lisp (add-hook 'org-mode-hook - (lambda () - (org-set-local 'yas/trigger-key [tab]) - (define-key yas/keymap [tab] 'yas/next-field-group))) + (lambda () + (org-set-local 'yas/trigger-key [tab]) + (define-key yas/keymap [tab] 'yas/next-field-group))) @end lisp @item @file{windmove.el} by Hovav Shacham @@ -13235,16 +13236,16 @@ This appendix covers some aspects where users can extend the functionality of Org. @menu -* Hooks:: Who to reach into Org's internals -* Add-on packages:: Available extensions -* Adding hyperlink types:: New custom link types -* Context-sensitive commands:: How to add functionality to such commands -* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs -* Dynamic blocks:: Automatically filled blocks -* Special agenda views:: Customized views +* Hooks:: Who to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for La@TeX{} and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views * Extracting agenda information:: Postprocessing of agenda information -* Using the property API:: Writing programs that use entry properties -* Using the mapping API:: Mapping over all or selected entries +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries @end menu @node Hooks, Add-on packages, Hacking, Hacking @@ -13438,10 +13439,10 @@ can use Org's facilities to edit and structure lists by turning @menu -* Radio tables:: Sending and receiving radio tables -* A LaTeX example:: Step by step, almost a tutorial -* Translator functions:: Copy and modify -* Radio lists:: Doing the same for lists +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Doing the same for lists @end menu @node Radio tables, A LaTeX example, Tables in arbitrary syntax, Tables in arbitrary syntax @@ -14215,9 +14216,9 @@ in-buffer settings, but it will understand the logistics of TODO state (@pxref{Setting tags}) only for those set in these variables. @menu -* Setting up the staging area:: Where to interact with the mobile device -* Pushing to MobileOrg:: Uploading Org files and agendas -* Pulling from MobileOrg:: Integrating captured and flagged items +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items @end menu @node Setting up the staging area, Pushing to MobileOrg, MobileOrg, MobileOrg @@ -14625,6 +14626,7 @@ org-customize @key{RET}} and then click yourself through the tree. @c Local variables: @c fill-column: 77 +@c indent-tabs-mode: nil @c End: From 6d7b15cf9ff4025c2670e48c08f52e12a8b5928b Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Thu, 9 Sep 2010 14:16:22 +0200 Subject: [PATCH 328/348] Mitigate access to messages on slow IMAP servers. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * org-gnus.el (org-gnus-nnimap-query-article-no-from-file): New customization variable. (org-gnus-nnimap-cached-article-number): New function. (org-gnus-follow-link): Try to fetch cached article number of message-id. Some IMAP servers (e.g. Courier) are slow when searching for a message by its message id header field. Because article numbers in IMAP mailboxes are persistent UIDs, we can try to look up the UID of a IMAP message in Gnus' cache for the mailbox in question and skip the slow search on the server. The problem with slow server was reported by Sébastien Vauban and the patch is based on the work of Tassilo Horn. --- lisp/org-gnus.el | 38 +++++++++++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index 10a042618..f98256fb2 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -54,12 +54,40 @@ negates this setting for the duration of the command." :group 'org-link-store :type 'boolean) +(defcustom org-gnus-nnimap-query-article-no-from-file t + "If non-nil, `org-gnus-follow-link' will try to translate +Message-Ids to article numbers by querying the .overview file. +Normally, this translation is done by querying the IMAP server, +which is usually very fast. Unfortunately, some (maybe badly +configured) IMAP servers don't support this operation quickly. +So if following a link to a Gnus article takes ages, try setting +this variable to `t'." + :group 'org-link-store + :type 'boolean) + + ;; Install the link type (org-add-link-type "gnus" 'org-gnus-open) (add-hook 'org-store-link-functions 'org-gnus-store-link) ;; Implementation +(defun org-gnus-nnimap-cached-article-number (group server message-id) + "Return cached article number (uid) of message in GROUP on SERVER. +MESSAGE-ID is the message-id header field that identifies the +message. If the uid is not cached, return nil." + (with-temp-buffer + (let ((nov (nnimap-group-overview-filename group server))) + (when (file-exists-p nov) + (mm-insert-file-contents nov) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (catch 'found + (while (search-forward message-id nil t) + (let ((hdr (split-string (thing-at-point 'line) "\t"))) + (if (string= (nth 4 hdr) message-id) + (throw 'found (nth 0 hdr)))))))))) + (defun org-gnus-group-link (group) "Create a link to the Gnus group GROUP. If GROUP is a newsgroup and `org-gnus-prefer-web-links' is @@ -171,7 +199,9 @@ If `org-store-link' was called with a prefix arg the meaning of (cond ((and group article) (gnus-activate-group group t) (condition-case nil - (let ((backend (car (gnus-find-method-for-group group)))) + (let* ((method (gnus-find-method-for-group group)) + (backend (car method)) + (server (cadr method))) (cond ((eq backend 'nndoc) (if (gnus-group-read-group t nil group) @@ -181,6 +211,12 @@ If `org-store-link' was called with a prefix arg the meaning of (t (let ((articles 1) group-opened) + (when (and (eq backend 'nnimap) + org-gnus-nnimap-query-article-no-from-file) + (setq article + (or (org-gnus-nnimap-cached-article-number + (nth 1 (split-string group ":")) + server (concat "<" article ">")) article))) (while (and (not group-opened) ;; stop on integer overflows (> articles 0)) From 9209139d1e0d4499fe86815fa79758fdf07dc9a0 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Thu, 9 Sep 2010 14:51:16 +0200 Subject: [PATCH 329/348] Declare function to silence byte compiler * org-gnus.el (nnimap-group-overview-filename): Declare function to silence byte compiler. --- lisp/org-gnus.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-gnus.el b/lisp/org-gnus.el index f98256fb2..020618806 100644 --- a/lisp/org-gnus.el +++ b/lisp/org-gnus.el @@ -39,6 +39,7 @@ ;; Declare external functions and variables (declare-function message-fetch-field "message" (header &optional not-all)) (declare-function message-narrow-to-head-1 "message" nil) +(declare-function nnimap-group-overview-filename "nnimap" (group server)) ;; The following line suppresses a compiler warning stemming from gnus-sum.el (declare-function gnus-summary-last-subject "gnus-sum" nil) ;; Customization variables From 06c332cfee2bdfb6c30ac0a016ce643c4da7e0a5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 9 Sep 2010 15:19:53 +0200 Subject: [PATCH 330/348] Fix notes indentation * org.el (org-store-log-note): Indent new notes to the right column. Also take `org-list-two-spaces-after-bullet-regexp' into consideration when creating the note. --- lisp/org.el | 29 +++++++++++++++++++++-------- 1 file changed, 21 insertions(+), 8 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index dfd6d79ac..95d1f31b9 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11823,7 +11823,7 @@ EXTRA is additional text that will be inserted into the notes buffer." "Finish taking a log note, and insert it to where it belongs." (let ((txt (buffer-string)) (note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind) + lines ind bul) (kill-buffer (current-buffer)) (while (string-match "\\`#.*\n[ \t\n]*" txt) (setq txt (replace-match "" t t txt))) @@ -11863,13 +11863,26 @@ EXTRA is additional text that will be inserted into the notes buffer." (move-marker org-log-note-marker nil) (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (org-indent-line-function) - (insert "- " (pop lines)) - (beginning-of-line 1) - (looking-at "[ \t]*") - (setq ind (concat (match-string 0) " ")) - (end-of-line 1) - (while lines (insert "\n" ind (pop lines))) + (setq ind (save-excursion + (if (org-in-item-p) + (progn + (goto-char (org-list-top-point)) + (org-get-indentation)) + (skip-chars-backward " \r\t\n") + (cond + ((and (org-at-heading-p) + (org-adapt-indentation)) + (1+ (org-current-level))) + ((org-at-heading-p) 0) + (t (org-get-indentation)))))) + (setq bul (org-list-bullet-string "-")) + (org-indent-line-to ind) + (insert bul (pop lines)) + (let ((ind-body (+ (length bul) ind))) + (while lines + (insert "\n") + (org-indent-line-to ind-body) + (insert (pop lines)))) (message "Note stored") (org-back-to-heading t) (org-cycle-hide-drawers 'children))))) From 7c28d8d3362ef1c41837b99cf69c9ccf172aa21f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 9 Sep 2010 15:20:54 +0200 Subject: [PATCH 331/348] Fix indentation when using a [@start:num] or [@num] construct. * org.el (org-indent-line-function): Indent past [@num] and [@start:num], consistently with what is already done with checkboxes. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 95d1f31b9..68ed311ca 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18588,7 +18588,7 @@ which make use of the date at the cursor." ;; Lists ((org-in-item-p) (org-beginning-of-item) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\[[- X]\\][ \t]*\\|.*? :: \\)?") + (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?") (setq bpos (match-beginning 1) tpos (match-end 0) bcol (progn (goto-char bpos) (current-column)) tcol (progn (goto-char tpos) (current-column)) From 385c2666b1519b598071b33189b8ca9f6ea28547 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Thu, 9 Sep 2010 15:35:46 +0200 Subject: [PATCH 332/348] More general regexp for descriptions items * org-list.el (org-list-to-generic): Descriptions labels can be any suit of symbols, and will end at double colons. --- lisp/org-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index ff6b80bfe..a47ef3822 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2245,7 +2245,7 @@ Valid parameters PARAMS are (while (setq sublist (pop list)) (cond ((symbolp sublist) nil) ((stringp sublist) - (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist) + (when (string-match "^\\(.*\\)[ \t]+::" sublist) (setq term (org-trim (format (concat dtstart "%s" dtend) (match-string 1 sublist)))) (setq sublist (concat ddstart From ece2c578f0a04a6cab9e552459a7d2a42c1428c3 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Thu, 9 Sep 2010 20:56:01 +0200 Subject: [PATCH 333/348] Save match data before call to `read-char-exclusive' * org.el (org-priority): Save match data before call to `read-char-exclusive'. Otherwise interactively calling `org-priority' with org-indent-mode enabled fails to set a new priority cookie. Bug reported by Joseph Buchignani. --- lisp/org.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 68ed311ca..6d8dfdcde 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -12120,7 +12120,8 @@ ACTION can be `set', `up', `down', or a character." (setq new action) (message "Priority %c-%c, SPC to remove: " org-highest-priority org-lowest-priority) - (setq new (read-char-exclusive))) + (save-match-data + (setq new (read-char-exclusive)))) (if (and (= (upcase org-highest-priority) org-highest-priority) (= (upcase org-lowest-priority) org-lowest-priority)) (setq new (upcase new))) From 025921e94f9e07932f3c3f11185f42423f147995 Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Fri, 10 Sep 2010 09:33:00 -0600 Subject: [PATCH 334/348] Babel language files should not require org mode explicitly * lisp/ob-C.el (org): no longer requires org * lisp/ob-ledger.el (org): no longer requires org --- lisp/ob-C.el | 1 - lisp/ob-ledger.el | 1 - 2 files changed, 2 deletions(-) diff --git a/lisp/ob-C.el b/lisp/ob-C.el index 18921747c..9022932c0 100644 --- a/lisp/ob-C.el +++ b/lisp/ob-C.el @@ -33,7 +33,6 @@ ;;; Code: (require 'ob) (require 'ob-eval) -(require 'org) (require 'cc-mode) (declare-function org-entry-get "org" diff --git a/lisp/ob-ledger.el b/lisp/ob-ledger.el index edd803ff2..111e3f964 100644 --- a/lisp/ob-ledger.el +++ b/lisp/ob-ledger.el @@ -38,7 +38,6 @@ ;;; Code: (require 'ob) -(require 'org) (defvar org-babel-default-header-args:ledger '((:results . "output") (:cmdline . "bal")) From fd49e69730ef47d4b797f6a5a80c6a92075e2590 Mon Sep 17 00:00:00 2001 From: aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local> Date: Sat, 11 Sep 2010 07:38:27 +0200 Subject: [PATCH 335/348] Use global archive location default * lisp/org-archive.el (org-get-local-archive-location): Use `org-carchive-location' as default. Strange that nobody has noticed this bug before! --- lisp/org-archive.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-archive.el b/lisp/org-archive.el index 865f4d1d1..629da050b 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -115,7 +115,7 @@ information." ((or (re-search-backward re nil t) (re-search-forward re nil t)) (match-string 1)) - (t org-archive-location (match-string 1))))))) + (t org-archive-location)))))) (defun org-add-archive-files (files) "Splice the archive files into the list of files. From 200f7541e88a97993dd2487196df102abc60242b Mon Sep 17 00:00:00 2001 From: aaa bbb <dominik@powerbook-g4-12-van-aaa-bbb.local> Date: Sat, 11 Sep 2010 07:39:11 +0200 Subject: [PATCH 336/348] Mention Nicaloas in acknowledgements --- doc/org.texi | 2 ++ 1 file changed, 2 insertions(+) diff --git a/doc/org.texi b/doc/org.texi index d655e05e5..d6ea14150 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -14448,6 +14448,8 @@ around a match in a hidden outline tree. @item @i{Niels Giesen} had the idea to automatically archive DONE trees. @item +@i{Nicolas Goaziou} rewrote much of the plain list code. +@item @i{Kai Grossjohann} pointed out key-binding conflicts with other packages. @item @i{Bernt Hansen} has driven much of the support for auto-repeating tasks, From 59fa0d12c8413cfb8fd00551bffe450df2319f5d Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Sun, 12 Sep 2010 18:45:04 +0200 Subject: [PATCH 337/348] Small fix in doc string * org-capture.el (org-capture-templates): Small fix in doc string. --- lisp/org-capture.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index eafc9c607..5b917d813 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -221,7 +221,7 @@ Furthermore, the following %-escapes will be replaced with content: Apart from these general escapes, you can access information specific to the link type that is created. For example, calling `org-capture' in emails or gnus will record the author and the subject of the message, which you -can access with \"%:author\" and \"%:subject\", respectively. Here is a +can access with \"%:from\" and \"%:subject\", respectively. Here is a complete list of what is recorded for each link type. Link type | Available information From 60fcd2fa7ec4cf805f13f91f80ad6d73264009f8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Sun, 12 Sep 2010 13:15:48 +0200 Subject: [PATCH 338/348] Replace non-interactive use of `org-next-item' and `org-previous-item'. * org.el (org-skip-over-state-notes): do not compute bottom point at each item. * org-mouse.el (org-mouse-for-each-item): use `org-apply-on-list' instead of moving to each item. --- lisp/org-mouse.el | 14 ++++++-------- lisp/org.el | 9 +++++---- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index c47d197eb..3a5a403d7 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -148,6 +148,7 @@ (declare-function org-agenda-change-all-lines "org-agenda" (newhead hdmarker &optional fixface just-this)) (declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) +(declare-function org-apply-on-list "org-list" (function init-value &rest args)) (defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " "Regular expression that matches a plain list.") @@ -576,14 +577,11 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (goto-char (second contextdata)) (re-search-forward ".*" (third contextdata)))))) -(defun org-mouse-for-each-item (function) - (save-excursion - (ignore-errors - (while t (org-previous-item))) - (ignore-errors - (while t - (funcall function) - (org-next-item))))) +(defun org-mouse-for-each-item (funct) + ;; Functions called by `org-apply-on-list' need an argument + (let ((wrap-fun (lambda (c) (funcall funct)))) + (when (org-in-item-p) + (org-apply-on-list wrap-fun nil)))) (defun org-mouse-bolp () "Return true if there only spaces, tabs, and '*' before point. diff --git a/lisp/org.el b/lisp/org.el index 6d8dfdcde..1c3b06425 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11775,10 +11775,11 @@ EXTRA is additional text that will be inserted into the notes buffer." (defun org-skip-over-state-notes () "Skip past the list of State notes in an entry." (if (looking-at "\n[ \t]*- State") (forward-char 1)) - (while (looking-at "[ \t]*- State") - (condition-case nil - (org-next-item) - (error (org-end-of-item))))) + (when (org-in-item-p) + (let ((limit (org-list-bottom-point))) + (while (looking-at "[ \t]*- State") + (goto-char (or (org-get-next-item (point) limit) + (org-get-end-of-item limit))))))) (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." From 73b8674e72bf270c03fa2f7609413ca893a18e34 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Sun, 12 Sep 2010 18:59:24 +0200 Subject: [PATCH 339/348] Fix wrong usage of`org-adapt-indentation' * org.el (org-store-log-note): Fix wrong usage of`org-adapt-indentation'. --- lisp/org.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index 1c3b06425..668d46983 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11872,7 +11872,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (skip-chars-backward " \r\t\n") (cond ((and (org-at-heading-p) - (org-adapt-indentation)) + org-adapt-indentation) (1+ (org-current-level))) ((org-at-heading-p) 0) (t (org-get-indentation)))))) From bbac53d7fe1cab14bc70e152092cf7a538a6a810 Mon Sep 17 00:00:00 2001 From: Noorul Islam <noorul@noorul.com> Date: Wed, 8 Sep 2010 02:41:51 +0000 Subject: [PATCH 340/348] org-html.el: Fix exporting link to .org files. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit On Wed, Sep 8, 2010 at 2:12 AM, Daniel Clemente <n142857@gmail.com> wrote: > > Commit bd1b57f92a33485c90db1efc407c8b7c7450993a broke the exporting > of [[file:a.org]] links, which now appear as [[http:a.html]]. Try > C-c C-e H on any .org with such links, even in emacs -Q. > > The problem is, I think, that „type“ is actually "http", not "file" > as the code tries. > * lisp/org-html.el (org-html-cvt-org-as-html): Do not convert protocol from 'file' to 'http'. TINYCHANGE --- lisp/org-html.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 5da2a5fd1..1a96fa12c 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -674,7 +674,7 @@ See variable `org-export-html-link-org-files-as-html'" (string-match "\\.org$" path) (progn (list - "http" + "file" (concat (substring path 0 (match-beginning 0)) "." From c19a04ec9f623ddcefa128648139fc849b1a557e Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Mon, 13 Sep 2010 11:55:38 -0400 Subject: [PATCH 341/348] removing org-babel-temp-directory until some issues are resolved --- lisp/ob.el | 55 +++++++++++++++++++++++++++--------------------------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index cdc4f28a7..069ccfae3 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1736,13 +1736,13 @@ the remote connection." localname)) file)) -(defvar org-babel-temporary-directory - (or (and (boundp 'org-babel-temporary-directory) - org-babel-temporary-directory) - (make-temp-file "babel-" t)) - "Directory to hold temporary files created to execute code blocks. -Used by `org-babel-temp-file'. This directory will be removed on -Emacs shutdown.") +;; (defvar org-babel-temporary-directory +;; (or (and (boundp 'org-babel-temporary-directory) +;; org-babel-temporary-directory) +;; (make-temp-file "babel-" t)) +;; "Directory to hold temporary files created to execute code blocks. +;; Used by `org-babel-temp-file'. This directory will be removed on +;; Emacs shutdown.") (defun org-babel-temp-file (prefix &optional suffix) "Create a temporary file in the `org-babel-temporary-directory'. @@ -1755,28 +1755,29 @@ of `org-babel-temporary-directory'." (expand-file-name prefix temporary-file-directory) nil suffix)) - (let ((temporary-file-directory (expand-file-name - org-babel-temporary-directory - temporary-file-directory))) - (make-temp-file prefix nil suffix)))) + ;; (let ((temporary-file-directory (expand-file-name + ;; org-babel-temporary-directory + ;; temporary-file-directory))) + ;; (make-temp-file prefix nil suffix)) + (make-temp-file prefix nil suffix))) -(defun org-babel-remove-temporary-directory () - "Remove `org-babel-temporary-directory' on Emacs shutdown." - (when (boundp 'org-babel-temporary-directory) - ;; taken from `delete-directory' in files.el - (mapc (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes file))) - (delete-directory file) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files org-babel-temporary-directory 'full - "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) - (delete-directory org-babel-temporary-directory))) +;; (defun org-babel-remove-temporary-directory () +;; "Remove `org-babel-temporary-directory' on Emacs shutdown." +;; (when (boundp 'org-babel-temporary-directory) +;; ;; taken from `delete-directory' in files.el +;; (mapc (lambda (file) +;; ;; This test is equivalent to +;; ;; (and (file-directory-p fn) (not (file-symlink-p fn))) +;; ;; but more efficient +;; (if (eq t (car (file-attributes file))) +;; (delete-directory file) +;; (delete-file file))) +;; ;; We do not want to delete "." and "..". +;; (directory-files org-babel-temporary-directory 'full +;; "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) +;; (delete-directory org-babel-temporary-directory))) -(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) +;; (add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) (provide 'ob) From c4644b9e00f78e2b5aec735732e6c9a9fe48e44a Mon Sep 17 00:00:00 2001 From: Achim Gratz <Stromeko@nexgo.de> Date: Mon, 13 Sep 2010 23:25:39 +0000 Subject: [PATCH 342/348] silence byte compiler warnings about european-calendar-style I've investigated further and defvaralias doesn't silence the warnings, but "with-no-warnings" does. --- lisp/org-agenda.el | 3 ++- lisp/org.el | 7 ++++--- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 32c65dbef..9f94fa6fb 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -7279,7 +7279,8 @@ the resulting entry will not be shown. When TEXT is empty, switch to (let ((calendar-date-display-form (if (if (boundp 'calendar-date-style) (eq calendar-date-style 'european) - (org-bound-and-true-p european-calendar-style)) ; Emacs 22 + (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (org-bound-and-true-p european-calendar-style))) ; Emacs 22 '(day " " month " " year) '(month " " day " " year)))) diff --git a/lisp/org.el b/lisp/org.el index 668d46983..70dd48241 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -14604,9 +14604,10 @@ user function argument order change dependent on argument order." (list arg2 arg1 arg3)) ((eq calendar-date-style 'iso) (list arg2 arg3 arg1))) - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3)))) + (with-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (if (org-bound-and-true-p european-calendar-style) + (list arg2 arg1 arg3) + (list arg1 arg2 arg3))))) (defun org-eval-in-calendar (form &optional keepdate) "Eval FORM in the calendar window and return to current window. From 2a688e9aebb898723e4016b535dbdffa5b2cb86e Mon Sep 17 00:00:00 2001 From: Eric Schulte <schulte.eric@gmail.com> Date: Wed, 8 Sep 2010 04:38:05 +0000 Subject: [PATCH 343/348] Explicitly mention when a language-mode throws an error Hi, The attached patch makes it clear when a language mode has thrown an error. This can clear up confusion whether an error is originating from Org-mode or form the language-mode in question. Should this be committed? Best -- Eric --- lisp/org-src.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index d1948cc54..233058a54 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -276,7 +276,10 @@ buffer." (unless preserve-indentation (setq total-nindent (or (org-do-remove-indentation) 0))) (let ((org-inhibit-startup t)) - (funcall lang-f)) + (condition-case e + (funcall lang-f) + (error + (error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) (set (make-local-variable 'org-edit-src-force-single-line) single) (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) (set (make-local-variable 'org-edit-src-allow-write-back-p) allow-write-back-p) From 2ad802968bea056eecf9d809c535ee40856320b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9mi=20Vanicat?= <vanicat@debian.org> Date: Fri, 10 Sep 2010 19:58:15 +0000 Subject: [PATCH 344/348] Allow iCalendar to use UTC for exported date-time. Define a new variable org-icalendar-use-UTC-date-time that when non-nil make icalendar exporter to use UTC date-time for better compatibility with some other software (as GCALDaemon). * lisp/org-icalendar.el (org-icalendar-use-UTC-date-time): New option. (org-ical-ts-to-string): Use UTC time when requested. --- lisp/org-icalendar.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/lisp/org-icalendar.el b/lisp/org-icalendar.el index c374e2eed..1e3c798c5 100644 --- a/lisp/org-icalendar.el +++ b/lisp/org-icalendar.el @@ -194,6 +194,13 @@ When nil of the empty string, use the abbreviation retrieved from Emacs." (const :tag "Unspecified" nil) (string :tag "Time zone"))) +(defcustom org-icalendar-use-UTC-date-time () + "Non-nil force the use of the universal time for iCalendar DATE-TIME. +The iCalendar DATE-TIME can be expressed with local time or universal Time, +universal time could be more compatible with some external tools." + :group 'org-export-icalendar + :type 'boolean) + ;;; iCalendar export ;;;###autoload @@ -634,8 +641,13 @@ a time), or the day by one (if it does not contain a time)." (setq h (+ 2 h))) (setq d (1+ d)))) (setq time (encode-time s mi h d m y))) - (setq fmt (if have-time ":%Y%m%dT%H%M%S" ";VALUE=DATE:%Y%m%d")) - (concat keyword (format-time-string fmt time))))) + (setq fmt (if have-time (if org-icalendar-use-UTC-date-time + ":%Y%m%dT%H%M%SZ" + ":%Y%m%dT%H%M%S") + ";VALUE=DATE:%Y%m%d")) + (concat keyword (format-time-string fmt time + (and org-icalendar-use-UTC-date-time + have-time)))))) (provide 'org-icalendar) From d3db88ffe4fec5b59af5a06a21a8b0afd780deba Mon Sep 17 00:00:00 2001 From: Carsten Dominik <carsten.dominik@gmail.com> Date: Tue, 14 Sep 2010 14:42:37 +0200 Subject: [PATCH 345/348] LaTeX export: Configurable format for tags * lisp/org-latex.el (org-export-latex-tag-markup): New option. (org-export-latex-keywords-maybe): Use `org-export-latex-tag-markup'. --- lisp/org-latex.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 852a83a05..9a62457ec 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -280,6 +280,11 @@ markup defined, the first one in the association list will be used." (string :tag "Keyword") (string :tag "Markup"))))) +(defcustom org-export-latex-tag-markup "\\textbf{%s}" + "Markup for tags, as a printf format." + :group 'org-export-latex + :type 'string) + (defcustom org-export-latex-timestamp-markup "\\textit{%s}" "A printf format string to be applied to time stamps." :group 'org-export-latex @@ -1335,7 +1340,7 @@ links, keywords, lists, tables, fixed-width" (replace-match "") (replace-match (org-export-latex-protect-string - (format "\\textbf{%s}" + (format org-export-latex-tag-markup (save-match-data (replace-regexp-in-string "_" "\\\\_" (match-string 0))))) From 1caba219daf065218b37ff3f249637732098902f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou <n.goaziou@gmail.com> Date: Tue, 14 Sep 2010 18:30:03 +0200 Subject: [PATCH 346/348] Small refactoring and docstrings update --- lisp/org-list.el | 69 +++++++++++------------------------------------- 1 file changed, 15 insertions(+), 54 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a47ef3822..d9fc24e77 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -73,7 +73,6 @@ (defcustom org-cycle-include-plain-lists t "When t, make TAB cycle visibility on plain list items. - Cycling plain lists works only when the cursor is on a plain list item. When the cursor is on an outline heading, plain lists are treated as text. This is the most stable way of handling this, @@ -161,7 +160,6 @@ spaces instead of one after the bullet in each item of the list." (defcustom org-list-ending-method 'both "Determine where plain lists should end. - Valid values are: `regexp', `indent' or `both'. When set to `regexp', Org will look into two variables, @@ -183,7 +181,6 @@ determine lists endings. This is the default method." (defcustom org-empty-line-terminates-plain-lists nil "Non-nil means an empty line ends all plain list levels. - This variable only makes sense if `org-list-ending-method' is set to `regexp' or `both'. This is then equivalent to set `org-list-end-regexp' to \"^[ \\t]*$\"." @@ -203,14 +200,12 @@ precedence over it." (indent . t) (insert . t)) "Non-nil means apply set of rules when acting on lists. - By default, automatic actions are taken when using -\\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return], -\\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright], -\\[org-shiftmetaleft], \\[org-ctrl-c-minus], -\\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can -disable individually these rules by setting them to nil. Valid -rules are: + \\[org-meta-return], \\[org-metaright], \\[org-metaleft], + \\[org-shiftmetaright], \\[org-shiftmetaleft], + \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or + \\[org-insert-todo-heading]. You can disable individually these + rules by setting them to nil. Valid rules are: bullet when non-nil, cycling bullet do not allow lists at column 0 to have * as a bullet and descriptions lists @@ -327,7 +322,6 @@ the end of the nearest terminator from MAX." (defun org-list-maybe-skip-block (search limit) "Return non-nil value if point is in a block, skipping it on the way. - It looks for the boundary of the block in SEARCH direction, stopping at LIMIT." (save-match-data @@ -341,7 +335,6 @@ stopping at LIMIT." (defun org-list-search-unenclosed-generic (search re bound noerr) "Search a string outside blocks and protected places. - Arguments SEARCH, RE, BOUND and NOERR are similar to those in `search-forward', `search-backward', `re-search-forward' and `re-search-backward'." @@ -360,7 +353,6 @@ Arguments SEARCH, RE, BOUND and NOERR are similar to those in (defun org-search-backward-unenclosed (regexp &optional bound noerror) "Like `re-search-backward' but don't stop inside blocks or protected places. - Arguments REGEXP, BOUND and NOERROR are similar to those used in `re-search-backward'." (org-list-search-unenclosed-generic @@ -368,7 +360,6 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in (defun org-search-forward-unenclosed (regexp &optional bound noerror) "Like `re-search-forward' but don't stop inside blocks or protected places. - Arguments REGEXP, BOUND and NOERROR are similar to those used in `re-search-forward'." (org-list-search-unenclosed-generic @@ -376,7 +367,6 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in (defun org-list-in-item-p-with-indent (limit) "Is the cursor inside a plain list? - Plain lists are considered ending when a non-blank line is less indented than the previous item within LIMIT." (save-excursion @@ -413,7 +403,6 @@ indented than the previous item within LIMIT." (defun org-list-in-item-p-with-regexp (limit) "Is the cursor inside a plain list? - Plain lists end when `org-list-end-regexp' is matched, or at a blank line if `org-empty-line-terminates-plain-lists' is true. @@ -434,7 +423,6 @@ Argument LIMIT specifies the upper-bound of the search." (defun org-list-top-point-with-regexp (limit) "Return point at the top level item in a list. - Argument LIMIT specifies the upper-bound of the search. List ending is determined by regexp. See @@ -450,7 +438,6 @@ List ending is determined by regexp. See (defun org-list-bottom-point-with-regexp (limit) "Return point just before list ending. - Argument LIMIT specifies the lower-bound of the search. List ending is determined by regexp. See @@ -464,7 +451,6 @@ List ending is determined by regexp. See (defun org-list-top-point-with-indent (limit) "Return point at the top level in a list. - Argument LIMIT specifies the upper-bound of the search. List ending is determined by indentation of text. See @@ -501,7 +487,6 @@ List ending is determined by indentation of text. See (defun org-list-bottom-point-with-indent (limit) "Return point just before list ending or nil if not in a list. - Argument LIMIT specifies the lower-bound of the search. List ending is determined by the indentation of text. See @@ -568,7 +553,6 @@ uses PRE-MOVE before search. Return nil if no item was found." (defun org-list-separating-blank-lines-number (pos top bottom) "Return number of blank lines that should separate items in list. - POS is the position of point to be considered. TOP and BOTTOM are respectively position of list beginning and @@ -613,7 +597,6 @@ some heuristics to guess the result." (defun org-list-insert-item-generic (pos &optional checkbox after-bullet) "Insert a new list item at POS. - If POS is before first character after bullet of the item, the new item will be created before the current one. @@ -703,7 +686,6 @@ function ends." (defun org-list-indent-item-generic (arg no-subtree top bottom) "Indent a local list item including its children. - When number ARG is a negative, item will be outdented, otherwise it will be indented. @@ -876,8 +858,10 @@ A checkbox is blocked if all of the following conditions are fulfilled: ;; already in a list and doesn't compute list boundaries. ;; If you plan to use more than one org-list function is some code, -;; you should therefore first compute list boundaries, and then make -;; use of non-interactive forms. +;; you should therefore first check if point is in a list with +;; `org-in-item-p' or `org-at-item-p', then compute list boundaries +;; with `org-list-top-point' and `org-list-bottom-point', and make use +;; of non-interactive forms. (defun org-list-top-point () "Return point at the top level in a list. @@ -973,8 +957,8 @@ If the cursor in not in an item, throw an error." (defun org-get-end-of-item (bottom) "Return position at the end of the current item. BOTTOM is the position at list ending." - (let* ((next-p (org-get-next-item (point) bottom))) - (or next-p (org-get-end-of-list bottom)))) + (or (org-get-next-item (point) bottom) + (org-get-end-of-list bottom))) (defun org-end-of-item () "Go to the end of the current hand-formatted item. @@ -1011,7 +995,6 @@ Stop searching at LIMIT. Return nil if no item is found." (defun org-previous-item () "Move to the beginning of the previous item. - Item is at the same level in the current plain list. Error if not in a plain list, or if this is the first item in the list." (interactive) @@ -1028,7 +1011,6 @@ Stop searching at LIMIT. Return nil if no item is found." (defun org-next-item () "Move to the beginning of the next item. - Item is at the same level in the current plain list. Error if not in a plain list, or if this is the last item in the list." (interactive) @@ -1041,7 +1023,6 @@ in a plain list, or if this is the last item in the list." (defun org-list-exchange-items (beg-A beg-B bottom) "Swap item starting at BEG-A with item starting at BEG-B. - Blank lines at the end of items are left in place. Assume BEG-A is lesser than BEG-B. @@ -1062,7 +1043,6 @@ BOTTOM is the position at list ending." (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. - Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) @@ -1084,7 +1064,6 @@ so this really moves item trees." (defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. - Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) @@ -1106,7 +1085,6 @@ so this really moves item trees." (defun org-insert-item (&optional checkbox) "Insert a new item at the current level. - If cursor is before first character after bullet of the item, the new item will be created before the current one. @@ -1166,7 +1144,6 @@ bullet string and bullet counter, if any." (defun org-list-struct (begin end top bottom &optional outdent) "Return the structure containing the list between BEGIN and END. - A structure is an alist where key is point of item and values are, in that order, indentation, bullet string and value of counter, if any. A structure contains every list and sublist that @@ -1232,7 +1209,6 @@ change is an outdent." (defun org-list-struct-origins (struct) "Return an alist where key is item's position and value parent's. - STRUCT is the list's structure looked up." (let* ((struct-rev (reverse struct)) (acc (list (cons (nth 1 (car struct)) 0))) @@ -1263,7 +1239,6 @@ STRUCT is the list's structure looked up." (defun org-list-struct-get-parent (item struct origins) "Return parent association of ITEM in STRUCT or nil. - ORIGINS is the alist of parents. See `org-list-struct-origins'." (let* ((parent-pos (cdr (assq (car item) origins)))) (when (> parent-pos 0) (assq parent-pos struct)))) @@ -1276,7 +1251,6 @@ ORIGINS is the alist of parents. See `org-list-struct-origins'." (defun org-list-struct-fix-bul (struct origins) "Verify and correct bullets for every association in STRUCT. - ORIGINS is the alist of parents. See `org-list-struct-origins'. This function modifies STRUCT." @@ -1317,7 +1291,6 @@ This function modifies STRUCT." (defun org-list-struct-fix-ind (struct origins) "Verify and correct indentation for every association in STRUCT. - ORIGINS is the alist of parents. See `org-list-struct-origins'. This function modifies STRUCT." @@ -1337,7 +1310,6 @@ This function modifies STRUCT." (defun org-list-struct-fix-struct (struct origins) "Return STRUCT with correct bullets and indentation. - ORIGINS is the alist of parents. See `org-list-struct-origins'. Only elements of STRUCT that have changed are returned." @@ -1348,7 +1320,6 @@ Only elements of STRUCT that have changed are returned." (defun org-list-struct-outdent (start end origins) "Outdent items in a structure. - Items are indented when their key is between START, included, and END, excluded. @@ -1381,7 +1352,6 @@ STRUCT is the concerned structure." (defun org-list-struct-indent (start end origins struct) "Indent items in a structure. - Items are indented when their key is between START, included, and END, excluded. @@ -1444,7 +1414,6 @@ END." (defun org-list-struct-apply-struct (struct bottom) "Apply modifications to list so it mirrors STRUCT. - BOTTOM is position at list ending. Initial position is restored after the changes." @@ -1517,7 +1486,6 @@ BOTTOM is position at list ending." (defun org-outdent-item () "Outdent a local list item, but not its children. - If a region is active, all items inside will be moved." (interactive) (org-list-indent-item-generic @@ -1525,7 +1493,6 @@ If a region is active, all items inside will be moved." (defun org-indent-item () "Indent a local list item, but not its children. - If a region is active, all items inside will be moved." (interactive) (org-list-indent-item-generic @@ -1533,7 +1500,6 @@ If a region is active, all items inside will be moved." (defun org-outdent-item-tree () "Outdent a local list item including its children. - If a region is active, all items inside will be moved." (interactive) (org-list-indent-item-generic @@ -1541,7 +1507,6 @@ If a region is active, all items inside will be moved." (defun org-indent-item-tree () "Indent a local list item including its children. - If a region is active, all items inside will be moved." (interactive) (org-list-indent-item-generic @@ -1550,9 +1515,8 @@ If a region is active, all items inside will be moved." (defvar org-tab-ind-state) (defun org-cycle-item-indentation () "Cycle levels of indentation of an empty item. - -The first run indent the item, if applicable. Subsequents runs -outdent it at meaningful levels in the list. When done, item is +The first run indent the item, if applicable. Subsequents runs +outdent it at meaningful levels in the list. When done, item is put back at its original position with its original bullet. Return t at each successful move." @@ -1699,7 +1663,6 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. - With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With double prefix, set checkbox to [-]. @@ -1935,8 +1898,7 @@ Otherwise it will be `org-todo'." ;;; Misc Tools (defun org-apply-on-list (function init-value &rest args) - "Call FUNCTION for each item of a the list under point. - + "Call FUNCTION on each item of the list at point. FUNCTION must be called with at least one argument: INIT-VALUE, that will contain the value returned by the function at the previous item, plus ARGS extra arguments. @@ -1944,7 +1906,7 @@ previous item, plus ARGS extra arguments. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) will return the number of items in the current list. -Sublists of the list are skipped. Cursor is always at the +Sublists of the list are skipped. Cursor is always at the beginning of the item." (let* ((pos (copy-marker (point))) (end (copy-marker (org-list-bottom-point))) @@ -2189,7 +2151,6 @@ this list." (defun org-list-to-generic (list params) "Convert a LIST parsed through `org-list-parse-list' to other formats. - Valid parameters PARAMS are :ustart String to start an unordered list From ba741e9d2e873e85c2dfbd3f48947b132b73e75a Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Wed, 15 Sep 2010 11:36:17 +0200 Subject: [PATCH 347/348] Fix typo in customization group :tag property * org-feed.el (org-feed): Fix typo in customization group :tag property. --- lisp/org-feed.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-feed.el b/lisp/org-feed.el index 0bab6390d..e06dac589 100644 --- a/lisp/org-feed.el +++ b/lisp/org-feed.el @@ -103,7 +103,7 @@ (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." - :tag "Org ID" + :tag "Org Feed" :group 'org) (defcustom org-feed-alist nil From 0e24c574ac96292cb2684a4ddb4717d81303a7a4 Mon Sep 17 00:00:00 2001 From: David Maus <dmaus@ictsoc.de> Date: Wed, 15 Sep 2010 18:59:22 +0200 Subject: [PATCH 348/348] Remove possible folding white space in message header field * org-mhe.el (org-mhe-get-header): Remove possible folding white space in message header field. Bug reported by Andrew J. Korty. --- lisp/org-mhe.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-mhe.el b/lisp/org-mhe.el index 46340be01..fe31513f8 100644 --- a/lisp/org-mhe.el +++ b/lisp/org-mhe.el @@ -181,7 +181,7 @@ you have a better idea of how to do this then please let us know." (if (equal major-mode 'mh-folder-mode) (mh-show) (mh-show-show)) - header-field))) + (org-trim header-field)))) (defun org-mhe-follow-link (folder article) "Follow an MH-E link to FOLDER and ARTICLE.