From 4db5a1edcf2a02ffc93e06a60de580b259f04d94 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 16 Feb 2011 00:48:05 +0100 Subject: [PATCH 001/107] `org-clock-clocktable-language-setup': added spanish translation. Thanks to Juan Pechiar for providing the translation. --- lisp/org-clock.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 4f32cf7de..07cc95260 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -260,6 +260,7 @@ For more information, see `org-clocktable-write-default'." (defcustom org-clock-clocktable-language-setup '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time") + ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo") ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier") ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd")) "Terms used in clocktable, translated to different languages." From d03d3575cb644734e35f039e9ceacd9bda9a6059 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 16 Feb 2011 10:58:04 +0100 Subject: [PATCH 002/107] Code cleanup: always use 'backend instead of htmlp, latexp, etc. --- lisp/org-exp-blocks.el | 11 +++-------- lisp/org-exp.el | 9 ++++----- lisp/org-latex.el | 1 - lisp/org-special-blocks.el | 5 ++--- 4 files changed, 9 insertions(+), 17 deletions(-) diff --git a/lisp/org-exp-blocks.el b/lisp/org-exp-blocks.el index 498322769..1fac3bf05 100644 --- a/lisp/org-exp-blocks.el +++ b/lisp/org-exp-blocks.el @@ -76,11 +76,6 @@ (require 'cl)) (require 'org) -(defvar htmlp) -(defvar latexp) -(defvar docbookp) -(defvar asciip) - (defun org-export-blocks-set (var value) "Set the value of `org-export-blocks' and install fontification." (set var value) @@ -247,7 +242,7 @@ passed to the ditaa utility as command line arguments." "\n"))) (prog1 (cond - ((or htmlp latexp docbookp) + ((member backend '(html latex docbook)) (unless (file-exists-p out-file) (mapc ;; remove old hashed versions of this file (lambda (file) @@ -306,7 +301,7 @@ digraph data_relationships { (out-file (concat (car out-file-parts) "_" hash "." (cdr out-file-parts)))) (prog1 (cond - ((or htmlp latexp docbookp) + ((member backend '(html latex docbook)) (unless (file-exists-p out-file) (mapc ;; remove old hashed versions of this file (lambda (file) @@ -338,7 +333,7 @@ other backends, it converts the comment into an EXAMPLE segment." (let ((owner (if headers (car headers))) (title (if (cdr headers) (mapconcat 'identity (cdr headers) " ")))) (cond - (htmlp ;; We are exporting to HTML + ((eq backend 'html) ;; We are exporting to HTML (concat "#+BEGIN_HTML\n" "
.*\n?") nil t) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 89d9ce38e..c55804355 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -73,7 +73,6 @@ org-closed-string"\\)") "Regexp matching special time planning keywords plus the time after it.") -(defvar latexp) ; dynamically scoped from org.el (defvar re-quote) ; dynamically scoped from org.el (defvar commentsp) ; dynamically scoped from org.el diff --git a/lisp/org-special-blocks.el b/lisp/org-special-blocks.el index 34479edae..d79f8e544 100644 --- a/lisp/org-special-blocks.el +++ b/lisp/org-special-blocks.el @@ -45,12 +45,11 @@ by org-special-blocks. These blocks will presumably be interpreted by other mechanisms.") -(defvar htmlp) -(defvar latexp) +(defvar backend) (defun org-special-blocks-make-special-cookies () "Adds special cookies when #+begin_foo and #+end_foo tokens are seen. This is run after a few special cases are taken care of." - (when (or htmlp latexp) + (when (or (eq backend 'html) (eq backend 'latex)) (goto-char (point-min)) (while (re-search-forward "^[ \t]*#\\+\\(begin\\|end\\)_\\(.*\\)$" nil t) (unless (org-string-match-p org-special-blocks-ignore-regexp (match-string 2)) From 4b8d74150f33043c62a3467379a87364e087205c Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 16 Feb 2011 11:39:13 +0100 Subject: [PATCH 003/107] Fix bug: fetch the updated title of a page when creating the sitemap. * org-publish.el (org-publish-cache-ctime-of-src): improve docstring. (org-publish-find-title): New option to explicitly reset the title in the cache. (org-publish-format-file-entry): Use this new option. Thanks to Jonathan Bisson for reporting this. --- lisp/org-publish.el | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/lisp/org-publish.el b/lisp/org-publish.el index 3a29d06c9..208d9a9d5 100644 --- a/lisp/org-publish.el +++ b/lisp/org-publish.el @@ -818,15 +818,15 @@ Default for SITEMAP-FILENAME is 'sitemap.org'." (defun org-publish-format-file-entry (fmt file project-plist) (format-spec fmt - `((?t . ,(org-publish-find-title file)) + `((?t . ,(org-publish-find-title file t)) (?d . ,(format-time-string sitemap-date-format (org-publish-find-date file))) (?a . ,(or (plist-get project-plist :author) user-full-name))))) -(defun org-publish-find-title (file) +(defun org-publish-find-title (file &optional reset) "Find the title of FILE in project." (or - (org-publish-cache-get-file-property file :title nil t) + (and (not reset) (org-publish-cache-get-file-property file :title nil t)) (let* ((visiting (find-buffer-visiting file)) (buffer (or visiting (find-file-noselect file))) title) @@ -1149,7 +1149,7 @@ Returns value on success, else nil." (puthash key value org-publish-cache)) (defun org-publish-cache-ctime-of-src (filename) - "Get the files ctime as integer." + "Get the FILENAME ctime as an integer." (let ((src-attr (file-attributes (if (stringp (file-symlink-p filename)) (file-symlink-p filename) filename)))) @@ -1157,8 +1157,6 @@ Returns value on success, else nil." (lsh (car (nth 5 src-attr)) 16) (cadr (nth 5 src-attr))))) - - (provide 'org-publish) ;; arch-tag: 72807f3c-8af0-4a6b-8dca-c3376eb25adb From 045214f9d2938f1cb3ef5b1c9f49a2c0d334d26b Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 16 Feb 2011 11:40:53 +0100 Subject: [PATCH 004/107] org-special-blocks.el: mention that backend is dynamically scoped. --- lisp/org-special-blocks.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-special-blocks.el b/lisp/org-special-blocks.el index d79f8e544..54fb6cb39 100644 --- a/lisp/org-special-blocks.el +++ b/lisp/org-special-blocks.el @@ -45,7 +45,7 @@ by org-special-blocks. These blocks will presumably be interpreted by other mechanisms.") -(defvar backend) +(defvar backend) ; dynamically scoped (defun org-special-blocks-make-special-cookies () "Adds special cookies when #+begin_foo and #+end_foo tokens are seen. This is run after a few special cases are taken care of." From c7700d7bbee4f7596feb199b1ec1bc7750d4fb48 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 16 Feb 2011 11:53:28 +0100 Subject: [PATCH 005/107] * org-html.el (org-export-as-html): expand the HTML title. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit This fix is a modified version of a patch submitted by Pierre Téchoueyres. --- lisp/org-html.el | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 9135c736a..23e1316c5 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1092,16 +1092,17 @@ PUB-DIR is set, use this as the publishing directory." (date (plist-get opt-plist :date)) (author (plist-get opt-plist :author)) (html-validation-link (or org-export-html-validation-link "")) - (title (or (and subtree-p (org-export-get-title-from-subtree)) - (plist-get opt-plist :title) - (and (not body-only) - (not - (plist-get opt-plist :skip-before-1st-heading)) - (org-export-grab-title-from-buffer)) - (and buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name))) - "UNTITLED")) + (title (org-html-expand + (or (and subtree-p (org-export-get-title-from-subtree)) + (plist-get opt-plist :title) + (and (not body-only) + (not + (plist-get opt-plist :skip-before-1st-heading)) + (org-export-grab-title-from-buffer)) + (and buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name))) + "UNTITLED"))) (link-up (and (plist-get opt-plist :link-up) (string-match "\\S-" (plist-get opt-plist :link-up)) (plist-get opt-plist :link-up))) @@ -1280,7 +1281,7 @@ lang=\"%s\" xml:lang=\"%s\"> org-export-html-preamble-format)) (cadr (assoc "en" org-export-html-preamble-format)))))) (insert (format-spec html-preamble-format - `((?t . ,(org-html-expand title)) + `((?t . ,title) (?a . ,author) (?d . ,date) (?e . ,email))))))) (if (and org-export-with-toc (not body-only)) From 17351b924f55f0d639a13d9b4493c08b266f133a Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Thu, 17 Feb 2011 17:38:57 +0100 Subject: [PATCH 006/107] org-clock.el: require 'org-exp to set `org-export-default-language'. Thanks to Matt Lundin for reporting this. --- lisp/org-clock.el | 1 + 1 file changed, 1 insertion(+) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 07cc95260..66a3b4bf2 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -29,6 +29,7 @@ ;; This file contains the time clocking code for Org-mode (require 'org) +(require 'org-exp) ;;; Code: (eval-when-compile From 196a9d7b2b6969bb77d879118c04aac5a800adb7 Mon Sep 17 00:00:00 2001 From: Sebastian Rose Date: Mon, 27 Sep 2010 10:36:01 +0000 Subject: [PATCH 007/107] Decode single byte sequence if decoding unicode failed. * org-protocol.el (org-protocol-unhex-single-byte-sequence): New function. Decode hex-encoded singly byte sequences. (org-protocol-unhex-compound): Use new function if decoding sequence as unicode character failed. --- lisp/org-protocol.el | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 5d5059fbf..fae48c4dc 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -305,7 +305,7 @@ part." (defun org-protocol-unhex-string(str) "Unhex hexified unicode strings as returned from the JavaScript function -encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." +encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'." (setq str (or str "")) (let ((tmp "") (case-fold-search t)) @@ -321,7 +321,9 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." (defun org-protocol-unhex-compound (hex) - "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ü'." + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'. +Note: this function also decodes single byte encodings like +`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group." (let* ((bytes (remove "" (split-string hex "%"))) (ret "") (eat 0) @@ -353,12 +355,30 @@ encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ü'." (setq val (logxor val xor)) (setq sum (+ (lsh sum shift) val)) (if (> eat 0) (setq eat (- eat 1))) - (when (= 0 eat) + (cond + ((= 0 eat) ;multi byte (setq ret (concat ret (org-protocol-char-to-string sum))) (setq sum 0)) + ((not bytes) ; single byte(s) + (setq ret (org-protocol-unhex-single-byte-sequence hex)))) )) ;; end (while bytes ret )) +(defun org-protocol-unhex-single-byte-sequence(hex) + "Unhexify hex-encoded single byte character sequences." + (let ((bytes (remove "" (split-string hex "%"))) + (ret "")) + (while bytes + (let* ((b (pop bytes)) + (a (elt b 0)) + (b (elt b 1)) + (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) + (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))) + (setq ret + (concat ret (char-to-string + (+ (lsh c1 4) c2)))))) + ret)) + (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) "Greedy handlers might receive a list like this from emacsclient: '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") From 0c4bb0e40647ed18d41818f8ebd442cf50d47c76 Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 10:38:27 +0100 Subject: [PATCH 008/107] New unicode aware percent encoding algorithm * org.el (org-link-escape): New unicode aware percent encoding algorithm. --- lisp/org.el | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 82a0986fe..8737900c5 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8636,17 +8636,14 @@ This is the list that is used before handing over to the browser.") (if (and org-url-encoding-use-url-hexify (not table)) (url-hexify-string text) (setq table (or table org-link-escape-chars)) - (when text - (let ((re (mapconcat (lambda (x) (regexp-quote - (char-to-string (car x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (cdr (assoc (string-to-char (match-string 0 text)) - table)) - t t text))) - text)))) + (mapconcat + (lambda (char) + (if (or (assoc char table) + (< char 32) (> char 126)) + (mapconcat (lambda (sequence) + (format "%%%.2X" sequence)) + (encode-coding-char char 'utf-8) "") + (char-to-string char))) text ""))) (defun org-link-unescape (text &optional table) "Reverse the action of `org-link-escape'." From 1a68b67939fc9b965c9fd476617b61c16225a5b9 Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 10:45:06 +0100 Subject: [PATCH 009/107] New format of percent escape table * org.el (org-link-escape-chars, org-link-escape-chars-browser): New format of percent escape table. (org-link-escape): Use new table format. Just a plain list with the chars that should be escaped. --- lisp/org.el | 27 +++++---------------------- 1 file changed, 5 insertions(+), 22 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 8737900c5..c6d02c87f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8603,32 +8603,15 @@ according to FMT (default from `org-email-link-description-format')." "]")) (defconst org-link-escape-chars - '((?\ . "%20") - (?\[ . "%5B") - (?\] . "%5D") - (?\340 . "%E0") ; `a - (?\342 . "%E2") ; ^a - (?\347 . "%E7") ; ,c - (?\350 . "%E8") ; `e - (?\351 . "%E9") ; 'e - (?\352 . "%EA") ; ^e - (?\356 . "%EE") ; ^i - (?\364 . "%F4") ; ^o - (?\371 . "%F9") ; `u - (?\373 . "%FB") ; ^u - (?\; . "%3B") -;; (?? . "%3F") - (?= . "%3D") - (?+ . "%2B") - ) - "Association list of escapes for some characters problematic in links. + '(?\ ?\[ ?\] ?\; ?\= ?\+) + "List of characters that should be escaped in link. This is the list that is used for internal purposes.") (defvar org-url-encoding-use-url-hexify nil) (defconst org-link-escape-chars-browser - '((?\ . "%20")) ; 32 for the SPC char - "Association list of escapes for some characters problematic in links. + '(?\ ) + "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") (defun org-link-escape (text &optional table) @@ -8638,7 +8621,7 @@ This is the list that is used before handing over to the browser.") (setq table (or table org-link-escape-chars)) (mapconcat (lambda (char) - (if (or (assoc char table) + (if (or (member char table) (< char 32) (> char 126)) (mapconcat (lambda (sequence) (format "%%%.2X" sequence)) From 41c771378a51df9418ef7c290ce6cf04a736de1d Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 11:00:39 +0100 Subject: [PATCH 010/107] Fixup doc string * org.el (org-link-escape): Fixup doc string. --- lisp/org.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/org.el b/lisp/org.el index c6d02c87f..ec817f07c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8615,7 +8615,10 @@ This is the list that is used for internal purposes.") This is the list that is used before handing over to the browser.") (defun org-link-escape (text &optional table) - "Escape characters in TEXT that are problematic for links." + "Return percent escaped representation of TEXT. +TEXT is a string with the text to escape. +Optional argument TABLE is a list with characters that should be +escaped. When nil, `org-link-escape-chars' is used." (if (and org-url-encoding-use-url-hexify (not table)) (url-hexify-string text) (setq table (or table org-link-escape-chars)) From 27915744a28cda571b14679fd9fc92432c51b439 Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 11:12:07 +0100 Subject: [PATCH 011/107] New optional argument: Merge user table with default table * org.el (org-link-escape): New optional argument. Merge user table with default table. --- lisp/org.el | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index ec817f07c..873cfe19d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8614,14 +8614,22 @@ This is the list that is used for internal purposes.") "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") -(defun org-link-escape (text &optional table) +(defun org-link-escape (text &optional table merge) "Return percent escaped representation of TEXT. TEXT is a string with the text to escape. Optional argument TABLE is a list with characters that should be -escaped. When nil, `org-link-escape-chars' is used." +escaped. When nil, `org-link-escape-chars' is used. +If optional argument MERGE is set, merge TABLE into +`org-link-escape-chars'." (if (and org-url-encoding-use-url-hexify (not table)) (url-hexify-string text) - (setq table (or table org-link-escape-chars)) + (cond + ((and table merge) + (mapc (lambda (defchr) + (unless (member defchr table) + (setq table (cons defchr table)))) org-link-escape-chars)) + ((null table) + (setq table org-link-escape-chars))) (mapconcat (lambda (char) (if (or (member char table) From 465940d6c263dd6eaaf65eaf6b4589b2c270d30e Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 11:20:40 +0100 Subject: [PATCH 012/107] Inline function to properly decode utf8 characters in Emacs 22 * org-macs.el (org-char-to-string): Inline function to properly decode utf8 characters in Emacs 22. Moved and renamed from org-protocol.el. * org-protocol.el (org-protocol-unhex-compound): Use renamed inline function. --- lisp/org-macs.el | 9 ++++++++- lisp/org-protocol.el | 13 +------------ 2 files changed, 9 insertions(+), 13 deletions(-) diff --git a/lisp/org-macs.el b/lisp/org-macs.el index 97a8fdc06..9c161e325 100644 --- a/lisp/org-macs.el +++ b/lisp/org-macs.el @@ -35,7 +35,14 @@ (eval-and-compile (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly)))) + (defmacro declare-function (fn file &optional arglist fileonly))) + (if (>= emacs-major-version 23) + (defsubst org-char-to-string(c) + "Defsubst to decode UTF-8 character values in emacs 23 and beyond." + (char-to-string c)) + (defsubst org-char-to-string (c) + "Defsubst to decode UTF-8 character values in emacs 22." + (string (decode-char 'ucs c))))) (declare-function org-add-props "org-compat" (string plist &rest props)) (declare-function org-string-match-p "org-compat" (&rest args)) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index fae48c4dc..6c96cdb81 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -292,17 +292,6 @@ part." (mapcar 'org-protocol-unhex-string split-parts)) split-parts))) -;; This inline function is needed in org-protocol-unhex-compound to do -;; the right thing to decode UTF-8 char integer values. -(eval-when-compile - (if (>= emacs-major-version 23) - (defsubst org-protocol-char-to-string(c) - "Defsubst to decode UTF-8 character values in emacs 23 and beyond." - (char-to-string c)) - (defsubst org-protocol-char-to-string (c) - "Defsubst to decode UTF-8 character values in emacs 22." - (string (decode-char 'ucs c))))) - (defun org-protocol-unhex-string(str) "Unhex hexified unicode strings as returned from the JavaScript function encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'." @@ -357,7 +346,7 @@ Note: this function also decodes single byte encodings like (if (> eat 0) (setq eat (- eat 1))) (cond ((= 0 eat) ;multi byte - (setq ret (concat ret (org-protocol-char-to-string sum))) + (setq ret (concat ret (org-char-to-string sum))) (setq sum 0)) ((not bytes) ; single byte(s) (setq ret (org-protocol-unhex-single-byte-sequence hex)))) From 51e665622cda249d43637da1e681dc8c602f0384 Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 11:33:13 +0100 Subject: [PATCH 013/107] Unescape functions moved and renamed from org-protocol.el * org.el (org-link-unescape, org-link-unescape-compound) (org-link-unescape-single-byte-sequence): Functions moved and renamed from org-protocol.el. --- lisp/org.el | 90 +++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 74 insertions(+), 16 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 873cfe19d..8151bfc9f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8639,22 +8639,80 @@ If optional argument MERGE is set, merge TABLE into (encode-coding-char char 'utf-8) "") (char-to-string char))) text ""))) -(defun org-link-unescape (text &optional table) - "Reverse the action of `org-link-escape'." - (if (and org-url-encoding-use-url-hexify (not table)) - (url-unhex-string text) - (setq table (or table org-link-escape-chars)) - (when text - (let ((case-fold-search t) - (re (mapconcat (lambda (x) (regexp-quote (downcase (cdr x)))) - table "\\|"))) - (while (string-match re text) - (setq text - (replace-match - (char-to-string (car (rassoc (upcase (match-string 0 text)) - table))) - t t text))) - text)))) +(defun org-link-unescape (str) + "Unhex hexified unicode strings as returned from the JavaScript function +encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'." + (setq str (or str "")) + (let ((tmp "") + (case-fold-search t)) + (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (hex (match-string 0 str)) + (replacement (org-link-unescape-compound (upcase hex)))) + (setq tmp (concat tmp (substring str 0 start) replacement)) + (setq str (substring str end)))) + (setq tmp (concat tmp str)) + tmp)) + +(defun org-link-unescape-compound (hex) + "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'. +Note: this function also decodes single byte encodings like +`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group." + (let* ((bytes (remove "" (split-string hex "%"))) + (ret "") + (eat 0) + (sum 0)) + (while bytes + (let* ((b (pop bytes)) + (a (elt b 0)) + (b (elt b 1)) + (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) + (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0))) + (val (+ (lsh c1 4) c2)) + (shift + (if (= 0 eat) ;; new byte + (if (>= val 252) 6 + (if (>= val 248) 5 + (if (>= val 240) 4 + (if (>= val 224) 3 + (if (>= val 192) 2 0))))) + 6)) + (xor + (if (= 0 eat) ;; new byte + (if (>= val 252) 252 + (if (>= val 248) 248 + (if (>= val 240) 240 + (if (>= val 224) 224 + (if (>= val 192) 192 0))))) + 128))) + (if (>= val 192) (setq eat shift)) + (setq val (logxor val xor)) + (setq sum (+ (lsh sum shift) val)) + (if (> eat 0) (setq eat (- eat 1))) + (cond + ((= 0 eat) ;multi byte + (setq ret (concat ret (org-char-to-string sum))) + (setq sum 0)) + ((not bytes) ; single byte(s) + (setq ret (org-link-unescape-single-byte-sequence hex)))) + )) ;; end (while bytes + ret )) + +(defun org-link-unescape-single-byte-sequence (hex) + "Unhexify hex-encoded single byte character sequences." + (let ((bytes (remove "" (split-string hex "%"))) + (ret "")) + (while bytes + (let* ((b (pop bytes)) + (a (elt b 0)) + (b (elt b 1)) + (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) + (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))) + (setq ret + (concat ret (char-to-string + (+ (lsh c1 4) c2)))))) + ret)) (defun org-xor (a b) "Exclusive or." From 17f3548e78d23aca8ecef251c07daa40604468b7 Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 11:44:44 +0100 Subject: [PATCH 014/107] Declare obsolete & alias to respective org-link-unescape-* functions * org-protocol.el (org-protocol-unhex-string) (org-protocol-unhex-compound) (org-protocol-unhex-single-byte-sequence): Declare obsolete and alias to respective org-link-unescape-* functions. --- lisp/org-protocol.el | 88 ++++++-------------------------------------- 1 file changed, 12 insertions(+), 76 deletions(-) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 6c96cdb81..46441db25 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -130,6 +130,18 @@ (filename &optional up)) (declare-function server-edit "server" (&optional arg)) +(define-obsolete-function-alias + 'org-protocol-unhex-compound 'org-link-unescape-compound + "2010-11-21") + +(define-obsolete-function-alias + 'org-protocol-unhex-string 'org-link-unescape + "2010-11-21") + +(define-obsolete-function-alias + 'org-protocol-unhex-single-byte-sequence + 'org-link-unescape-single-byte-sequence + "2011-11-21") (defgroup org-protocol nil "Intercept calls from emacsclient to trigger custom actions. @@ -292,82 +304,6 @@ part." (mapcar 'org-protocol-unhex-string split-parts)) split-parts))) -(defun org-protocol-unhex-string(str) - "Unhex hexified unicode strings as returned from the JavaScript function -encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (hex (match-string 0 str)) - (replacement (org-protocol-unhex-compound (upcase hex)))) - (setq tmp (concat tmp (substring str 0 start) replacement)) - (setq str (substring str end)))) - (setq tmp (concat tmp str)) - tmp)) - - -(defun org-protocol-unhex-compound (hex) - "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'. -Note: this function also decodes single byte encodings like -`%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group." - (let* ((bytes (remove "" (split-string hex "%"))) - (ret "") - (eat 0) - (sum 0)) - (while bytes - (let* ((b (pop bytes)) - (a (elt b 0)) - (b (elt b 1)) - (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) - (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0))) - (val (+ (lsh c1 4) c2)) - (shift - (if (= 0 eat) ;; new byte - (if (>= val 252) 6 - (if (>= val 248) 5 - (if (>= val 240) 4 - (if (>= val 224) 3 - (if (>= val 192) 2 0))))) - 6)) - (xor - (if (= 0 eat) ;; new byte - (if (>= val 252) 252 - (if (>= val 248) 248 - (if (>= val 240) 240 - (if (>= val 224) 224 - (if (>= val 192) 192 0))))) - 128))) - (if (>= val 192) (setq eat shift)) - (setq val (logxor val xor)) - (setq sum (+ (lsh sum shift) val)) - (if (> eat 0) (setq eat (- eat 1))) - (cond - ((= 0 eat) ;multi byte - (setq ret (concat ret (org-char-to-string sum))) - (setq sum 0)) - ((not bytes) ; single byte(s) - (setq ret (org-protocol-unhex-single-byte-sequence hex)))) - )) ;; end (while bytes - ret )) - -(defun org-protocol-unhex-single-byte-sequence(hex) - "Unhexify hex-encoded single byte character sequences." - (let ((bytes (remove "" (split-string hex "%"))) - (ret "")) - (while bytes - (let* ((b (pop bytes)) - (a (elt b 0)) - (b (elt b 1)) - (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) - (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))) - (setq ret - (concat ret (char-to-string - (+ (lsh c1 4) c2)))))) - ret)) - (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) "Greedy handlers might receive a list like this from emacsclient: '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") From 98bf28c52fb83764a2bc91de12ca6929fdb12f3d Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 11:51:31 +0100 Subject: [PATCH 015/107] Remove obsolete argument in call to org-link-unescape * org-mobile.el (org-mobile-locate-entry): Remove obsolete argument in call to org-link-unescape. `org-link-unescape' always unescapes all percent escaped sequences. --- lisp/org-mobile.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 4b16e2b8f..3b9f45d1d 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -969,11 +969,10 @@ is currently a noop.") (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) nil (let ((file (match-string 1 link)) - (path (match-string 2 link)) - (table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) - (setq file (org-link-unescape file table)) + (path (match-string 2 link))) + (setq file (org-link-unescape file)) (setq file (expand-file-name file org-directory)) - (setq path (mapcar (lambda (x) (org-link-unescape x table)) + (setq path (mapcar 'org-link-unescape (org-split-string path "/"))) (org-find-olp (cons file path)))))) From d8c2cad3ef03019b0096abc3a3b37895510d867f Mon Sep 17 00:00:00 2001 From: David Maus Date: Sun, 21 Nov 2010 12:06:42 +0100 Subject: [PATCH 016/107] Use new percent escape character table format * org-mobile.el (org-mobile-escape-olp): Use new percent escape character table format. --- lisp/org-mobile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el index 3b9f45d1d..c3d181d10 100644 --- a/lisp/org-mobile.el +++ b/lisp/org-mobile.el @@ -660,7 +660,7 @@ The table of checksums is written to the file mobile-checksums." (org-mobile-escape-olp (nth 4 (org-heading-components)))))) (defun org-mobile-escape-olp (s) - (let ((table '((?: . "%3a") (?\[ . "%5b") (?\] . "%5d") (?/ . "%2f")))) + (let ((table '(?: ?/))) (org-link-escape s table))) ;;;###autoload From 1350e576263db0d5be70572fbf0d8a4f9ed97a24 Mon Sep 17 00:00:00 2001 From: David Maus Date: Mon, 22 Nov 2010 19:21:57 +0100 Subject: [PATCH 017/107] Add percent sign to list of escape chars * org.el (org-link-escape-chars-browser, org-link-escape-chars): Add percent sign to list of escape chars. --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 8151bfc9f..ac99f6cab 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8603,14 +8603,14 @@ according to FMT (default from `org-email-link-description-format')." "]")) (defconst org-link-escape-chars - '(?\ ?\[ ?\] ?\; ?\= ?\+) + '(?\ ?\[ ?\] ?\; ?\= ?\+ ?\%) "List of characters that should be escaped in link. This is the list that is used for internal purposes.") (defvar org-url-encoding-use-url-hexify nil) (defconst org-link-escape-chars-browser - '(?\ ) + '(?\ ?\%) "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") From dc76fd5d7127645e2699b1b194cf3ad26f73d4f0 Mon Sep 17 00:00:00 2001 From: David Maus Date: Wed, 24 Nov 2010 21:50:46 +0100 Subject: [PATCH 018/107] Rename lambda argument * org.el (org-link-escape): Rename lambda argument. --- lisp/org.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index ac99f6cab..043cac439 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8634,8 +8634,8 @@ If optional argument MERGE is set, merge TABLE into (lambda (char) (if (or (member char table) (< char 32) (> char 126)) - (mapconcat (lambda (sequence) - (format "%%%.2X" sequence)) + (mapconcat (lambda (sequence-element) + (format "%%%.2X" sequence-element)) (encode-coding-char char 'utf-8) "") (char-to-string char))) text ""))) From 7b58cccdddfd55daa70aaf5c775aa1f1482ab32e Mon Sep 17 00:00:00 2001 From: David Maus Date: Sat, 27 Nov 2010 20:02:23 +0100 Subject: [PATCH 019/107] Refactor unescaping functions * org.el (org-link-unescape): Simpler algorithm for replacing percent escapes. (org-link-unescape-compound): Use cond statements instead of nested if, convert hex string with string-to-number, save match data. (org-link-unescape-single-byte-sequence): Use mapconcat and string-to-number for unescaping single byte sequence. --- lisp/org.el | 102 ++++++++++++++++++++-------------------------------- 1 file changed, 39 insertions(+), 63 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 043cac439..6b2dc2ba0 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8642,77 +8642,53 @@ If optional argument MERGE is set, merge TABLE into (defun org-link-unescape (str) "Unhex hexified unicode strings as returned from the JavaScript function encodeURIComponent. E.g. `%C3%B6' is the german Umlaut `ö'." - (setq str (or str "")) - (let ((tmp "") - (case-fold-search t)) - (while (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (hex (match-string 0 str)) - (replacement (org-link-unescape-compound (upcase hex)))) - (setq tmp (concat tmp (substring str 0 start) replacement)) - (setq str (substring str end)))) - (setq tmp (concat tmp str)) - tmp)) + (unless (and (null str) (string= "" str)) + (let ((pos 0) (case-fold-search t) unhexed) + (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos)) + (setq unhexed (org-link-unescape-compound (match-string 0 str))) + (setq str (replace-match unhexed t t str)) + (setq pos (+ pos (length unhexed)))))) + str) (defun org-link-unescape-compound (hex) "Unhexify unicode hex-chars. E.g. `%C3%B6' is the German Umlaut `ö'. Note: this function also decodes single byte encodings like `%E1' (\"á\") if not followed by another `%[A-F0-9]{2}' group." - (let* ((bytes (remove "" (split-string hex "%"))) - (ret "") - (eat 0) - (sum 0)) - (while bytes - (let* ((b (pop bytes)) - (a (elt b 0)) - (b (elt b 1)) - (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) - (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0))) - (val (+ (lsh c1 4) c2)) - (shift - (if (= 0 eat) ;; new byte - (if (>= val 252) 6 - (if (>= val 248) 5 - (if (>= val 240) 4 - (if (>= val 224) 3 - (if (>= val 192) 2 0))))) - 6)) - (xor - (if (= 0 eat) ;; new byte - (if (>= val 252) 252 - (if (>= val 248) 248 - (if (>= val 240) 240 - (if (>= val 224) 224 - (if (>= val 192) 192 0))))) - 128))) - (if (>= val 192) (setq eat shift)) - (setq val (logxor val xor)) - (setq sum (+ (lsh sum shift) val)) - (if (> eat 0) (setq eat (- eat 1))) - (cond - ((= 0 eat) ;multi byte - (setq ret (concat ret (org-char-to-string sum))) - (setq sum 0)) - ((not bytes) ; single byte(s) - (setq ret (org-link-unescape-single-byte-sequence hex)))) - )) ;; end (while bytes - ret )) + (save-match-data + (let* ((bytes (cdr (split-string hex "%"))) + (ret "") + (eat 0) + (sum 0)) + (while bytes + (let* ((val (string-to-number (pop bytes) 16)) + (shift-xor + (if (= 0 eat) + (cond + ((>= val 252) (cons 6 252)) + ((>= val 248) (cons 5 248)) + ((>= val 240) (cons 4 240)) + ((>= val 224) (cons 3 224)) + ((>= val 192) (cons 2 192)) + (t (cons 0 0))) + (cons 6 128)))) + (if (>= val 192) (setq eat (car shift-xor))) + (setq val (logxor val (cdr shift-xor))) + (setq sum (+ (lsh sum (car shift-xor)) val)) + (if (> eat 0) (setq eat (- eat 1))) + (cond + ((= 0 eat) ;multi byte + (setq ret (concat ret (org-char-to-string sum))) + (setq sum 0)) + ((not bytes) ; single byte(s) + (setq ret (org-link-unescape-single-byte-sequence hex)))) + )) ;; end (while bytes + ret ))) (defun org-link-unescape-single-byte-sequence (hex) "Unhexify hex-encoded single byte character sequences." - (let ((bytes (remove "" (split-string hex "%"))) - (ret "")) - (while bytes - (let* ((b (pop bytes)) - (a (elt b 0)) - (b (elt b 1)) - (c1 (if (> a ?9) (+ 10 (- a ?A)) (- a ?0))) - (c2 (if (> b ?9) (+ 10 (- b ?A)) (- b ?0)))) - (setq ret - (concat ret (char-to-string - (+ (lsh c1 4) c2)))))) - ret)) + (mapconcat (lambda (byte) + (char-to-string (string-to-number byte 16))) + (cdr (split-string hex "%")) "")) (defun org-xor (a b) "Exclusive or." From 139cc1d4c2623ab9b11546a3959ea315ed720f0b Mon Sep 17 00:00:00 2001 From: David Maus Date: Wed, 15 Dec 2010 19:58:37 +0100 Subject: [PATCH 020/107] Always percent escape the percent sign * lisp/org.el (org-link-escape, org-link-escape-chars-browser) (org-link-escape-chars): Always percent escape the percent sign. --- lisp/org.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 6b2dc2ba0..6e60e4272 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8603,14 +8603,14 @@ according to FMT (default from `org-email-link-description-format')." "]")) (defconst org-link-escape-chars - '(?\ ?\[ ?\] ?\; ?\= ?\+ ?\%) + '(?\ ?\[ ?\] ?\; ?\= ?\+) "List of characters that should be escaped in link. This is the list that is used for internal purposes.") (defvar org-url-encoding-use-url-hexify nil) (defconst org-link-escape-chars-browser - '(?\ ?\%) + '(?\ ) "List of escapes for characters that are problematic in links. This is the list that is used before handing over to the browser.") @@ -8633,7 +8633,7 @@ If optional argument MERGE is set, merge TABLE into (mapconcat (lambda (char) (if (or (member char table) - (< char 32) (> char 126)) + (< char 32) (= char 37) (> char 126)) (mapconcat (lambda (sequence-element) (format "%%%.2X" sequence-element)) (encode-coding-char char 'utf-8) "") From 0590bb7fe17b70e928a5bccb50013d827396b525 Mon Sep 17 00:00:00 2001 From: David Maus Date: Wed, 15 Dec 2010 20:01:51 +0100 Subject: [PATCH 021/107] Use `org-link-unescape' instead of obsolete unhex string function * lisp/org-protocol.el (org-protocol-split-data) (org-protocol-open-source): Use `org-link-unescape' instead of obsolete unhex string function. --- lisp/org-protocol.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index 46441db25..b1ad0a98e 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -301,7 +301,7 @@ part." (if unhexify (if (fboundp unhexify) (mapcar unhexify split-parts) - (mapcar 'org-protocol-unhex-string split-parts)) + (mapcar 'org-link-unescape split-parts)) split-parts))) (defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) @@ -476,7 +476,7 @@ The location for a browser's bookmark should look like this: ;; As we enter this function for a match on our protocol, the return value ;; defaults to nil. (let ((result nil) - (f (org-protocol-unhex-string fname))) + (f (org-link-unescape fname))) (catch 'result (dolist (prolist org-protocol-project-alist) (let* ((base-url (plist-get (cdr prolist) :base-url)) From 0d6dacd978eaaf548ce1e5e6f72fc2d3ab60d894 Mon Sep 17 00:00:00 2001 From: David Maus Date: Wed, 15 Dec 2010 20:11:15 +0100 Subject: [PATCH 022/107] Throw error if encoding character in utf8 fails * lisp/org.el (org-link-escape): Throw error if encoding character in utf8 fails. --- lisp/org.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 6e60e4272..655d10621 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8636,8 +8636,10 @@ If optional argument MERGE is set, merge TABLE into (< char 32) (= char 37) (> char 126)) (mapconcat (lambda (sequence-element) (format "%%%.2X" sequence-element)) - (encode-coding-char char 'utf-8) "") - (char-to-string char))) text ""))) + (or (encode-coding-char char 'utf-8) + (error "Unable to percent escape character: %s" + (char-to-string char))) "") + (char-to-string char))) text ""))) (defun org-link-unescape (str) "Unhex hexified unicode strings as returned from the JavaScript function From 373caa4d1cbf3e94edd32519b5bda1ac2d086a76 Mon Sep 17 00:00:00 2001 From: David Maus Date: Thu, 17 Feb 2011 20:21:54 +0100 Subject: [PATCH 023/107] Change date of obsolete declaration to 2011-02-17 * org-protocol.el (org-protocol-unhex-single-byte-sequence) (org-protocol-unhex-string, org-protocol-unhex-compound): Change date of obsolete declaration to 2011-02-17. --- lisp/org-protocol.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org-protocol.el b/lisp/org-protocol.el index b1ad0a98e..84f2c9ddd 100644 --- a/lisp/org-protocol.el +++ b/lisp/org-protocol.el @@ -132,16 +132,16 @@ (define-obsolete-function-alias 'org-protocol-unhex-compound 'org-link-unescape-compound - "2010-11-21") + "2011-02-17") (define-obsolete-function-alias 'org-protocol-unhex-string 'org-link-unescape - "2010-11-21") + "2011-02-17") (define-obsolete-function-alias 'org-protocol-unhex-single-byte-sequence 'org-link-unescape-single-byte-sequence - "2011-11-21") + "2011-02-17") (defgroup org-protocol nil "Intercept calls from emacsclient to trigger custom actions. From 68114fb650f4653eb6e71f3004e396c4241e54dd Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 18 Feb 2011 09:49:12 +0100 Subject: [PATCH 024/107] Replace remaining htmlp and latexp conditions. --- contrib/lisp/org-exp-bibtex.el | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) diff --git a/contrib/lisp/org-exp-bibtex.el b/contrib/lisp/org-exp-bibtex.el index ab6a6b006..de3d662e3 100644 --- a/contrib/lisp/org-exp-bibtex.el +++ b/contrib/lisp/org-exp-bibtex.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2009 Taru Karttunen -;; Author: Taru Karttunen +;; Author: Taru Karttunen ;; This file is not currently part of GNU Emacs. @@ -72,13 +72,12 @@ (opt (org-exp-bibtex-options-to-plist (match-string 3)))) (replace-match (cond - (htmlp ;; We are exporting to HTML + ((eq backend 'html) ;; We are exporting to HTML (let (extra-args cite-list end-hook tmp-files) (dolist (elt opt) (when (equal "option" (car elt)) (setq extra-args (cons (cdr elt) extra-args)))) - (when (assoc "limit" opt) ;; Limit is true - collect references (org-exp-bibtex-docites (lambda () (dolist (c (org-split-string (match-string 1) ",")) @@ -107,13 +106,12 @@ (while (re-search-forward "
" nil t) (replace-match "
" t t)) (concat "\n#+BEGIN_HTML\n
\n" (buffer-string) "\n
\n#+END_HTML\n")))) - (latexp ;; Latex export + ((eq backend 'latex) ;; Latex export (concat "\n#+LATEX: \\bibliographystyle{" style "}" "\n#+LATEX: \\bibliography{" file "}\n"))) t t))) - ;; Convert cites to links in html - (when htmlp + (when (eq backend 'html) ;; Split citation commands with multiple keys (org-exp-bibtex-docites (lambda () @@ -126,28 +124,21 @@ (lambda () (let* ((cn (match-string 1)) (cv (assoc cn oebp-cite-plist))) ;; (message "L: %s" (concat "\[_{}[[" cn "][" (if cv (cdr cv) cn) "]]\]")) - (replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t)))) - - -)) + (replace-match (concat "\[_{}[[#" cn "][" (if cv (cdr cv) cn) "]]\]")) t t)))))) (defun org-exp-bibtex-docites (fun) (save-excursion (save-match-data (goto-char (point-min)) - (when htmlp + (when (eq backend 'html) (while (re-search-forward "\\\\cite{\\([^}\n]+\\)}" nil t) (apply fun nil)))))) - (defun org-exp-bibtex-options-to-plist (options) (save-match-data (flet ((f (o) (let ((s (split-string o ":"))) (cons (nth 0 s) (nth 1 s))))) (mapcar 'f (split-string options nil t))))) - - - (add-hook 'org-export-preprocess-hook 'org-export-bibtex-preprocess) (provide 'org-exp-bibtex) From e16c502b4a4753138ae9773d35af84de93586e55 Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 18 Feb 2011 11:25:11 +0100 Subject: [PATCH 025/107] org-latex.el: fix bug about #+BIND directive not followed. * org-latex.el (org-export-latex-content): bind local variables for export in the temporary export buffer. Thanks to Andreas Leha for reporting this. --- lisp/org-latex.el | 49 ++++++++++++++++++++++++----------------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index c55804355..f803737c6 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -1441,31 +1441,32 @@ Don't perform conversions that are in EXCLUDE-LIST. Recognized conversion types are: quotation-marks, emphasis, sub-superscript, links, keywords, lists, tables, fixed-width" (with-temp-buffer - (insert content) - (unless (memq 'timestamps exclude-list) - (org-export-latex-time-stamps)) - (unless (memq 'quotation-marks exclude-list) - (org-export-latex-quotation-marks)) - (unless (memq 'emphasis exclude-list) - (when (plist-get org-export-latex-options-plist :emphasize) - (org-export-latex-fontify))) - (unless (memq 'sub-superscript exclude-list) - (org-export-latex-special-chars - (plist-get org-export-latex-options-plist :sub-superscript))) - (unless (memq 'links exclude-list) - (org-export-latex-links)) - (unless (memq 'keywords exclude-list) - (org-export-latex-keywords)) - (unless (memq 'lists exclude-list) - (org-export-latex-lists)) - (unless (memq 'tables exclude-list) - (org-export-latex-tables - (plist-get org-export-latex-options-plist :tables))) - (unless (memq 'fixed-width exclude-list) - (org-export-latex-fixed-width - (plist-get org-export-latex-options-plist :fixed-width))) + (org-install-letbind) + (insert content) + (unless (memq 'timestamps exclude-list) + (org-export-latex-time-stamps)) + (unless (memq 'quotation-marks exclude-list) + (org-export-latex-quotation-marks)) + (unless (memq 'emphasis exclude-list) + (when (plist-get org-export-latex-options-plist :emphasize) + (org-export-latex-fontify))) + (unless (memq 'sub-superscript exclude-list) + (org-export-latex-special-chars + (plist-get org-export-latex-options-plist :sub-superscript))) + (unless (memq 'links exclude-list) + (org-export-latex-links)) + (unless (memq 'keywords exclude-list) + (org-export-latex-keywords)) + (unless (memq 'lists exclude-list) + (org-export-latex-lists)) + (unless (memq 'tables exclude-list) + (org-export-latex-tables + (plist-get org-export-latex-options-plist :tables))) + (unless (memq 'fixed-width exclude-list) + (org-export-latex-fixed-width + (plist-get org-export-latex-options-plist :fixed-width))) ;; return string - (buffer-substring (point-min) (point-max)))) + (buffer-substring (point-min) (point-max)))) (defun org-export-latex-protect-string (s) "Add the org-protected property to string S." From cad24d757d50ec83b81cd5c528c532d7922119a4 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 15 Dec 2010 14:01:05 +0100 Subject: [PATCH 026/107] org-list: add checkbox to list structures * lisp/org-list.el (org-list-struct-assoc-at-point): add checkbox to list structure * lisp/org-list.el (org-list-struct-assoc-at-point): add checkbox as value in structure * lisp/org-list.el (org-list-struct-apply-struct): also apply checkboxes --- lisp/org-list.el | 61 +++++++++++++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 24 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 0c519fcde..c698d92f4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1145,7 +1145,9 @@ bullet string and bullet counter, if any." (progn (goto-char (match-end 0)) (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]") - (match-string 1)))))) + (match-string-no-properties 1))) + (when (org-at-item-checkbox-p) + (match-string-no-properties 1))))) (defun org-list-struct (begin end top bottom &optional outdent) "Return the structure containing the list between BEGIN and END. @@ -1424,15 +1426,18 @@ BOTTOM is position at list ending. Initial position is restored after the changes." (let* ((pos (copy-marker (point))) (ancestor (caar struct)) + (full-item-re (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" + "\\(\\[@\\(?:start:\\)[0-9]+\\]\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?")) (modify (lambda (item) (goto-char (car item)) + (looking-at full-item-re) (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))) + (new-box (nth 4 item)) + (old-bul (match-string 1)) + (old-ind (save-match-data (org-get-indentation))) (old-body-ind (+ (length old-bul) old-ind)) (new-body-ind (+ (length new-bul) new-ind))) ;; 1. Shift item's body @@ -1440,16 +1445,23 @@ Initial position is restored after the changes." (org-shift-item-indentation (- new-body-ind old-body-ind) bottom)) ;; 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 (equal (match-string 1) new-bul) + (replace-match new-bul nil nil nil 1)) + ;; 3. Replace checkbox + (cond + ((equal (match-string 3) new-box)) + ((and (match-string 3) new-box) + (replace-match new-box nil nil nil 3)) + ((match-string 3) + (goto-char (or (match-end 2) (match-end 1))) + (looking-at "\\[[ X-]\\][ \t]+") + (replace-match "")) + (t (goto-char (or (match-end 2) (match-end 1))) + (insert (concat new-box " ")))) + ;; 4. Indent item to appropriate column (unless (= new-ind old-ind) - (delete-region (point-at-bol) - (progn - (skip-chars-forward " \t") - (point))) + (delete-region (goto-char (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)) @@ -1478,16 +1490,17 @@ 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 bottom))) - (beginning-of-line (unless (eolp) 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)) - (org-indent-line-to (+ i delta))))) - (beginning-of-line 0))))) + (save-match-data + (let ((beg (point-at-bol)) + (end (org-end-of-item-or-at-child bottom))) + (beginning-of-line (unless (eolp) 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)) + (org-indent-line-to (+ i delta))))) + (beginning-of-line 0)))))) (defun org-outdent-item () "Outdent a local list item, but not its children. From 7e57111524884effcde424446c22ef58dfb2de6b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 19 Dec 2010 22:03:05 +0100 Subject: [PATCH 027/107] org-list: implement new accessors to list structures * lisp/org-list.el (org-list-get-all-items): new function (org-list-get-all-children): new function (org-list-get-nth): new function (org-list-set-nth): new function (org-list-get-ind): new function (org-list-set-ind): new function (org-list-get-bullet): new function (org-list-set-bullet): new function (org-list-get-checkbox): new function (org-list-set-checkbox): new function (org-list-struct-fix-bul): use new accessors (org-list-repair): use new accessors (org-list-indent-item-generic): make use of accessors (org-list-get-parent): renamed from org-list-struct-get-parent (org-list-get-child): renamed from org-list-struct-get-child (org-list-struct-fix-ind): make use of accessors (org-list-get-next-item): new function (org-list-get-subtree): new function --- lisp/org-list.el | 134 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 100 insertions(+), 34 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c698d92f4..3d0514c90 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -64,6 +64,8 @@ (declare-function outline-previous-heading "outline" ()) (declare-function org-icompleting-read "org" (&rest args)) (declare-function org-time-string-to-seconds "org" (s)) +(declare-function org-sublist "org" (list start end)) +(declare-function org-remove-if-not "org" (predicate seq)) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." @@ -738,37 +740,35 @@ Return t if successful." (end (marker-position org-last-indent-end-marker)) (struct (org-list-struct beg end top (if specialp end bottom) (< arg 0))) - (origins (org-list-struct-origins struct)) - (beg-item (assq beg struct))) + (origins (org-list-struct-origins 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))) + (top-ind (org-list-get-ind beg struct))) (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 "-")))) + (string-match "*" (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct (org-list-bullet-string "-"))) ;; Shift ancestor - (let ((anc (car struct))) - (setcdr anc (list (+ (nth 1 anc) offset) "" nil))) + (let ((anc (caar struct))) + (org-list-set-ind anc struct (+ (org-list-get-ind anc struct) + offset))) (org-list-struct-fix-struct struct origins) (org-list-struct-apply-struct struct end)))) ;; Forbidden move ((and (< arg 0) (or (and no-subtree (not regionp) - (org-list-struct-get-child beg-item struct)) + (org-list-get-child beg origins)) (let ((last-item (save-excursion (goto-char end) (skip-chars-backward " \r\t\n") - (goto-char (org-get-item-beginning)) - (org-list-struct-assoc-at-point)))) - (org-list-struct-get-child last-item struct)))) + (org-get-item-beginning)))) + (org-list-get-child last-item origins)))) (error "Cannot outdent an item without its children")) ;; Normal shifting (t @@ -1244,17 +1244,82 @@ STRUCT is the list's structure looked up." (t (cons item-pos (cdar acc)))))))) (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. +(defun org-list-get-parent (item origins) + "Return parent of ITEM 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)))) + (let* ((parent (cdr (assq item origins)))) + (and (> parent 0) parent))) -(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-get-child (item origins) + "Return child of ITEM or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (car (rassq item origins))) + +(defun org-list-get-next-item (item origins) + "Return next item at same level of ITEM or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (unless (zerop item) + (let ((parent (cdr (assq item origins)))) + (car (rassq parent (cdr (member (assq item origins) origins))))))) + +(defun org-list-get-subtree (item origins) + "Return all items with ITEM as a common ancestor or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (let ((next (org-list-get-next-item item origins))) + (if next + (let ((len (length origins)) + (orig-car (mapcar 'car origins))) + (cdr (org-sublist orig-car + (- len (1- (length (memq item orig-car)))) + (- len (length (memq next orig-car)))))) + (mapcar 'car (cdr (member (assq item origins) origins)))))) + +(defun org-list-get-all-items (item origins) + "List of items in the same sub-list as ITEM. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (let ((anc (cdr (assq item origins)))) + (mapcar 'car (org-remove-if-not (lambda (e) (= (cdr e) anc)) origins)))) + +(defun org-list-get-all-children (item origins) + "List all children of ITEM, or nil. +ORIGINS is the alist of parents. See `org-list-struct-origins'." + (mapcar 'car (org-remove-if-not (lambda (e) (= (cdr e) item)) origins))) + +(defun org-list-get-nth (n key struct) + "Return the Nth value of KEY in STRUCT." + (nth n (assq key struct))) + +(defun org-list-set-nth (n key struct new) + "Set the Nth value of KEY in STRUCT to NEW. +\nThis function modifies STRUCT." + (setcar (nthcdr n (assq key struct)) new)) + +(defun org-list-get-ind (item struct) + "Return indentation of ITEM in STRUCT." + (org-list-get-nth 1 item struct)) + +(defun org-list-set-ind (item struct ind) + "Set indentation of ITEM in STRUCT to IND. +\nThis function modifies STRUCT." + (org-list-set-nth 1 item struct ind)) + +(defun org-list-get-bullet (item struct) + "Return bullet of ITEM in STRUCT." + (org-list-get-nth 2 item struct)) + +(defun org-list-set-bullet (item struct bullet) + "Set bullet of ITEM in STRUCT to BULLET. +\nThis function modifies STRUCT." + (org-list-set-nth 2 item struct bullet)) + +(defun org-list-get-checkbox (item struct) + "Return checkbox of ITEM in STRUCT or nil." + (org-list-get-nth 4 item struct)) + +(defun org-list-set-checkbox (item struct checkbox) + "Set checkbox of ITEM in STRUCT to CHECKBOX. +\nThis function modifies STRUCT." + (org-list-set-nth 4 item struct checkbox)) (defun org-list-struct-fix-bul (struct origins) "Verify and correct bullets for every association in STRUCT. @@ -1287,10 +1352,10 @@ This function modifies STRUCT." (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)) + (org-list-set-bullet (car item) struct new-bul)) ;; A new list is starting (let ((new-bul (funcall init-bul item))) - (funcall set-bul item new-bul) + (org-list-set-bullet (car item) struct new-bul) (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))) @@ -1301,19 +1366,21 @@ This function modifies STRUCT." ORIGINS is the alist of parents. See `org-list-struct-origins'. This function modifies STRUCT." - (let* ((headless (cdr struct)) - (ancestor (car struct)) - (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor)))) + (let* ((ancestor (caar struct)) + (top-ind (+ (org-list-get-ind ancestor struct) + (length (org-list-get-bullet ancestor struct)))) (new-ind (lambda (item) - (let* ((parent (org-list-struct-get-parent item headless origins))) + (let ((parent (org-list-get-parent item origins))) (if parent ;; Indent like parent + length of parent's bullet - (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) - (cddr item))) + (org-list-set-ind item + struct + (+ (length (org-list-get-bullet parent struct)) + (org-list-get-ind parent struct))) ;; If no parent, indent like top-point - (setcdr item (cons top-ind (cddr item)))))))) - (mapc new-ind headless))) + (org-list-set-ind item struct top-ind)))))) + (mapc new-ind (mapcar 'car (cdr struct))))) (defun org-list-struct-fix-struct (struct origins) "Return STRUCT with correct bullets and indentation. @@ -1629,9 +1696,8 @@ Item's body is not indented, only shifted with the bullet." fixed-struct) (if (stringp force-bullet) (let ((begin (nth 1 struct))) - (setcdr begin (list (nth 1 begin) - (org-list-bullet-string force-bullet) - (nth 3 begin))) + (org-list-set-bullet (car begin) struct + (org-list-bullet-string force-bullet)) (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins)))) (setq fixed-struct (org-list-struct-fix-struct struct origins))) From 8a3a81c08eec031d8636737024d652a4178cf317 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 19 Dec 2010 22:04:12 +0100 Subject: [PATCH 028/107] org-list: fix checkboxes directly from list structures * lisp/org-list.el (org-list-struct-fix-checkboxes): new function (org-checkbox-blocked-p): removed function --- lisp/org-list.el | 93 ++++++++++++++++++++++++++++++++++-------------- 1 file changed, 66 insertions(+), 27 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 3d0514c90..6a2f3acae 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -834,28 +834,6 @@ TOP is the position of list's top-item." "Is point at a line starting a plain-list item with a checklet?" (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) -(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 1) "[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)) - (when (org-search-forward-unenclosed - "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t) - (org-current-line))))))) - ;;; Navigate ;; Every interactive navigation function is derived from a @@ -1336,15 +1314,13 @@ This function modifies STRUCT." ((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 + (lambda (item) (let* ((parent (cdr (assq (car item) origins))) (orig-ref (assq parent acc))) (if orig-ref @@ -1382,11 +1358,70 @@ This function modifies STRUCT." (org-list-set-ind item struct top-ind)))))) (mapc new-ind (mapcar 'car (cdr struct))))) +(defun org-list-struct-fix-checkboxes (struct origins &optional ordered) + "Verify and correct checkboxes for every association in STRUCT. +ORIGINS is the alist of parents. See `org-list-struct-origins'. + +If ORDERED is non-nil, a checkbox can only be checked when every +checkbox before it is checked too. If there was an attempt to +break this rule, the function will return the blocking item. In +all others cases, the return value will be `nil'. + +To act reliably, this function requires the full structure of the +list, and not a part of it. It will modify STRUCT." + (let ((struct (cdr struct)) + (set-parent-box + (function + (lambda (item) + (let* ((box-list (mapcar (lambda (child) + (org-list-get-checkbox child struct)) + (org-list-get-all-children item origins)))) + (org-list-set-checkbox + item struct + (cond + ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]") + ((member "[-]" box-list) "[-]") + ((member "[X]" box-list) "[X]") + ((member "[ ]" box-list) "[ ]") + ;; parent has no boxed child: leave box as-is + (t (org-list-get-checkbox item struct)))))))) + parent-list) + ;; Start: get all parents with a checkbox + (mapc + (lambda (elt) + (let* ((parent (cdr elt)) + (parent-box-p (org-list-get-checkbox parent struct))) + (when (and parent-box-p (not (memq parent parent-list))) + (setq parent-list (cons parent parent-list))))) + origins) + ;; sort those parents by decreasing indentation + (setq parent-list (sort parent-list + (lambda (e1 e2) + (> (org-list-get-ind e1 struct) + (org-list-get-ind e2 struct))))) + ;; for each parent, get all children's checkboxes to determine and + ;; set its checkbox accordingly + (mapc set-parent-box parent-list) + ;; if ORDERED is set, see if we need to uncheck some boxes + (when ordered + (let* ((all-items (mapcar 'car struct)) + (box-list + (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items)) + (after-unchecked (member "[ ]" box-list))) + ;; there are boxes checked after an unchecked one: fix that + (when (member "[X]" after-unchecked) + (let ((index (- (length struct) (length after-unchecked)))) + (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]")) + (nthcdr index all-items)) + ;; Verify once again the structure, without ORDERED + (org-list-struct-fix-checkboxes struct origins nil) + ;; return blocking item + (nth index all-items))))))) + (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." +\nOnly elements of STRUCT that have changed are returned." (let ((old (copy-alist struct))) (org-list-struct-fix-bul struct origins) (org-list-struct-fix-ind struct origins) @@ -1516,6 +1551,10 @@ Initial position is restored after the changes." (replace-match new-bul nil nil nil 1)) ;; 3. Replace checkbox (cond + ((and new-box + (save-match-data (org-at-item-description-p)) + (cdr (assq 'checkbox org-list-automatic-rules))) + (message "Cannot add a checkbox to a description list item")) ((equal (match-string 3) new-box)) ((and (match-string 3) new-box) (replace-match new-box nil nil nil 3)) From 1829aa79b51c462032a270431217e98e63c37ecc Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 17 Dec 2010 19:54:25 +0100 Subject: [PATCH 029/107] org-list: use list structure to update checkboxes and cookies * lisp/org-list.el (org-toggle-checkbox): use structures to fix checkboxes of a list (org-update-checkbox-count): use structures to update cookies --- lisp/org-list.el | 364 +++++++++++++++++++++++++---------------------- 1 file changed, 191 insertions(+), 173 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6a2f3acae..5cb494d16 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1798,77 +1798,91 @@ 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, 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 - ;; toggles on single items will return errors. - (let* ((bounds - (cond - ((org-region-active-p) - (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 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) (1+ (point-at-eol)) t)) - (t (error "Not at an item or heading, and no active region")))) - (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 beg) - (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 - (goto-char beg) - (while (< (point) end) - (funcall act-on-item ref-presence ref-status) - (org-search-forward-unenclosed org-item-beginning-re end 'move))) + (save-excursion + (let* (singlep + block-item + lim-up + lim-down + (orderedp (ignore-errors (org-entry-get nil "ORDERED"))) + (bounds + ;; In a region, start at first item in region + (cond + ((org-region-active-p) + (let ((limit (region-end))) + (goto-char (region-beginning)) + (if (org-search-forward-unenclosed org-item-beginning-re + limit t) + (setq lim-up (point-at-bol)) + (error "No item in region")) + (setq lim-down (copy-marker limit)))) + ((org-on-heading-p) + ;; On an heading, start at first item after drawers + (let ((limit (save-excursion (outline-next-heading) (point)))) + (forward-line 1) + (when (looking-at org-drawer-regexp) + (re-search-forward "^[ \t]*:END:" limit nil)) + (if (org-search-forward-unenclosed org-item-beginning-re + limit t) + (setq lim-up (point-at-bol)) + (error "No item in subtree")) + (setq lim-down (copy-marker limit)))) + ;; Just one item: set singlep flag + ((org-at-item-p) + (setq singlep t) + (setq lim-up (point-at-bol) + lim-down (point-at-eol))) + (t (error "Not at an item or heading, and no active region")))) + ;; determine the checkbox going to be applied to all items + ;; within bounds + (ref-checkbox + (progn + (goto-char lim-up) + (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) + (cond + ((equal toggle-presence '(16)) "[-]") + ((equal toggle-presence '(4)) + (unless cbox "[ ]")) + ((equal "[ ]" cbox) "[X]") + (t "[ ]")))))) + ;; When an item is found within bounds, grab the full list at + ;; point structure, then: 1. set checkbox of all its items + ;; within bounds to ref-checkbox; 2. fix checkboxes of the whole + ;; list; 3. move point after the list. + (goto-char lim-up) + (while (and (< (point) lim-down) + (org-search-forward-unenclosed + org-item-beginning-re lim-down 'move)) + (let* ((struct (org-list-struct)) + (struct-copy (mapcar (lambda (e) (copy-alist e)) struct)) + (parents (org-list-struct-parent-alist struct)) + (bottom (copy-marker (org-list-get-bottom-point struct))) + (items-to-toggle (org-remove-if + (lambda (e) (or (< e lim-up) (> e lim-down))) + (mapcar 'car (cdr struct))))) + (mapc (lambda (e) (org-list-set-checkbox + e struct + ;; if there is no box at item, leave as-is + ;; unless function was called with C-u prefix + (let ((cur-box (org-list-get-checkbox e struct))) + (if (or cur-box (equal toggle-presence '(4))) + ref-checkbox + cur-box)))) + items-to-toggle) + (setq block-item (org-list-struct-fix-box struct parents orderedp)) + ;; Report some problems due to ORDERED status of subtree. If + ;; only one box was being checked, throw an error, else, + ;; only signal problems. + (cond + ((and singlep block-item (> lim-up block-item)) + (error + "Checkbox blocked because of unchecked box at line %d" + (org-current-line block-item))) + (block-item + (message + "Checkboxes were removed due to unchecked box at line %d" + (org-current-line block-item)))) + (goto-char bottom) + (org-list-struct-apply-struct struct struct-copy)))) (org-update-checkbox-count-maybe))) (defun org-reset-checkbox-state-subtree () @@ -1901,110 +1915,114 @@ information.") (defun org-update-checkbox-count (&optional all) "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." +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 ((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 "\\" - (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 "\\" - (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))))) + (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (box-re "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + (recursivep + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\" + (or (ignore-errors + (org-entry-get nil "COOKIE_DATA")) + "")))) + (bounds (if all + (cons (point-min) (point-max)) + (cons (or (ignore-errors (org-back-to-heading) (point)) + (point-min)) + (save-excursion (outline-next-heading) (point))))) + (count-boxes + (function + ;; add checked boxes and boxes of all types in all + ;; structures in STRUCTS to c-on and c-all, respectively. + ;; This looks at RECURSIVEP value. If ITEM is nil, count + ;; across the whole structure, else count only across + ;; subtree whose ancestor is ITEM. + (lambda (item structs) + (mapc + (lambda (s) + (let* ((pre (org-list-struct-prev-alist s)) + (items + (if recursivep + (or (and item (org-list-get-subtree item s pre)) + (mapcar 'car s)) + (or (and item (org-list-get-all-children item s pre)) + (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (setq c-all (+ (length cookies) c-all) + c-on (+ (org-count "[X]" cookies) c-on)))) + structs)))) + cookies-list backup-end structs-backup) + (goto-char (car bounds)) + ;; 1. Build an alist for each cookie found within BOUNDS. The + ;; key will be position at beginning of cookie and values + ;; ending position, format of cookie, number of checked boxes + ;; to report, and total number of boxes. + (while (re-search-forward cookie-re (cdr bounds) t) + (save-excursion + (let ((c-on 0) (c-all 0)) + (save-match-data + ;; There are two types of cookies: those at headings and those + ;; at list items. + (cond + ((and (org-on-heading-p) + (string-match "\\" + (downcase + (or (org-entry-get nil "COOKIE_DATA") ""))))) + ;; This cookie is at an heading, but specifically for + ;; todo, not for checkboxes: skip it. + ((org-on-heading-p) + (setq backup-end (save-excursion + (outline-next-heading) (point))) + ;; This cookie is at an heading. Grab structure of + ;; every list containing a checkbox between point and + ;; next headline, and save them in STRUCTS-BACKUP + (while (org-search-forward-unenclosed box-re backup-end 'move) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (setq structs-backup (cons struct structs-backup)) + (goto-char bottom))) + (funcall count-boxes nil structs-backup)) + ((org-at-item-p) + ;; This cookie is at an item. Look in STRUCTS-BACKUP + ;; to see if we have the structure of list at point in + ;; it. Else compute the structure. + (let ((item (point-at-bol))) + (if (and backup-end (< item backup-end)) + (funcall count-boxes item structs-backup) + (setq end-entry bottom + structs-backup (list (org-list-struct))) + (funcall count-boxes item structs-backup)))))) + ;; Build the cookies list, with appropriate information + (setq cookies-list (cons (list (match-beginning 1) ; cookie start + (match-end 1) ; cookie end + (match-beginning 2) ; percent? + c-on ; checked boxes + c-all) ; total boxes + cookies-list))))) + ;; 2. Apply alist to buffer, in reverse order so positions stay + ;; unchanged after cookie modifications. + (mapc (lambda (cookie) + (let* ((beg (car cookie)) + (end (nth 1 cookie)) + (percentp (nth 2 cookie)) + (checked (nth 3 cookie)) + (total (nth 4 cookie)) + (new (if percentp + (format "[%d%%]" (/ (* 100 checked) + (max 1 total))) + (format "[%d/%d]" checked total)))) + (goto-char beg) + (insert new) + (delete-region (point) (+ (point) (- end beg))))) + cookies-list)))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. From d48a6cf50dad3a61bf75ae28582a1aa3ec28e1ae Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 23 Dec 2010 18:54:24 +0100 Subject: [PATCH 030/107] org-list: new way to get structure of a list and new accessors * lisp/org-list.el (org-list-blocks): new variable (org-list-context): new function (org-list-full-item-re): new variable (org-list-struct-assoc-at-point): use new varible (org-list-struct): rewrite of function. Now, list data is collected by looking at the list line after line. It reads the whole list each time because reading only a subtree was not enough for some operations, like fixing checkboxes. It also removes the need to get `org-list-top-point' and `org-list-bottom-point' first. An added data is the position of item ending. This aims to be able to have list followed by text inside an item. (org-list-struct-assoc-end): new function (org-list-struct-parent-alist): new function (org-list-get-parent): new function (org-list-get-child): new function (org-list-get-next-item): new function (org-list-get-prev-item): new function (org-list-get-subtree): use helper function `org-list-struct-prev-alist'. (org-list-get-all-items): new function (org-list-get-all-children): new function (org-list-get-top-point): new function (org-list-get-bottom-point): new function (org-list-get-counter): new function (org-list-get-item-end): new function (org-list-struct-fix-bul): rewrite for cleaner code. Make use of new accessors. (org-list-struct-fix-ind): make use of new accessors. (org-list-struct-fix-box): new function (org-list-struct-fix-checkboxes): removed function (org-list-struct-outdent): use new accessors. Use the fact that there is no longer a virtual item at beginning of structure. (org-list-struct-indent): use helper functions `org-list-struct-prev-alist' and `org-list-struct-parent-alist'. Also use new accessors. (org-list-struct-fix-struct): comment function. Call directly `org-list-struct-apply-struct', without removing unchanged items first. (org-list-struct-apply-struct): comment function. Rewrite using new accessors. Use new variable `org-list-full-item-re'. (org-list-shift-item-indentation): removed function, now included in `org-list-struct-apply-struct' because it is too specific. Conflicts: lisp/org-list.el org-list: new way to get structure of a list and new accessors * lisp/org-list.el (org-list-blocks): new variable (org-list-context): new function (org-list-full-item-re): new variable (org-list-struct-assoc-at-point): use new varible (org-list-struct): rewrite of function. Now, list data is collected by looking at the list line after line. It reads the whole list each time because reading only a subtree was not enough for some operations, like fixing checkboxes. It also removes the need to get `org-list-top-point' and `org-list-bottom-point' first. An added data is the position of item ending. This aims to be able to have list followed by text inside an item. (org-list-struct-assoc-end): new function (org-list-struct-parent-alist): new function (org-list-get-parent): new function (org-list-get-child): new function (org-list-get-next-item): new function (org-list-get-prev-item): new function (org-list-get-subtree): use helper function `org-list-struct-prev-alist'. (org-list-get-all-items): new function (org-list-get-all-children): new function (org-list-get-counter): new function (org-list-get-item-end): new function (org-list-struct-fix-bul): rewrite for cleaner code. Make use of new accessors. (org-list-struct-fix-ind): make use of new accessors. (org-list-struct-fix-box): new function (org-list-struct-fix-checkboxes): removed function (org-list-struct-outdent): use new accessors. Use the fact that there is no longer a virtual item at beginning of structure. (org-list-struct-indent): use helper functions `org-list-struct-prev-alist' and `org-list-struct-parent-alist'. Also use new accessors. (org-list-struct-fix-struct): comment function. Call directly `org-list-struct-apply-struct', without removing unchanged items first. (org-list-struct-apply-struct): comment function. Rewrite using new accessors. Use new variable `org-list-full-item-re'. (org-list-shift-item-indentation): removed function, now included in `org-list-struct-apply-struct' because it is too specific. Conflicts: lisp/org-list.el --- lisp/org-list.el | 991 ++++++++++++++++++++++++++++++++--------------- 1 file changed, 670 insertions(+), 321 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 5cb494d16..e99974362 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -66,6 +66,9 @@ (declare-function org-time-string-to-seconds "org" (s)) (declare-function org-sublist "org" (list start end)) (declare-function org-remove-if-not "org" (predicate seq)) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." @@ -277,6 +280,9 @@ list, obtained by prompting the user." ;;; Internal functions +(defconst org-list-blocks '("EXAMPLE" "VERSE" "SRC") + "Names of blocks where lists are not allowed.") + (defun org-list-end-re () "Return the regex corresponding to the end of a list. It depends on `org-empty-line-terminates-plain-lists'." @@ -300,6 +306,118 @@ 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.") +(defconst org-list-full-item-re + (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?") + "Matches a list item and puts everything into groups: +group 1: the bullet +group 2: the counter +group 3: the checkbox") + +(defun org-list-context () + "Determine context, and its boundaries, around point. + +Context is determined by reading `org-context' text property if +applicable, or looking at Org syntax around. + +Context will be an alist like (MIN MAX CONTEXT) where MIN and MAX +are boundaries and CONTEXT is a symbol among `nil', `drawer', +`block', `invalid' and `inlinetask'. + +Symbols `block' and `invalid' refer to `org-list-blocks'." + (save-match-data + (let* ((origin (point)) + (context-prop (get-text-property origin 'org-context))) + (if context-prop + (list + (or (previous-single-property-change + (min (1+ (point)) (point-max)) 'org-context) (point-min)) + (or (next-single-property-change origin 'org-context) (point-max)) + (cond + ((equal (downcase context-prop) "inlinetask") 'inlinetask) + ((member (upcase context-prop) org-list-blocks) 'invalid) + (t 'block))) + (save-excursion + (beginning-of-line) + (let* ((outline-regexp (org-get-limited-outline-regexp)) + ;; can't use org-drawers-regexp as this function might be + ;; called in buffers not in Org mode + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (case-fold-search t) + ;; compute position of surrounding headings. this is the + ;; default context. + (heading + (save-excursion + (list + (or (and (org-at-heading-p) (point-at-bol)) + (outline-previous-heading) + (point-min)) + (or (outline-next-heading) + (point-max)) + nil))) + (prev-head (car heading)) + (next-head (nth 1 heading)) + ;; Are we strictly inside a drawer? + (drawerp + (when (and (org-in-regexps-block-p + drawers-re "^[ \t]*:END:" prev-head) + (save-excursion + (beginning-of-line) + (and (not (looking-at drawers-re)) + (not (looking-at "^[ \t]*:END:"))))) + (save-excursion + (list + (progn + (re-search-backward drawers-re prev-head t) + (1+ (point-at-eol))) + (if (re-search-forward "^[ \t]*:END:" next-head t) + (1- (point-at-bol)) + next-head) + 'drawer)))) + ;; Are we strictly in a block, and of which type? + (blockp + (save-excursion + (when (and (org-in-regexps-block-p + "^[ \t]*#\\+begin_" "^[ \t]*#\\+end_" prev-head) + (save-excursion + (beginning-of-line) + (not (looking-at + "^[ \t]*#\\+\\(begin\\|end\\)_")))) + (list + (progn + (re-search-backward + "^[ \t]*#\\+begin_\\(\\S-+\\)" prev-head t) + (1+ (point-at-eol))) + (save-match-data + (if (re-search-forward "^[ \t]*#\\+end_" next-head t) + (1- (point-at-bol)) + next-head)) + (if (member (upcase (match-string 1)) org-list-blocks) + 'invalid + 'block))))) + ;; Are we in an inlinetask? + (inlinetaskp + (when (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (not (looking-at "^\\*+"))) + (save-excursion + (list + (progn (org-inlinetask-goto-beginning) + (1+ (point-at-eol))) + (progn + (org-inlinetask-goto-end) + (forward-line -1) + (1- (point-at-bol))) + 'inlinetask)))) + ;; list actual candidates + (context-list + (delq nil (list heading drawerp blockp inlinetaskp)))) + ;; Return the closest context around + (assq (apply 'max (mapcar 'car context-list)) context-list))))))) + (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. @@ -1109,159 +1227,337 @@ item is invisible." ;; 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. -It is a cons-cell whose key is point and values are indentation, -bullet string and bullet counter, if any." +(defun org-list-struct () + "Return structure of list at point. + +A list structure is an alist where keys is point at item, and +values are: +1. indentation, +2. bullet with trailing whitespace, +3. bullet counter, if any, +4. checkbox, if any, +5. position at item end. + +Assume point is at an item." (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-no-properties 1))) - (when (org-at-item-checkbox-p) - (match-string-no-properties 1))))) - -(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 -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." - (save-excursion - (let* (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 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))) - ;; Find end of min list - (goto-char end) - (end-of-line) - (while (and (org-search-forward-unenclosed - org-item-beginning-re bottom 'move) - (>= (org-get-indentation) ind-min)) - (setq post-list (cons (org-list-struct-assoc-at-point) - post-list))) - ;; Is list is malformed? If some items are less - ;; indented that top-item, add them anyhow. - (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) - 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. -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) - (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))) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (lim-down (nth 1 context)) + (text-min-ind 10000) + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (beg-cell (cons (point) (org-get-indentation))) + ind itm-lst itm-lst-2 end-lst end-lst-2 struct + (assoc-at-point + ;; Return an association whose key is point and values are + ;; indentation, bullet string, bullet counter, and + ;; checkbox. + (function + (lambda (ind) + (looking-at org-list-full-item-re) + (list (point) + ind + (match-string-no-properties 1) ; bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3))))) ; checkbox + (end-before-blank + ;; Ensure list ends at the first blank line. + (function + (lambda () + (skip-chars-backward " \r\t\n") + (min (1+ (point-at-eol)) lim-down))))) + ;; 1. Read list from starting item to its beginning, and save + ;; top item position and indentation in BEG-CELL. Also store + ;; ending position of items in END-LST. + (save-excursion + (catch 'exit + (while t + (let ((ind (org-get-indentation))) (cond - ;; List closing. - ((> prev-ind ind) - (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))) - (setq acc (cons (cons ind origin) acc)) - (cons item-pos origin))) - ;; Current list going on - (t (cons item-pos (cdar acc)))))))) - (cons '(0 . 0) (mapcar get-origins (cdr struct))))) + ((<= (point) lim-up) + ;; At upward limit: if we ended at an item, store it, + ;; else dimiss useless data recorded above BEG-CELL. + ;; Jump to part 2. + (throw 'exit + (setq itm-lst + (if (not (org-at-item-p)) + (memq (assq (car beg-cell) itm-lst) itm-lst) + (setq beg-cell (cons (point) ind)) + (cons (funcall assoc-at-point ind) itm-lst))))) + ((and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + ;; Looking at a list ending regexp. Dismiss useless + ;; data recorded above BEG-CELL. Jump to part 2. + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) + ;; Skip blocks, drawers, inline tasks, blank lines + ;; along the way. + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" nil t)) + ((looking-at "^[ \t]*:END:") + (re-search-backward drawers-re nil t) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") + (forward-line -1)) + ((org-at-item-p) + ;; Point is at an item. Add data to ITM-LST. It may + ;; also end a previous item: save it in END-LST. If + ;; ind is less or equal than BEG-CELL and there is no + ;; end at this ind or lesser, this item becomes the + ;; new BEG-CELL. + (setq itm-lst (cons (funcall assoc-at-point ind) itm-lst) + end-lst (cons (cons ind (point-at-bol)) end-lst)) + (when (or (and (eq org-list-ending-method 'regexp) + (<= ind (cdr beg-cell))) + (< ind text-min-ind)) + (setq beg-cell (cons (point-at-bol) ind))) + (forward-line -1)) + (t + ;; Point is not at an item. Unless ending method is + ;; `regexp', interpret line's indentation: + ;; + ;; - text at column 0 is necessarily out of any list. + ;; Dismiss data recorded above BEG-CELL. Jump to + ;; part 2. + ;; + ;; - any other case, it can possibly be an ending + ;; position for an item above. Save it and proceed. + (cond + ((eq org-list-ending-method 'regexp)) + ((= ind 0) + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) + (t + (when (< ind text-min-ind) (setq text-min-ind ind)) + (setq end-lst (cons (cons ind (point-at-bol)) end-lst)))) + (forward-line -1))))))) + ;; 2. Read list from starting point to its end, that is until we + ;; get out of context, or a non-item line is less or equally + ;; indented that BEG-CELL's cdr. Also store ending position + ;; of items in END-LST-2. + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((>= (point) lim-down) + ;; At downward limit: this is de facto the end of the + ;; list. Save point as an ending position, and jump to + ;; part 3. + (throw 'exit + (setq end-lst-2 + (cons + (cons 0 (funcall end-before-blank)) end-lst-2)))) + ((and (not (eq org-list-ending-method 'regexp)) + (looking-at (org-list-end-re))) + ;; Looking at a list ending regexp. Save point as an + ;; ending position and jump to part 3. + (throw 'exit + (setq end-lst-2 + (cons (cons ind (point-at-bol)) end-lst-2)))) + ;; Skip blocks, drawers, inline tasks and blank lines + ;; along the way + ((looking-at "^[ \t]*#\\+begin_") + (re-search-forward "^[ \t]*#\\+end_") + (forward-line 1)) + ((looking-at drawers-re) + (re-search-forward "^[ \t]*:END:" nil t) + (forward-line 1)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-end) + (forward-line 1)) + ((looking-at "^[ \t]*$") + (forward-line 1)) + ((org-at-item-p) + ;; Point is at an item. Add data to ITM-LST-2. It may also + ;; end a previous item, so save it in END-LST-2. + (setq itm-lst-2 (cons (funcall assoc-at-point ind) itm-lst-2) + end-lst-2 (cons (cons ind (point-at-bol)) end-lst-2)) + (forward-line 1)) + (t + ;; Point is not at an item. If ending method is not + ;; `regexp', two situations are of interest: + ;; + ;; - ind is lesser or equal than BEG-CELL's. The list is + ;; over. Store point as an ending position and jump to + ;; part 3. + ;; + ;; - ind is lesser or equal than previous item's. This + ;; is an ending position. Store it and proceed. + (cond + ((eq org-list-ending-method 'regexp)) + ((<= ind (cdr beg-cell)) + (setq end-lst-2 + (cons (cons ind (funcall end-before-blank)) end-lst-2)) + (throw 'exit nil)) + ((<= ind (nth 1 (car itm-lst-2))) + (setq end-lst-2 (cons (cons ind (point-at-bol)) end-lst-2)))) + (forward-line 1)))))) + (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))) + (setq end-lst (append end-lst (cdr (nreverse end-lst-2)))) + ;; 3. Correct ill-formed lists by making sure top item has the + ;; least indentation of the list + (let ((min-ind (nth 1 (car struct)))) + (mapc (lambda (item) + (let ((ind (nth 1 item))) + (when (< ind min-ind) (setcar (cdr item) min-ind)))) + struct)) + ;; 4. Associate each item to its end pos. + (org-list-struct-assoc-end struct end-lst) + ;; 5. Return STRUCT + struct))) -(defun org-list-get-parent (item origins) - "Return parent of ITEM or nil. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (let* ((parent (cdr (assq item origins)))) - (and (> parent 0) parent))) +(defun org-list-struct-assoc-end (struct end-list) + "Associate proper ending point to items in STRUCT. -(defun org-list-get-child (item origins) - "Return child of ITEM or nil. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (car (rassq item origins))) +END-LIST is a pseudo-alist where car is indentation and cdr is +ending position. -(defun org-list-get-next-item (item origins) - "Return next item at same level of ITEM or nil. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (unless (zerop item) - (let ((parent (cdr (assq item origins)))) - (car (rassq parent (cdr (member (assq item origins) origins))))))) +This function modifies STRUCT." + (let ((endings end-list)) + (mapc + (lambda (elt) + (let ((pos (car elt)) + (ind (nth 1 elt))) + ;; remove end candidates behind current item + (while (or (<= (cdar endings) pos)) + (pop endings)) + ;; add end position to item assoc + (let ((old-end (nthcdr 5 elt)) + (new-end (assoc-default ind endings '<=))) + (if old-end + (setcar old-end new-end) + (setcdr elt (append (cdr elt) (list new-end))))))) + struct))) -(defun org-list-get-subtree (item origins) +(defun org-list-struct-prev-alist (struct) + "Return alist between item and previous item in STRUCT." + (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 5 e))) + struct))) + (mapcar (lambda (e) + (let ((prev (car (rassq (car e) item-end-alist)))) + (cons (car e) prev))) + struct))) + +(defun org-list-struct-parent-alist (struct) + "Return alist between item and parent in STRUCT." + (let ((ind-to-ori (list (list (nth 1 (car struct))))) + (prev-pos (list (caar struct)))) + (cons prev-pos + (mapcar (lambda (item) + (let ((pos (car item)) + (ind (nth 1 item)) + (prev-ind (caar ind-to-ori))) + (setq prev-pos (cons pos prev-pos)) + (cond + ((> prev-ind ind) + (setq ind-to-ori + (member (assq ind ind-to-ori) ind-to-ori)) + (cons pos (cdar ind-to-ori))) + ((< prev-ind ind) + (let ((origin (nth 1 prev-pos))) + (setq ind-to-ori (cons (cons ind origin) ind-to-ori)) + (cons pos origin))) + (t (cons pos (cdar ind-to-ori)))))) + (cdr struct))))) + +(defun org-list-get-parent (item struct &optional parents) + "Return parent of ITEM in STRUCT, or nil. +PARENTS, when provided, is the alist of items' parent. See +`org-list-struct-parent-alist'." + (let ((parents (or parents (org-list-struct-parent-alist struct)))) + (cdr (assq item parents)))) + +(defun org-list-get-child (item struct) + "Return child of ITEM in STRUCT, or nil." + (let ((ind (org-list-get-ind item struct)) + (child-maybe (car (nth 1 (member (assq item struct) struct))))) + (when (< ind (org-list-get-ind child-maybe struct)) child-maybe))) + +(defun org-list-get-next-item (item struct prevs) + "Return next item in same sub-list as ITEM in STRUCT, or nil. +PREVS is the alist of previous items. See +`org-list-struct-prev-alist'." + (car (rassq item prevs))) + +(defun org-list-get-prev-item (item struct prevs) + "Return previous item in same sub-list as ITEM in STRUCT, or nil. +PREVS is the alist of previous items. See +`org-list-struct-prev-alist'." + (cdr (assq item prevs))) + +(defun org-list-get-subtree (item struct) "Return all items with ITEM as a common ancestor or nil. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (let ((next (org-list-get-next-item item origins))) - (if next - (let ((len (length origins)) - (orig-car (mapcar 'car origins))) - (cdr (org-sublist orig-car - (- len (1- (length (memq item orig-car)))) - (- len (length (memq next orig-car)))))) - (mapcar 'car (cdr (member (assq item origins) origins)))))) +PREVS is the alist of previous items. See +`org-list-struct-prev-alist'." + (let* ((item-end (org-list-get-item-end item struct)) + (sub-struct (cdr (member (assq item struct) struct))) + subtree) + (catch 'exit + (mapc (lambda (e) (let ((pos (car e))) + (if (< pos item-end) + (setq subtree (cons pos subtree)) + (throw 'exit nil)))) + sub-struct)) + (nreverse subtree))) -(defun org-list-get-all-items (item origins) - "List of items in the same sub-list as ITEM. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (let ((anc (cdr (assq item origins)))) - (mapcar 'car (org-remove-if-not (lambda (e) (= (cdr e) anc)) origins)))) +(defun org-list-get-all-items (item struct prevs) + "List of items in the same sub-list as ITEM in STRUCT. +PREVS, when provided, is the alist of previous items. See +`org-list-struct-prev-alist'." + (let ((prev-item item) + (next-item item) + before-item after-item) + (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) + (setq before-item (cons prev-item before-item))) + (while (setq next-item (org-list-get-next-item next-item struct prevs)) + (setq after-item (cons next-item after-item))) + (append before-item (list item) (nreverse after-item)))) -(defun org-list-get-all-children (item origins) - "List all children of ITEM, or nil. -ORIGINS is the alist of parents. See `org-list-struct-origins'." - (mapcar 'car (org-remove-if-not (lambda (e) (= (cdr e) item)) origins))) +(defun org-list-get-all-children (item struct prevs) + "List all children of ITEM in STRUCT, or nil. +PREVS is the alist of previous items. See +`org-list-struct-prev-alist'." + (let ((child (org-list-get-child item struct))) + (and child (org-list-get-all-items child struct prevs)))) + +(defun org-list-get-top-point (struct) + "Return point at beginning of list. +STRUCT is the structure of the list." + (caar struct)) + +(defun org-list-get-bottom-point (struct) + "Return point at bottom of list. +STRUCT is the structure of the list." + (apply 'max + (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) + +(defun org-list-get-list-begin (item struct prevs) + "Return point at beginning of sub-list ITEM belongs. +STRUCT is the structure of the list. PREVS is the alist of +previous items. See `org-list-struct-prev-alist'." + (let ((prev-item item) first-item) + (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) + (setq first-item prev-item)) + first-item)) + +(defun org-list-get-list-end (item struct prevs) + "Return point at end of sub-list ITEM belongs. +STRUCT is the structure of the list. PREVS is the alist of +previous items. See `org-list-struct-prev-alist'." + (let ((next-item item) last-item) + (while (setq next-item (org-list-get-next-item next-item struct prevs)) + (setq last-item next-item)) + (org-list-get-item-end last-item struct))) (defun org-list-get-nth (n key struct) "Return the Nth value of KEY in STRUCT." @@ -1290,6 +1586,10 @@ ORIGINS is the alist of parents. See `org-list-struct-origins'." \nThis function modifies STRUCT." (org-list-set-nth 2 item struct bullet)) +(defun org-list-get-counter (item struct) + "Return counter of ITEM in STRUCT." + (org-list-get-nth 3 item struct)) + (defun org-list-get-checkbox (item struct) "Return checkbox of ITEM in STRUCT or nil." (org-list-get-nth 4 item struct)) @@ -1299,83 +1599,75 @@ ORIGINS is the alist of parents. See `org-list-struct-origins'." \nThis function modifies STRUCT." (org-list-set-nth 4 item struct checkbox)) -(defun org-list-struct-fix-bul (struct origins) +(defun org-list-get-item-end (item struct) + "Return end position of ITEM in STRUCT." + (org-list-get-nth 5 item struct)) + +(defun org-list-struct-fix-bul (struct prevs) "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) - (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))))) - (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 +\nThis function modifies STRUCT." + (let ((fix-bul + (function (lambda (item) - (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)) - (org-list-set-bullet (car item) struct new-bul)) - ;; A new list is starting - (let ((new-bul (funcall init-bul item))) - (org-list-set-bullet (car item) struct new-bul) - (setq acc (cons (cons parent - (org-list-inc-bullet-maybe new-bul)) - acc)))))))) - (mapc fix-bul (cdr struct)))) + (let* ((prev (org-list-get-prev-item item struct prevs)) + (prev-bul (and prev (org-list-get-bullet prev struct))) + (counter (org-list-get-counter item struct)) + (bullet (org-list-get-bullet item struct))) + (org-list-set-bullet + item struct + (org-list-bullet-string + (cond + ((and prev (string-match "[0-9]+" prev-bul) counter) + (replace-match counter nil nil prev-bul)) + (prev + (org-list-inc-bullet-maybe (org-list-get-bullet prev struct))) + ((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))))))))) + (mapc fix-bul (mapcar 'car struct)))) -(defun org-list-struct-fix-ind (struct origins) +(defun org-list-struct-fix-ind (struct parents &optional bullet-size) "Verify and correct indentation for every association in STRUCT. -ORIGINS is the alist of parents. See `org-list-struct-origins'. + +If numeric optional argument BULLET-SIZE is set, assume all +bullets in list have this length to determine new indentation. This function modifies STRUCT." - (let* ((ancestor (caar struct)) - (top-ind (+ (org-list-get-ind ancestor struct) - (length (org-list-get-bullet ancestor struct)))) + (let* ((ancestor (org-list-get-top-point struct)) + (top-ind (org-list-get-ind ancestor struct)) (new-ind (lambda (item) - (let ((parent (org-list-get-parent item origins))) + (let ((parent (org-list-get-parent item struct parents))) (if parent ;; Indent like parent + length of parent's bullet - (org-list-set-ind item - struct - (+ (length (org-list-get-bullet parent struct)) - (org-list-get-ind parent struct))) + (org-list-set-ind + item struct (+ (or bullet-size + (length + (org-list-get-bullet parent struct))) + (org-list-get-ind parent struct))) ;; If no parent, indent like top-point (org-list-set-ind item struct top-ind)))))) (mapc new-ind (mapcar 'car (cdr struct))))) -(defun org-list-struct-fix-checkboxes (struct origins &optional ordered) +(defun org-list-struct-fix-box (struct parents prevs &optional ordered) "Verify and correct checkboxes for every association in STRUCT. -ORIGINS is the alist of parents. See `org-list-struct-origins'. If ORDERED is non-nil, a checkbox can only be checked when every checkbox before it is checked too. If there was an attempt to break this rule, the function will return the blocking item. In all others cases, the return value will be `nil'. -To act reliably, this function requires the full structure of the -list, and not a part of it. It will modify STRUCT." - (let ((struct (cdr struct)) +This function modifies STRUCT." + (let ((all-items (mapcar 'car struct)) (set-parent-box (function (lambda (item) - (let* ((box-list (mapcar (lambda (child) - (org-list-get-checkbox child struct)) - (org-list-get-all-children item origins)))) + (let* ((box-list + (mapcar (lambda (child) + (org-list-get-checkbox child struct)) + (org-list-get-all-children item struct prevs)))) (org-list-set-checkbox item struct (cond @@ -1386,26 +1678,25 @@ list, and not a part of it. It will modify STRUCT." ;; parent has no boxed child: leave box as-is (t (org-list-get-checkbox item struct)))))))) parent-list) - ;; Start: get all parents with a checkbox + ;; 1. List all parents with a checkbox (mapc - (lambda (elt) - (let* ((parent (cdr elt)) + (lambda (e) + (let* ((parent (org-list-get-parent e struct parents)) (parent-box-p (org-list-get-checkbox parent struct))) (when (and parent-box-p (not (memq parent parent-list))) (setq parent-list (cons parent parent-list))))) - origins) - ;; sort those parents by decreasing indentation + all-items) + ;; 2. Sort those parents by decreasing indentation (setq parent-list (sort parent-list (lambda (e1 e2) (> (org-list-get-ind e1 struct) (org-list-get-ind e2 struct))))) - ;; for each parent, get all children's checkboxes to determine and - ;; set its checkbox accordingly + ;; 3. For each parent, get all children's checkboxes to determine + ;; and set its checkbox accordingly (mapc set-parent-box parent-list) - ;; if ORDERED is set, see if we need to uncheck some boxes + ;; 4. If ORDERED is set, see if we need to uncheck some boxes (when ordered - (let* ((all-items (mapcar 'car struct)) - (box-list + (let* ((box-list (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items)) (after-unchecked (member "[ ]" box-list))) ;; there are boxes checked after an unchecked one: fix that @@ -1414,27 +1705,61 @@ list, and not a part of it. It will modify STRUCT." (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]")) (nthcdr index all-items)) ;; Verify once again the structure, without ORDERED - (org-list-struct-fix-checkboxes struct origins nil) + (org-list-struct-fix-box struct prevs nil) ;; return blocking item (nth index all-items))))))) -(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'. -\nOnly elements of STRUCT that have changed are returned." - (let ((old (copy-alist struct))) - (org-list-struct-fix-bul struct origins) - (org-list-struct-fix-ind struct origins) - (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct)))) +(defun org-list-struct-fix-struct (struct parents) + "Return STRUCT with correct bullets and indentation." + ;; Order of functions matters here: checkboxes and endings need + ;; correct indentation to be set, and indentation needs correct + ;; bullets. + ;; + ;; 0. Save a copy of structure before modifications + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + ;; 1. Set a temporary, but coherent with PARENTS, indentation in + ;; order to get items endings and bullets properly + (org-list-struct-fix-ind struct parents 2) + ;; 2. Get pseudo-alist of ending positions and sort it by position. + ;; Then associate them to the structure. + (let (end-list acc-end) + (mapc (lambda (e) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (end-pos (org-list-get-item-end pos struct))) + (unless (assq end-pos struct) + ;; to determine real ind of an ending position that is + ;; not at an item, we have to find the item it belongs + ;; to: it is the last item (ITEM-UP), whose ending is + ;; further than the position we're interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (setq end-list + (append + (list (cons + (if item-up + (+ (org-list-get-ind item-up struct) 2) + 0) ; this case is for the bottom point + end-pos)) + end-list)))) + (setq end-list (append (list (cons ind-pos pos)) end-list)) + (setq acc-end (cons (cons end-pos pos) acc-end)))) + struct) + (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) + (org-list-struct-assoc-end struct end-list)) + ;; 3. Get bullets right + (let ((prevs (org-list-struct-prev-alist struct))) + (org-list-struct-fix-bul struct prevs) + ;; 4. Now get real indentation + (org-list-struct-fix-ind struct parents) + ;; 5. Eventually fix checkboxes + (org-list-struct-fix-box struct parents prevs)) + ;; 6. Apply structure modifications to buffer + (org-list-struct-apply-struct struct old-struct))) -(defun org-list-struct-outdent (start end origins) +(defun org-list-struct-outdent (start end struct parents) "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." +END, excluded. STRUCT is the concerned structure." (let* (acc (out (lambda (cell) (let* ((item (car cell)) @@ -1444,51 +1769,42 @@ STRUCT is the concerned structure." ((< item start) cell) ;; Item out of zone: follow associations in acc ((>= item end) - (let ((convert (assq parent acc))) + (let ((convert (and parent (assq parent acc)))) (if convert (cons item (cdr convert)) cell))) ;; Item has no parent: error - ((<= parent 0) + ((not parent) (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)))) + (let ((grand-parent (org-list-get-parent + parent struct parents))) (setq acc (cons (cons parent item) acc)) (cons item grand-parent)))))))) - (mapcar out origins))) + (mapcar out struct))) -(defun org-list-struct-indent (start end origins struct) +(defun org-list-struct-indent (start end struct parents prevs) "Indent 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'. +PARENTS is the alist of parents. See +`org-list-struct-parent-alist'. PREVS is the alist of previous +items. See `org-list-struct-prev-alist'. 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 - (lambda (cell parent) - (car (rassq parent (cdr (memq cell orig-rev)))))) - (set-assoc - (lambda (cell) - (setq acc (cons cell acc)) cell)) + (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))))))) + (function + (lambda (item) + (let* ((bul (org-trim (org-list-get-bullet item struct))) + (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet)))) + (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) (ind (lambda (cell) (let* ((item (car cell)) @@ -1502,79 +1818,130 @@ END." (if convert (cons item (cdr convert)) cell))) (t ;; Item is in zone... - (let ((prev (funcall get-prev-item cell parent))) + (let ((prev (org-list-get-prev-item item struct prevs))) ;; 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)) + ((and (not prev) (< 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)) + ((not prev) (funcall set-assoc cell)) ;; Previous item not indented: reparent to it - ((< prev start) - (funcall set-assoc (cons item prev))) + ((< prev start) (funcall set-assoc (cons item prev))) ;; Previous item indented: reparent like it (t (funcall set-assoc (cons item (cdr (assq prev acc))))))))))))) - (mapcar ind origins))) + (mapcar ind parents))) -(defun org-list-struct-apply-struct (struct bottom) +(defun org-list-struct-apply-struct (struct old-struct) "Apply modifications to list so it mirrors STRUCT. -BOTTOM is position at list ending. -Initial position is restored after the changes." +OLD-STRUCT is the structure before any modifications. Thus, the +function is smart enough to modify only parts of buffer which +have changed. + +Initial position of cursor is restored after the changes." (let* ((pos (copy-marker (point))) - (ancestor (caar struct)) - (full-item-re (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" - "\\(\\[@\\(?:start:\\)[0-9]+\\]\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?")) - (modify - (lambda (item) - (goto-char (car item)) - (looking-at full-item-re) - (let* ((new-ind (nth 1 item)) - (new-bul (org-list-bullet-string (nth 2 item))) - (new-box (nth 4 item)) - (old-bul (match-string 1)) - (old-ind (save-match-data (org-get-indentation))) - (old-body-ind (+ (length old-bul) old-ind)) - (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) bottom)) - ;; 2. Replace bullet - (unless (equal (match-string 1) new-bul) - (replace-match new-bul nil nil nil 1)) - ;; 3. Replace checkbox - (cond - ((and new-box - (save-match-data (org-at-item-description-p)) - (cdr (assq 'checkbox org-list-automatic-rules))) - (message "Cannot add a checkbox to a description list item")) - ((equal (match-string 3) new-box)) - ((and (match-string 3) new-box) - (replace-match new-box nil nil nil 3)) - ((match-string 3) - (goto-char (or (match-end 2) (match-end 1))) - (looking-at "\\[[ X-]\\][ \t]+") - (replace-match "")) - (t (goto-char (or (match-end 2) (match-end 1))) - (insert (concat new-box " ")))) - ;; 4. Indent item to appropriate column - (unless (= new-ind old-ind) - (delete-region (goto-char (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) - struct))) - ;; Apply changes from bottom to top - (mapc modify (nreverse struct-to-apply)) + (shift-body-ind + (function + ;; Shift the indentation between END and BEG by DELTA. + ;; Start from the line before END. + (lambda (end beg delta) + (unless (= delta 0) + (goto-char end) + (forward-line -1) + (while (or (> (point) beg) + (and (= (point) beg) (not (org-at-item-p)))) + (when (org-looking-at-p "^[ \t]*\\S-") + (let ((i (org-get-indentation))) + (org-indent-line-to (+ i delta)))) + (forward-line -1)))))) + (modify-item + (function + ;; Replace item first line elements with new elements from + ;; STRUCT, if appropriate. + (lambda (item) + (goto-char item) + (let* ((new-ind (org-list-get-ind item struct)) + (old-ind (org-list-get-ind item old-struct)) + (new-bul (org-list-bullet-string + (org-list-get-bullet item struct))) + (old-bul (org-list-get-bullet item old-struct)) + (new-box (org-list-get-checkbox item struct))) + (looking-at org-list-full-item-re) + ;; a. Replace bullet + (unless (equal old-bul new-bul) + (replace-match new-bul nil nil nil 1)) + ;; b. Replace checkbox + (cond + ((and new-box + (save-match-data (org-at-item-description-p)) + (cdr (assq 'checkbox org-list-automatic-rules))) + (message "Cannot add a checkbox to a description list item")) + ((equal (match-string 3) new-box)) + ((and (match-string 3) new-box) + (replace-match new-box nil nil nil 3)) + ((match-string 3) + (goto-char (or (match-end 2) (match-end 1))) + (looking-at "\\[[ X-]\\][ \t]+") + (replace-match "")) + (t (goto-char (or (match-end 2) (match-end 1))) + (insert (concat new-box " ")))) + ;; c. Indent item to appropriate column + (unless (= new-ind old-ind) + (delete-region (goto-char (point-at-bol)) + (progn (skip-chars-forward " \t") (point))) + (indent-to new-ind))))))) + ;; 1. First get list of items and position endings. We maintain + ;; two alists: ITM-SHIFT, determining indentation shift needed + ;; at item, and END-POS, a pseudo-alist where key is ending + ;; position and value point + (let (end-list acc-end itm-shift all-ends sliced-struct) + (mapc (lambda (e) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (ind-old (org-list-get-ind pos old-struct)) + (bul-pos (org-list-get-bullet pos struct)) + (bul-old (org-list-get-bullet pos old-struct)) + (ind-shift (- (+ ind-pos (length bul-pos)) + (+ ind-old (length bul-old)))) + (end-pos (org-list-get-item-end pos old-struct))) + (setq itm-shift (cons (cons pos ind-shift) itm-shift)) + (unless (assq end-pos old-struct) + ;; To determine real ind of an ending position that is + ;; not at an item, we have to find the item it belongs + ;; to: it is the last item (ITEM-UP), whose ending is + ;; further than the position we're interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (setq end-list (append + (list (cons end-pos item-up)) end-list)))) + (setq acc-end (cons (cons end-pos pos) acc-end)))) + old-struct) + ;; 2. Slice the items into parts that should be shifted by the + ;; same amount of indentation. The slices are returned in + ;; reverse order so changes modifying buffer do not change + ;; positions they refer to. + (setq all-ends (sort (append (mapcar 'car itm-shift) + (org-uniquify (mapcar 'car end-list))) + '<)) + (while (cdr all-ends) + (let* ((up (pop all-ends)) + (down (car all-ends)) + (ind (if (assq up struct) + (cdr (assq up itm-shift)) + (cdr (assq (cdr (assq up end-list)) itm-shift))))) + (setq sliced-struct (cons (list down up ind) sliced-struct)))) + ;; 3. Modify each slice in buffer, from end to beginning, with a + ;; special action when beginning is at item start. + (mapc (lambda (e) + (apply shift-body-ind e) + (let ((beg (nth 1 e))) + (when (assq beg struct) + (funcall modify-item beg)))) + sliced-struct)) + ;; 4. Go back to initial position (goto-char pos))) ;;; Indentation @@ -1590,24 +1957,6 @@ Initial position is restored after the changes." (t (throw 'exit t))))) i)) -(defun org-shift-item-indentation (delta bottom) - "Shift the indentation in current item by DELTA. -Sub-items are not moved. - -BOTTOM is position at list ending." - (save-excursion - (save-match-data - (let ((beg (point-at-bol)) - (end (org-end-of-item-or-at-child bottom))) - (beginning-of-line (unless (eolp) 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)) - (org-indent-line-to (+ i delta))))) - (beginning-of-line 0)))))) - (defun org-outdent-item () "Outdent a local list item, but not its children. If a region is active, all items inside will be moved." From af8da7965cad927af4307a57fbc99f42e7b164f3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 24 Dec 2010 00:53:30 +0100 Subject: [PATCH 031/107] org-list: interactive tools use new structures * org-list.el (org-list-repair): removed optional argument FORCE-BULLET. The job of this interactive function is to completely fix a list at point. Changing bullets is a separate task. Also removed others optional arguments TOP and BOTTOM to follow the new structures. (org-list-indent-item-generic): remove need for TOP and BOTTOM. STRUCT is a new required argument. This avoids computing a list structure many times when function is called more than once in a row, for example in org-cycle-item-indentation. Use new accessors. Now, also call `org-update-checkbox-count-maybe'. (org-outdent-item,org-indent-item,org-outdent-item-tree,org-indent-item-tree): remove need for TOP and BOTTOM. (org-list-insert-item-generic): reflect changes to `org-list-repair'. (org-list-exchange-items): use new accessors. Now modify struct to avoid re-reading it later. (org-move-item-down): reflect changes to `org-list-repair'. Use new accessors. (org-move-item-up): reflect changes to `org-list-repair'. Use new accessors. (org-cycle-list-bullet): use new structures. Also use a shortcut to `org-list-struct-fix-struct' in order to avoid unnecessary fixes, like `org-list-struct-fix-box' (org-sort-list): use of new structures. Renamed an internal function for a little more clarity. (org-cycle-item-indentation): remove dependency on org-list-repair. Use new accessors. (org-list-get-child): correct bug when asking for the child of the last item (org-list-exchange-items): use new accessors. --- lisp/org-list.el | 380 ++++++++++++++++++++++++----------------------- 1 file changed, 192 insertions(+), 188 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index e99974362..b48abc997 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -781,7 +781,7 @@ function ends." ;; marker here (setq bottom (copy-marker bottom)) (when checkbox (org-update-checkbox-count-maybe)) - (org-list-repair nil top bottom)))) + (org-list-repair nil)))) (goto-char true-pos) (cond (before-p (funcall insert-fun nil) t) @@ -809,7 +809,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 top bottom) +(defun org-list-indent-item-generic (arg no-subtree struct) "Indent a local list item including its children. When number ARG is a negative, item will be outdented, otherwise it will be indented. @@ -819,82 +819,90 @@ 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))) - (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) - (= 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 + (save-excursion + (beginning-of-line) + (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 at an item")) + (t + (let* ((top (org-list-get-top-point struct)) + (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-struct-prev-alist struct)) + ;; Are we going to move the whole list? + (specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= top (point))))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, save them for 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)) + (set-marker org-last-indent-end-marker (cond - (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 top (if specialp end bottom) (< arg 0))) - (origins (org-list-struct-origins 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 (org-list-get-ind beg struct))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" (org-list-get-bullet beg struct))) - (org-list-set-bullet beg struct (org-list-bullet-string "-"))) - ;; Shift ancestor - (let ((anc (caar struct))) - (org-list-set-ind anc struct (+ (org-list-get-ind anc struct) - offset))) - (org-list-struct-fix-struct struct origins) - (org-list-struct-apply-struct struct end)))) - ;; Forbidden move - ((and (< arg 0) - (or (and no-subtree - (not regionp) - (org-list-get-child beg origins)) - (let ((last-item (save-excursion - (goto-char end) - (skip-chars-backward " \r\t\n") - (org-get-item-beginning)))) - (org-list-get-child last-item origins)))) - (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 bottom)))))))))) + (specialp (org-list-get-bottom-point struct)) + (no-subtree (1+ (point))) + (t (org-list-get-item-end (point) struct)))))) + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker))) + (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 (org-list-get-ind beg struct)) + (old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" + (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct + (org-list-bullet-string "-"))) + ;; Shift every item by OFFSET and fix bullets. Then + ;; apply changes to buffer. + (mapc (lambda (e) + (let ((ind (org-list-get-ind (car e) struct))) + (org-list-set-ind (car e) struct (+ ind offset)))) + struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-apply-struct struct old-struct)))) + ;; Forbidden move: + ((and (< arg 0) + ;; If only one item is moved, it mustn't have a child + (or (and no-subtree + (not regionp) + (org-list-get-child beg struct)) + ;; If a subtree or region is moved, the last item + ;; of the subtree mustn't have a child + (let ((last-item (caar + (reverse + (org-remove-if + (lambda (e) (>= (car e) end)) + struct))))) + (org-list-get-child last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((new-parents + (if (< arg 0) + (org-list-struct-outdent beg end struct parents) + (org-list-struct-indent beg end struct parents prevs)))) + (org-list-struct-fix-struct struct new-parents)) + (org-update-checkbox-count-maybe))))))))) + t) ;;; Predicates @@ -1122,17 +1130,14 @@ in a plain list, or if this is the last item in the list." ;;; Manipulate -(defun org-list-exchange-items (beg-A beg-B bottom) +(defun org-list-exchange-items (beg-A beg-B struct) "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. - -BOTTOM is the position at list ending." +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 bottom)))) + (goto-char (org-list-get-item-end-before-blank pos struct)))) (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)) @@ -1147,20 +1152,22 @@ BOTTOM is the position at list ending." Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (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)) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((pos (point)) + (col (current-column)) + (actual-item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (next-item (org-list-get-next-item (point-at-bol) struct prevs))) + (if (not next-item) + (progn + (goto-char pos) + (error "Cannot move this item further down")) + (let ((next-item-size (- (org-list-get-item-end next-item struct) + next-item))) + (org-list-exchange-items actual-item next-item struct) + (org-list-repair) + (goto-char (+ (point) next-item-size)) (org-move-to-column col))))) (defun org-move-item-up () @@ -1168,21 +1175,20 @@ so this really moves item trees." Subitems (items with larger indentation) are considered part of the item, so this really moves item trees." (interactive) - (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) - (org-move-to-column col))))) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((pos (point)) + (col (current-column)) + (actual-item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) + (if (not prev-item) + (progn + (goto-char pos) + (error "Cannot move this item further up")) + (org-list-exchange-items prev-item actual-item struct) + (org-list-repair) + (org-move-to-column col)))) (defun org-insert-item (&optional checkbox) "Insert a new item at the current level. @@ -1481,7 +1487,9 @@ PARENTS, when provided, is the alist of items' parent. See "Return child of ITEM in STRUCT, or nil." (let ((ind (org-list-get-ind item struct)) (child-maybe (car (nth 1 (member (assq item struct) struct))))) - (when (< ind (org-list-get-ind child-maybe struct)) child-maybe))) + (when (and child-maybe + (< ind (org-list-get-ind child-maybe struct))) + child-maybe))) (defun org-list-get-next-item (item struct prevs) "Return next item in same sub-list as ITEM in STRUCT, or nil. @@ -1705,7 +1713,7 @@ This function modifies STRUCT." (mapc (lambda (e) (org-list-set-checkbox e struct "[ ]")) (nthcdr index all-items)) ;; Verify once again the structure, without ORDERED - (org-list-struct-fix-box struct prevs nil) + (org-list-struct-fix-box struct parents prevs nil) ;; return blocking item (nth index all-items))))))) @@ -1783,7 +1791,7 @@ END, excluded. STRUCT is the concerned structure." parent struct parents))) (setq acc (cons (cons parent item) acc)) (cons item grand-parent)))))))) - (mapcar out struct))) + (mapcar out parents))) (defun org-list-struct-indent (start end struct parents prevs) "Indent items in a structure. @@ -1961,74 +1969,76 @@ Initial position of cursor is restored after the changes." "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-top-point) (org-list-bottom-point))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 t struct))) (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 - 1 t (org-list-top-point) (org-list-bottom-point))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 t struct))) (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 - -1 nil (org-list-top-point) (org-list-bottom-point))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 nil struct))) (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 - 1 nil (org-list-top-point) (org-list-bottom-point))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 nil struct))) (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 +The first run indents 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." - (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 bottom) - (skip-chars-backward " \r\t\n") - (point)))) - (setq this-command 'org-cycle-item-indentation) - (let ((top (org-list-top-point))) + (when (org-at-item-p) + (let* ((org-adapt-indentation nil) + (struct (org-list-struct)) + (ind (org-list-get-ind (point-at-bol) struct))) + ;; Check that item is really empty + (when (and (or (org-at-item-description-p) + (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re))) + (>= (match-end 0) (save-excursion + (goto-char (org-list-get-item-end + (point-at-bol) struct)) + (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) (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)))) + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + ((and (= ind (car org-tab-ind-state)) + (ignore-errors (org-list-indent-item-generic 1 t struct)))) (t (back-to-indentation) (org-indent-to-column (car org-tab-ind-state)) + (looking-at "\\S-+") + (replace-match (cdr 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-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))) + ((ignore-errors (org-list-indent-item-generic 1 t struct))) + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + (t (error "Cannot move item")))) + t)))) ;;; Bullets @@ -2063,33 +2073,14 @@ It determines the number of whitespaces to append by looking at nil nil bullet) bullet)) -(defun org-list-repair (&optional force-bullet top bottom) +(defun org-list-repair () "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." +This function scans the list at point, along with any sublist." (interactive) (unless (org-at-item-p) (error "This is not a list")) - (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) - (let ((begin (nth 1 struct))) - (org-list-set-bullet (car begin) struct - (org-list-bullet-string force-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 bottom))) + (let* ((struct (org-list-struct)) + (parents (org-list-struct-parent-alist struct))) + (org-list-struct-fix-struct struct parents))) (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. @@ -2099,18 +2090,22 @@ This cycle the entire list level through the sequence: 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." +`previous', cycle backwards." (interactive "P") + (unless (org-at-item-p) (error "This is not a list")) (save-excursion - (let* ((top (org-list-top-point)) - (bullet (progn - (goto-char (org-get-beginning-of-list top)) - (org-get-bullet))) + (beginning-of-line) + (let* ((struct (org-list-struct)) + (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-struct-prev-alist struct)) + (list-beg (org-list-get-list-begin (point) struct prevs)) + (bullet (org-list-get-bullet list-beg struct)) (current (cond ((string-match "\\." bullet) "1.") ((string-match ")" bullet) "1)") - (t bullet))) + (t (org-trim bullet)))) (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + ;; Compute list of possible bullets, depending on context (bullet-list (append '("-" "+" ) ;; *-bullets are not allowed at column 0 (unless (and bullet-rule-p @@ -2130,7 +2125,13 @@ 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-list-repair new top)))) + ;; Use a short variation of `org-list-struct-fix-struct' as + ;; there's no need to go through all the steps. + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (org-list-set-bullet list-beg struct (org-list-bullet-string new)) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct))))) ;;; Checkboxes @@ -2204,6 +2205,7 @@ in subtree, ignoring drawers." (let* ((struct (org-list-struct)) (struct-copy (mapcar (lambda (e) (copy-alist e)) struct)) (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-struct-prev-alist struct)) (bottom (copy-marker (org-list-get-bottom-point struct))) (items-to-toggle (org-remove-if (lambda (e) (or (< e lim-up) (> e lim-down))) @@ -2217,7 +2219,8 @@ in subtree, ignoring drawers." ref-checkbox cur-box)))) items-to-toggle) - (setq block-item (org-list-struct-fix-box struct parents orderedp)) + (setq block-item (org-list-struct-fix-box + struct parents prevs orderedp)) ;; Report some problems due to ORDERED status of subtree. If ;; only one box was being checked, throw an error, else, ;; only signal problems. @@ -2296,7 +2299,7 @@ With optional prefix argument ALL, do this for the whole buffer." (let* ((pre (org-list-struct-prev-alist s)) (items (if recursivep - (or (and item (org-list-get-subtree item s pre)) + (or (and item (org-list-get-subtree item s)) (mapcar 'car s)) (or (and item (org-list-get-all-children item s pre)) (org-list-get-all-items @@ -2346,8 +2349,9 @@ With optional prefix argument ALL, do this for the whole buffer." (let ((item (point-at-bol))) (if (and backup-end (< item backup-end)) (funcall count-boxes item structs-backup) - (setq end-entry bottom - structs-backup (list (org-list-struct))) + (let ((struct (org-list-struct))) + (setq end-entry (org-list-get-bottom-point struct) + structs-backup (list struct))) (funcall count-boxes item structs-backup)))))) ;; Build the cookies list, with appropriate information (setq cookies-list (cons (list (match-beginning 1) ; cookie start @@ -2440,10 +2444,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)) - (top (org-list-top-point)) - (bottom (org-list-bottom-point)) - (start (org-get-beginning-of-list top)) - (end (org-get-end-of-list bottom)) + (struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (start (org-list-get-list-begin (point-at-bol) struct prevs)) + (end (org-list-get-list-end (point-at-bol) struct prevs)) (sorting-type (progn (message @@ -2465,11 +2469,11 @@ compare entries." ((= dcst ?f) compare-func) ((= dcst ?t) '<) (t nil))) - (begin-record (lambda () + (next-record (lambda () (skip-chars-forward " \r\t\n") (beginning-of-line))) (end-record (lambda () - (goto-char (org-end-of-item-before-blank end)))) + (goto-char (org-list-get-item-end (point) struct)))) (value-to-sort (lambda () (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") @@ -2499,12 +2503,12 @@ compare entries." (error "Invalid key function `%s'" getkey-func))) (t (error "Invalid sorting type `%c'" sorting-type))))))) (sort-subr (/= dcst sorting-type) - begin-record + next-record end-record value-to-sort nil sort-func) - (org-list-repair nil top bottom) + (org-list-repair nil) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) From b2c369725adbf14cf490bd6811f37d3ee706ef13 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 23 Dec 2010 22:02:05 +0100 Subject: [PATCH 032/107] org-list: keep byte-compiler happy --- lisp/org-list.el | 35 ++++++++++++++++++----------------- 1 file changed, 18 insertions(+), 17 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b48abc997..c7d897e14 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -44,31 +44,32 @@ (defvar org-ts-regexp) (defvar org-ts-regexp-both) -(declare-function org-on-heading-p "org" (&optional invisible-ok)) -(declare-function outline-next-heading "outline" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-at-heading-p "org" (&optional ignored)) (declare-function org-back-over-empty-lines "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-back-to-heading "org" (&optional invisible-ok)) (declare-function org-combine-plists "org" (&rest plists)) (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" ()) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-icompleting-read "org" (&rest args)) (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)) -(declare-function org-sublist "org" (list start end)) -(declare-function org-remove-if-not "org" (predicate seq)) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) (declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-invisible-p "org" ()) +(declare-function org-level-increment "org" ()) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-on-heading-p "org" (&optional invisible-ok)) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-show-subtree "org" ()) +(declare-function org-time-string-to-seconds "org" (s)) +(declare-function org-timer-hms-to-secs "org-timer" (hms)) +(declare-function org-timer-item "org-timer" (&optional arg)) +(declare-function org-trim "org" (s)) +(declare-function org-uniquify "org" (list)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." From e865ce445a2061d02da75c38d222fe04cb1b54c0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 24 Dec 2010 00:54:48 +0100 Subject: [PATCH 033/107] org-list: interactive navigation functions use accessors * lisp/org-list.el (org-list-in-item-p): unify methods for this predicate. (org-list-in-item-p-with-indent): removed function (org-list-ending-between): removed function (org-list-maybe-skip-block): removed function (org-list-in-item-p-with-regexp): removed function (org-list-top-point-with-regexp): removed function (org-list-top-point-with-indent): removed function (org-list-bottom-point-with-indent): removed function (org-list-bottom-point-with-regexp): removed function (org-list-get-item-same-level): removed function (org-list-top-point): removed function (org-list-bottom-point): removed function (org-get-item-beginning): renamed to org-list-get-item-begin to be consistent with naming policy of non-interactive functions. (org-get-beginning-of-list): removed function (org-beginning-of-item-list): use new accessors (org-get-end-of-list): removed function (org-end-of-list): use new accessors (org-get-end-of-item): removed function (org-end-of-item): use new accessors (org-get-previous-item): removed function (org-previous-item): use new accessors (org-get-next-item): removed function (org-next-item): use new accessors (org-end-of-item-before-blank): renamed to (org-list-get-item-end-before-blank): Use new accessors. --- lisp/org-list.el | 522 ++++++++++++----------------------------------- 1 file changed, 133 insertions(+), 389 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c7d897e14..cc98cad49 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -419,40 +419,6 @@ Symbols `block' and `invalid' refer to `org-list-blocks'." ;; Return the closest context around (assq (apply 'max (mapcar 'car context-list)) context-list))))))) -(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 -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 t)))) - ;; 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))))) - -(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 - (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 a string outside blocks and protected places. Arguments SEARCH, RE, BOUND and NOERR are similar to those in @@ -485,171 +451,6 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in (org-list-search-unenclosed-generic #'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." - (save-excursion - (beginning-of-line) - (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) - (or (org-at-item-p) - (let* ((case-fold-search t) - (ind-ref (org-get-indentation)) - ;; Ensure there is at least an item above - (up-item-p (save-excursion - (org-search-backward-unenclosed - org-item-beginning-re limit t)))) - (and up-item-p - (catch 'exit - (while t - (cond - ((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_")) - (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? -Plain lists end when `org-list-end-regexp' is matched, or at a -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 - ;; `org-item-re'. - (last-item-start (save-excursion - (org-search-backward-unenclosed - org-item-beginning-re limit t))) - (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))))) - -(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 -`org-list-ending-method'. for more information." - (save-excursion - (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. -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 - (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. -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 ((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 (+ (or (get-text-property (point) 'original-indentation) 0) - (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. -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 ((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) - (catch 'exit - (while t - (skip-chars-forward " \t") - (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) - (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 ind) - (forward-line 1)) - ((<= ind ind-ref) - (throw 'exit (progn - ;; Again, ensure bottom is just after a - ;; non-blank line. - (skip-chars-backward " \r\t\n") - (min (point-max) (1+ (point-at-eol)))))) - ((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?" (and (org-at-item-p) @@ -660,23 +461,6 @@ List ending is determined by the indentation of text. See (goto-char (match-end 0))) (looking-at regexp)))) -(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 search. Return nil if no item was found." - (save-excursion - (goto-char pos) - (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 - (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)) - (point-at-bol))))) - (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. @@ -744,7 +528,7 @@ function ends." (let* ((true-pos (point)) (top (org-list-top-point)) (bottom (copy-marker (org-list-bottom-point))) - (bullet (and (goto-char (org-get-item-beginning)) + (bullet (and (goto-char (org-list-get-item-begin)) (org-list-bullet-string (org-get-bullet)))) (ind (org-get-indentation)) (before-p (progn @@ -761,7 +545,7 @@ function ends." (lambda (text) ;; insert bullet above item in order to avoid bothering ;; with possible blank lines ending last item. - (goto-char (org-get-item-beginning)) + (goto-char (org-list-get-item-begin)) (org-indent-to-column ind) (insert (concat bullet (when checkbox "[ ] ") after-bullet)) ;; Stay between after-bullet and before text. @@ -773,7 +557,7 @@ function ends." (setq bottom (marker-position bottom)) (let ((col (current-column))) (org-list-exchange-items - (org-get-item-beginning) (org-get-next-item (point) bottom) + (org-list-get-item-begin) (org-get-next-item (point) bottom) bottom) ;; recompute next-item: last sexp modified list (goto-char (org-get-next-item (point) bottom)) @@ -910,32 +694,50 @@ Return t if successful." (defun org-in-item-p () "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* ((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 'regexp) - (org-list-in-item-p-with-regexp bound)) - ((eq org-list-ending-method 'indent) - (org-list-in-item-p-with-indent 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 (top) - "Is this item the first item in a plain list? -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 top t)) - (< (org-get-indentation) ind))))) + (unless (or (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) + (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re)) + (progn (forward-line -1) (looking-at (org-list-end-re))))) + (or (and (org-at-item-p) (point-at-bol)) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (ind-ref (if (looking-at "^[ \t]*$") + 10000 + (org-get-indentation)))) + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((<= (point) lim-up) + (throw 'exit (and (org-at-item-p) (< ind ind-ref)))) + ((and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (throw 'exit nil)) + ;; Skip blocks, drawers, inline-tasks, blank lines + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" nil t)) + ((looking-at "^[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") + (forward-line -1)) + ((< ind ind-ref) + (if (org-at-item-p) + (throw 'exit (point)) + (setq ind-ref ind) + (forward-line -1))) + (t (if (and (eq org-list-ending-method 'regexp) + (org-at-item-p)) + (throw 'exit (point)) + (forward-line -1)))))))))))) (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" @@ -963,178 +765,86 @@ TOP is the position of list's top-item." ;;; 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 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. -Assume point is in a list." - (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 'regexp) - (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))) - (org-list-top-point-with-indent (or top-re bound))))))) - -(defun org-list-bottom-point () - "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 - ;; changes OUTLINE-REGEXP. - (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))))))) - -(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))) +(defalias 'org-list-get-item-begin 'org-in-item-p) (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) - (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)))) + (let ((begin (org-in-item-p))) + (if begin (goto-char begin) (error "Not in an item")))) (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))))) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-list-begin begin (org-list-struct))))))) (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." - (or (org-get-next-item (point) bottom) - (org-get-end-of-list bottom))) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-list-end begin (org-list-struct))))))) (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) - (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 (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 (bottom) - "Return point at end of item, before any blank line. -Point returned is at eol. - -BOTTOM is the position at list ending." - (save-excursion - (goto-char (org-get-end-of-item bottom)) - (skip-chars-backward " \r\t\n") - (point-at-eol))) - -(defun org-get-previous-item (pos limit) - "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)) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-item-end begin struct)))))) (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) - (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-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)) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (prevp (org-list-get-prev-item begin struct prevs))) + (if prevp (goto-char prevp) (error "On first item")))))) (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) - (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"))))) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (prevp (org-list-get-next-item begin struct prevs))) + (if prevp (goto-char prevp) (error "On last item")))))) ;;; Manipulate (defun org-list-exchange-items (beg-A beg-B struct) - "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." + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. +Blank lines at the end of items are left in place. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B +belong to the same sub-list. + +This function modifies STRUCT." (save-excursion (let* ((end-of-item-no-blank (lambda (pos) @@ -1146,7 +856,21 @@ is lesser than BEG-B." (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))))) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions + (let* ((sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct))) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (inter-A-B (- beg-B end-A)) + (size-A (- end-A beg-A)) + (size-B (- end-B beg-B))) + (mapc (lambda (e) (org-list-set-pos e struct (+ e size-B inter-A-B))) + sub-A) + (mapc (lambda (e) (org-list-set-pos e struct (- e size-A inter-A-B))) + sub-B) + (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))) (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. @@ -1164,12 +888,17 @@ so this really moves item trees." (progn (goto-char pos) (error "Cannot move this item further down")) - (let ((next-item-size (- (org-list-get-item-end next-item struct) - next-item))) - (org-list-exchange-items actual-item next-item struct) - (org-list-repair) - (goto-char (+ (point) next-item-size)) - (org-move-to-column col))))) + (org-list-exchange-items actual-item next-item struct) + ;; Use a short variation of `org-list-struct-fix-struct' as + ;; there's no need to go through all the steps. + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (prevs (org-list-struct-prev-alist struct)) + (parents (org-list-struct-parent-alist struct))) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct) + (goto-char (org-list-get-next-item (point-at-bol) struct prevs))) + (org-move-to-column col)))) (defun org-move-item-up () "Move the plain list item at point up, i.e. swap with previous item. @@ -1188,7 +917,14 @@ so this really moves item trees." (goto-char pos) (error "Cannot move this item further up")) (org-list-exchange-items prev-item actual-item struct) - (org-list-repair) + ;; Use a short variation of `org-list-struct-fix-struct' as + ;; there's no need to go through all the steps. + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (prevs (org-list-struct-prev-alist struct)) + (parents (org-list-struct-parent-alist struct))) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct)) (org-move-to-column col)))) (defun org-insert-item (&optional checkbox) @@ -1205,13 +941,13 @@ item is invisible." (goto-char (org-get-item-beginning)) (outline-invisible-p))) (if (save-excursion - (goto-char (org-get-item-beginning)) + (goto-char (org-list-get-item-begin)) (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 (goto-char (org-get-item-beginning)) + (and (goto-char (org-list-get-item-begin)) (org-at-item-description-p))) (concat (read-string "Term: ") " :: ")))) ;; Don't insert a checkbox if checkbox rule is applied and it @@ -1612,6 +1348,14 @@ previous items. See `org-list-struct-prev-alist'." "Return end position of ITEM in STRUCT." (org-list-get-nth 5 item struct)) +(defun org-list-get-item-end-before-blank (item struct) + "Return point at end of item, before any blank line. +Point returned is at end of line." + (save-excursion + (goto-char (org-list-get-item-end item struct)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (defun org-list-struct-fix-bul (struct prevs) "Verify and correct bullets for every association in STRUCT. \nThis function modifies STRUCT." From ddcd5d480f04271e44303bf57ab20e960b233e1e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 24 Dec 2010 13:25:37 +0100 Subject: [PATCH 034/107] org-list: rewrite of insert-item code. * org-list.el (org-list-separating-blank-lines-number): use new accessors. (org-list-insert-item-generic): use list structures to insert a new item. (org-list-exchange-items): refactor and comment code. Now return new struct instead of modifying it, as list sorting would sometimes eat first item. (org-move-item-down,org-move-item-up): reflect changes to `org-list-exchange-items'. (org-insert-item): as `org-in-item-p' also computes item beginning when applicable, reuse the result. * org-timer.el (org-timer-item): as `org-in-item-p' also computes item beginning when applicable, reuse the result. --- lisp/org-list.el | 339 ++++++++++++++++++++++++++++------------------ lisp/org-timer.el | 32 ++--- 2 files changed, 223 insertions(+), 148 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index cc98cad49..22aedd83a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -461,12 +461,9 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in (goto-char (match-end 0))) (looking-at regexp)))) -(defun org-list-separating-blank-lines-number (pos top bottom) +(defun org-list-separating-blank-lines-number (pos struct prevs) "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. +POS is the position at item beginning to be considered. Assume point is at item's beginning. If the item is alone, apply some heuristics to guess the result." @@ -483,16 +480,16 @@ some heuristics to guess the result." ((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))) + (t (let ((next-p (org-list-get-next-item (point) struct prevs))) (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-list-get-prev-item (point) struct prevs) (org-back-over-empty-lines)) ;; User inserted blank lines, trust him - ((and (> pos (org-end-of-item-before-blank bottom)) + ((and (> pos (org-list-get-item-end-before-blank pos struct)) (> (save-excursion (goto-char pos) (skip-chars-backward " \t") @@ -501,7 +498,8 @@ some heuristics to guess the result." ;; Are there blank lines inside the item ? ((save-excursion (org-search-forward-unenclosed - "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1) + "^[ \t]*$" (org-list-get-item-end-before-blank pos struct) t)) + 1) ;; No parent: no blank line. (t 0)))))))) @@ -513,83 +511,136 @@ 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 ends." - (goto-char pos) - ;; 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))) - (if (not (cdr (assq 'insert org-list-automatic-rules))) - ;; 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) - (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t) - (end-of-line 0))) - (let* ((true-pos (point)) - (top (org-list-top-point)) - (bottom (copy-marker (org-list-bottom-point))) - (bullet (and (goto-char (org-list-get-item-begin)) - (org-list-bullet-string (org-get-bullet)))) - (ind (org-get-indentation)) - (before-p (progn - ;; Description item: text starts after colons. - (or (org-at-item-description-p) - ;; 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)))) - (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 - ;; with possible blank lines ending last item. - (goto-char (org-list-get-item-begin)) - (org-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 - ;; 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-list-get-item-begin) (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))) - ;; 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)))) - (goto-char true-pos) - (cond - (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) - ;; 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 modified line. - (let* ((pos (point)) - (end-before-blank (org-end-of-item-before-blank bottom)) - (after-text - (when (< pos end-before-blank) - (prog1 - (delete-and-extract-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))) - (beginning-of-line 0)))))) - (funcall insert-fun after-text) t))))) + (let ((case-fold-search t)) + (goto-char pos) + ;; 1. Check if a new item can be inserted at point: are we in an + ;; invalid block ? Move outside it if `org-list-automatic' + ;; rules says so. + (when (or (eq (nth 2 (org-list-context)) 'invalid) + (save-excursion + (beginning-of-line) + (or (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_") + (looking-at (concat + "\\(" + org-drawer-regexp + "\\|^[ \t]*:END:[ \t]*$\\)")) + (and (featurep 'org-inlinetask) + (looking-at (org-inlinetask-outline-regexp)))))) + (if (not (cdr (assq 'insert org-list-automatic-rules))) + (error "Cannot insert item inside a block") + (end-of-line) + (if (string-match "^\\*+[ \t]+" (match-string 0)) + (org-inlinetask-goto-beginning) + (let ((block-start (if (string-match "#\\+" (match-string 0)) + "^[ \t]*#\\+begin_" + org-drawer-regexp))) + (re-search-backward block-start nil t))) + (end-of-line 0))) + ;; 2. Get information about list: structure, usual helper + ;; functions, position of point with regards to item start + ;; (BEFOREP), blank lines number separating items (BLANK-NB), + ;; position of split (POS) if we're allowed to (SPLIT-LINE-P). + (let* ((pos (point)) + (item (goto-char (org-get-item-beginning))) + (struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (item-end (org-list-get-item-end item struct)) + (item-end-no-blank (org-list-get-item-end-before-blank item struct)) + (beforep (and (or (org-at-item-description-p) + (looking-at org-list-full-item-re)) + (<= pos (match-end 0)))) + (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) + (blank-nb (org-list-separating-blank-lines-number + item struct prevs)) + ;; 3. Build the new item to be created. Concatenate same + ;; bullet as item, checkbox, text AFTER-BULLET if + ;; provided, and text cut from point to end of item + ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on + ;; BEFOREP and SPLIT-LINE-P. The difference of size + ;; between what was cut and what was inserted in buffer + ;; is stored in SIZE-OFFSET. + (ind (org-list-get-ind item struct)) + (bullet (org-list-bullet-string (org-list-get-bullet item struct))) + (box (when checkbox "[ ]")) + (text-cut + (and (not beforep) split-line-p + (progn + (goto-char pos) + (skip-chars-backward " \r\t\n") + (setq pos (point)) + (delete-and-extract-region pos item-end-no-blank)))) + (body (concat bullet (when box (concat box " ")) after-bullet + (or (and text-cut + (if (string-match "\\`[ \t]+" text-cut) + (replace-match "" t t text-cut) + text-cut)) + ""))) + (item-sep (make-string (1+ blank-nb) ?\n)) + (item-size (+ ind (length body) (length item-sep))) + (size-offset (- item-size (length text-cut)))) + ;; 4. Insert effectively item into buffer + (goto-char item) + (org-indent-to-column ind) + (insert body) + (insert item-sep) + ;; 5. Add new item to STRUCT. + (mapc (lambda (e) + (let ((p (car e)) + (end (nth 5 e))) + (cond + ;; Before inserted item, positions don't change but + ;; an item ending after insertion has its end shifted + ;; by SIZE-OFFSET. + ((< p item) + (when (> end item) (setcar (nthcdr 5 e) (+ end size-offset)))) + ;; Trivial cases where current item isn't split in + ;; two. Just shift every item after new one by + ;; ITEM-SIZE. + ((or beforep (not split-line-p)) + (setcar e (+ p item-size)) + (setcar (nthcdr 5 e) (+ end item-size))) + ;; Item is split in two: elements before POS are just + ;; shifted by ITEM-SIZE. In the case item would end + ;; after split POS, ending is only shifted by + ;; SIZE-OFFSET. + ((< p pos) + (setcar e (+ p item-size)) + (if (< end pos) + (setcar (nthcdr 5 e) (+ end item-size)) + (setcar (nthcdr 5 e) (+ end size-offset)))) + ;; Elements after POS are moved into new item. Length + ;; of ITEM-SEP has to be removed as ITEM-SEP + ;; doesn't appear in buffer yet. + ((< p item-end) + (setcar e (+ p size-offset (- item pos (length item-sep)))) + (if (= end item-end) + (setcar (nthcdr 5 e) (+ item item-size)) + (setcar (nthcdr 5 e) + (+ end size-offset + (- item pos (length item-sep)))))) + ;; Elements at ITEM-END or after are only shifted by + ;; SIZE-OFFSET. + (t (setcar e (+ p size-offset)) + (setcar (nthcdr 5 e) (+ end size-offset)))))) + struct) + (setq struct (sort + (cons (list item ind bullet nil box (+ item item-size)) + struct) + (lambda (e1 e2) (< (car e1) (car e2))))) + ;; 6. If not BEFOREP, new item must appear after ITEM, so + ;; exchange ITEM with the next item in list. Position cursor + ;; after bullet, counter, checkbox, and label. + (if beforep + (goto-char item) + (setq struct (org-list-exchange-items item (+ item item-size) struct)) + (goto-char (org-list-get-next-item + item struct (org-list-struct-prev-alist struct)))) + (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) + (when checkbox (org-update-checkbox-count-maybe)) + (or (org-at-item-description-p) + (looking-at org-list-full-item-re)) + (goto-char (match-end 0)) + t))) (defvar org-last-indent-begin-marker (make-marker)) (defvar org-last-indent-end-marker (make-marker)) @@ -839,38 +890,58 @@ in a plain list, or if this is the last item in the list." (defun org-list-exchange-items (beg-A beg-B struct) "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. -Blank lines at the end of items are left in place. +Blank lines at the end of items are left in place. Return the new +structure after the changes. -Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B -belong to the same sub-list. +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. This function modifies STRUCT." (save-excursion - (let* ((end-of-item-no-blank - (lambda (pos) - (goto-char (org-list-get-item-end-before-blank pos struct)))) - (end-A-no-blank (funcall end-of-item-no-blank beg-A)) - (end-B-no-blank (funcall end-of-item-no-blank beg-B)) + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-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))) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + ;; 1. Move effectively items in buffer. (goto-char beg-A) (delete-region beg-A end-B-no-blank) (insert (concat body-B between-A-no-blank-and-B body-A)) - ;; Now modify struct. No need to re-read the list, the - ;; transformation is just a shift of positions - (let* ((sub-A (cons beg-A (org-list-get-subtree beg-A struct))) - (sub-B (cons beg-B (org-list-get-subtree beg-B struct))) - (end-A (org-list-get-item-end beg-A struct)) - (end-B (org-list-get-item-end beg-B struct)) - (inter-A-B (- beg-B end-A)) - (size-A (- end-A beg-A)) - (size-B (- end-B beg-B))) - (mapc (lambda (e) (org-list-set-pos e struct (+ e size-B inter-A-B))) - sub-A) - (mapc (lambda (e) (org-list-set-pos e struct (- e size-A inter-A-B))) - sub-B) - (sort struct (lambda (e1 e2) (< (car e1) (car e2)))))))) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, item + ;; BEG-A will end with whitespaces that were at the end of + ;; BEG-B and the same applies to BEG-B. + (mapc (lambda (e) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 5 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 5 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 5 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 5 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 5 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 5 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 5 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 5 e) (+ end-e (- size-B size-A)))))))) + struct) + (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) (defun org-move-item-down () "Move the plain list item at point down, i.e. swap with following item. @@ -888,7 +959,8 @@ so this really moves item trees." (progn (goto-char pos) (error "Cannot move this item further down")) - (org-list-exchange-items actual-item next-item struct) + (setq struct + (org-list-exchange-items actual-item next-item struct)) ;; Use a short variation of `org-list-struct-fix-struct' as ;; there's no need to go through all the steps. (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) @@ -916,7 +988,8 @@ so this really moves item trees." (progn (goto-char pos) (error "Cannot move this item further up")) - (org-list-exchange-items prev-item actual-item struct) + (setq struct + (org-list-exchange-items prev-item actual-item struct)) ;; Use a short variation of `org-list-struct-fix-struct' as ;; there's no need to go through all the steps. (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) @@ -936,27 +1009,29 @@ 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)) - (save-excursion - (goto-char (org-get-item-beginning)) - (outline-invisible-p))) - (if (save-excursion - (goto-char (org-list-get-item-begin)) - (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 (goto-char (org-list-get-item-begin)) - (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 - (or (not desc-text) - (not (cdr (assq 'checkbox org-list-automatic-rules))))) - desc-text))))) + (let ((itemp (org-in-item-p))) + (unless (or (not itemp) + (save-excursion + (goto-char itemp) + (org-invisible-p))) + (if (save-excursion + (goto-char itemp) + (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 (goto-char itemp) + (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 + (or (not desc-text) + (not (cdr (assq 'checkbox org-list-automatic-rules))))) + desc-text)))))) + ;;; Structures diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 908232792..d3b2572f1 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -207,22 +207,22 @@ it in the buffer." (defun org-timer-item (&optional arg) "Insert a description-type item with the current timer value." (interactive "P") - (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-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) - (error "This is not a timer list")) - ;; Else, insert the timer correctly indented at bol. - (t - (beginning-of-line) - (org-indent-line-function) - (insert "- ") - (org-timer (when arg '(4))) - (insert ":: ")))) + (let ((itemp (org-in-item-p))) + (cond + ;; In a timer list, insert with `org-list-insert-item-generic'. + ((and itemp + (save-excursion (goto-char itemp) (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. + (itemp (error "This is not a timer list")) + ;; Else, insert the timer correctly indented at bol. + (t + (beginning-of-line) + (org-indent-line-function) + (insert "- ") + (org-timer (when arg '(4))) + (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 e2233577435e403b99e8fa8d472da7a7a680ff07 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 24 Dec 2010 16:13:59 +0100 Subject: [PATCH 035/107] Lighten process when C-c C-c is called at a list item * org.el (org-ctrl-c-ctrl-c): when called at a list item, replace usage `org-repair-list', forcing another reading of the list, with only needed subroutines. --- lisp/org.el | 42 ++++++++++++++++++++++++++++++++++++++---- 1 file changed, 38 insertions(+), 4 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 655d10621..4d9a367ea 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17398,12 +17398,46 @@ 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-list-repair) - (call-interactively 'org-toggle-checkbox) + ;; Use a light version of `org-toggle-checkbox' to avoid + ;; computing list structure twice. + (let* ((cbox (match-string 1)) + (struct (org-list-struct)) + (old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-struct-prev-alist struct)) + (orderedp (ignore-errors (org-entry-get nil "ORDERED"))) + block-item) + (org-list-set-checkbox (point-at-bol) struct + (cond + ((equal arg '(16)) "[-]") + ((equal arg '(4)) nil) + ((equal "[ ]" cbox) "[X]") + (t "[ ]"))) + (org-list-struct-fix-ind struct parents) + (org-list-struct-fix-bul struct prevs) + (setq block-item + (org-list-struct-fix-box struct parents prevs orderedp)) + (when block-item + (message + "Checkboxes were removed due to unchecked box at line %d" + (org-current-line block-item))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) (org-list-send-list 'maybe)) ((org-at-item-p) - (call-interactively 'org-list-repair) - (when arg (call-interactively 'org-toggle-checkbox)) + ;; Do checkbox related actions only if function was called with + ;; an argument + (let* ((struct (org-list-struct)) + (old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-struct-prev-alist struct))) + (org-list-struct-fix-ind struct parents) + (org-list-struct-fix-bul struct prevs) + (when arg + (org-list-set-checkbox (point-at-bol) struct "[ ]") + (org-list-struct-fix-box struct parents prevs)) + (org-list-struct-apply-struct struct old-struct) + (when arg (org-update-checkbox-count-maybe))) (org-list-send-list 'maybe)) ((save-excursion (beginning-of-line 1) (looking-at org-dblock-start-re)) ;; Dynamic block From c12ce921d7127ac86db6406acaa61400bbaf0e4c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 01:42:34 +0100 Subject: [PATCH 036/107] Checkboxes do not change indentation in lists * org.el (org-indent-line-function): Indentation of item's body starts just after the bullet, not after a checkbox. Moreover, As `org-in-item-p' also returns item beginning position when point is in a list, do not compute it a second time. --- lisp/org.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 4d9a367ea..39eb60e8f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18817,9 +18817,9 @@ If point is in an inline task, mark that task instead." (org-get-indentation) (org-get-indentation (match-string 0))))) ;; Lists - ((org-in-item-p) - (org-beginning-of-item) - (looking-at "[ \t]*\\(\\S-+\\)[ \t]*\\(\\(:?\\[@\\(:?start:\\)?[0-9]+\\][ \t]*\\)?\\[[- X]\\][ \t]*\\|.*? :: \\)?") + ((let ((in-item-p (org-in-item-p))) + (and in-item-p (goto-char in-item-p))) + (or (org-at-item-description-p) (org-at-item-p)) (setq bpos (match-beginning 1) tpos (match-end 0) bcol (progn (goto-char bpos) (current-column)) tcol (progn (goto-char tpos) (current-column))) @@ -18840,7 +18840,11 @@ If point is in an inline task, mark that task instead." (and (looking-at "[ \t]*#\\+end_") (re-search-backward "[ \t]*#\\+begin_"nil t)) (looking-at "[ \t]*[\n:#|]") - (and (org-in-item-p) (goto-char (org-list-top-point))) + (let ((itemp (org-in-item-p))) + (and itemp + (goto-char itemp) + (goto-char + (org-list-get-top-point (org-list-struct))))) (and (not inline-task-p) (featurep 'org-inlinetask) (org-inlinetask-in-task-p) From 14df1d59d4b3ad73dccf34383b6e19680c9f3e53 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 01:43:20 +0100 Subject: [PATCH 037/107] org-list: various fixes to accessors * org-list.el (org-list-has-child-p): renamed from org-list-get-child. Returning first child is only useful as a predicate, as we're allowing an item to have more than one sub-list. (org-list-indent-item-generic): use `org-list-has-child-p' instead of org-list-get-child. (org-in-item-p): also return item beginning when list starts at context beginning. (org-list-get-parent): use of `org-list-struct-parent-alist' helper function is not optional anymore. (org-list-get-all-items): shorten code with the help of cl.el. (org-list-get-children): now returns all children of item, even if they do not belong to the same list. Renamed from org-list-get-all-children. (org-list-get-list-begin): function wasn't return value when item was already the first item of the list at point. (org-list-get-list-end): function wasn't return value when item was already the last item of the list at point. (org-list-struct-fix-box,org-update-checkbox-count): now uses `org-list-get-children'. --- lisp/org-list.el | 45 +++++++++++++++++++++++++-------------------- 1 file changed, 25 insertions(+), 20 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 22aedd83a..c62319c96 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -720,7 +720,7 @@ Return t if successful." ;; If only one item is moved, it mustn't have a child (or (and no-subtree (not regionp) - (org-list-get-child beg struct)) + (org-list-has-child-p beg struct)) ;; If a subtree or region is moved, the last item ;; of the subtree mustn't have a child (let ((last-item (caar @@ -728,7 +728,7 @@ Return t if successful." (org-remove-if (lambda (e) (>= (car e) end)) struct))))) - (org-list-get-child last-item struct)))) + (org-list-has-child-p last-item struct)))) (error "Cannot outdent an item without its children")) ;; Normal shifting (t @@ -765,7 +765,7 @@ This checks `org-list-ending-method'." (let ((ind (org-get-indentation))) (cond ((<= (point) lim-up) - (throw 'exit (and (org-at-item-p) (< ind ind-ref)))) + (throw 'exit (and (org-at-item-p) (< ind ind-ref) (point)))) ((and (not (eq org-list-ending-method 'indent)) (looking-at (org-list-end-re))) (throw 'exit nil)) @@ -1288,15 +1288,16 @@ This function modifies STRUCT." (t (cons pos (cdar ind-to-ori)))))) (cdr struct))))) -(defun org-list-get-parent (item struct &optional parents) +(defun org-list-get-parent (item struct parents) "Return parent of ITEM in STRUCT, or nil. -PARENTS, when provided, is the alist of items' parent. See +PARENTS is the alist of items' parent. See `org-list-struct-parent-alist'." (let ((parents (or parents (org-list-struct-parent-alist struct)))) (cdr (assq item parents)))) -(defun org-list-get-child (item struct) - "Return child of ITEM in STRUCT, or nil." +(defun org-list-has-child-p (item struct) + "Return a non-nil value if ITEM in STRUCT has a child. +The value returned is the position of the first child of ITEM." (let ((ind (org-list-get-ind item struct)) (child-maybe (car (nth 1 (member (assq item struct) struct))))) (when (and child-maybe @@ -1338,17 +1339,20 @@ PREVS, when provided, is the alist of previous items. See (next-item item) before-item after-item) (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) - (setq before-item (cons prev-item before-item))) + (push prev-item before-item)) (while (setq next-item (org-list-get-next-item next-item struct prevs)) - (setq after-item (cons next-item after-item))) + (push next-item after-item)) (append before-item (list item) (nreverse after-item)))) -(defun org-list-get-all-children (item struct prevs) +(defun org-list-get-children (item struct parents) "List all children of ITEM in STRUCT, or nil. -PREVS is the alist of previous items. See -`org-list-struct-prev-alist'." - (let ((child (org-list-get-child item struct))) - (and child (org-list-get-all-items child struct prevs)))) +PARENTS is the alist of items' parent. See +`org-list-struct-parent-alist'." + (let (all) + (while (setq child (car (rassq item parents))) + (setq parents (cdr (member (assq child parents) parents)) + all (cons child all))) + (nreverse all))) (defun org-list-get-top-point (struct) "Return point at beginning of list. @@ -1365,8 +1369,8 @@ STRUCT is the structure of the list." "Return point at beginning of sub-list ITEM belongs. STRUCT is the structure of the list. PREVS is the alist of previous items. See `org-list-struct-prev-alist'." - (let ((prev-item item) first-item) - (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) + (let ((first-item item) prev-item) + (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) (setq first-item prev-item)) first-item)) @@ -1374,8 +1378,8 @@ previous items. See `org-list-struct-prev-alist'." "Return point at end of sub-list ITEM belongs. STRUCT is the structure of the list. PREVS is the alist of previous items. See `org-list-struct-prev-alist'." - (let ((next-item item) last-item) - (while (setq next-item (org-list-get-next-item next-item struct prevs)) + (let ((last-item item) next-item) + (while (setq next-item (org-list-get-next-item last-item struct prevs)) (setq last-item next-item)) (org-list-get-item-end last-item struct))) @@ -1495,7 +1499,7 @@ This function modifies STRUCT." (let* ((box-list (mapcar (lambda (child) (org-list-get-checkbox child struct)) - (org-list-get-all-children item struct prevs)))) + (org-list-get-children item struct parents)))) (org-list-set-checkbox item struct (cond @@ -2117,11 +2121,12 @@ With optional prefix argument ALL, do this for the whole buffer." (mapc (lambda (s) (let* ((pre (org-list-struct-prev-alist s)) + (par (org-list-struct-parent-alist s)) (items (if recursivep (or (and item (org-list-get-subtree item s)) (mapcar 'car s)) - (or (and item (org-list-get-all-children item s pre)) + (or (and item (org-list-get-children item s par)) (org-list-get-all-items (org-list-get-top-point s) s pre)))) (cookies (delq nil (mapcar From e2c1ec92a482f91a96220b33466bb85cf72fedc0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 01:43:42 +0100 Subject: [PATCH 038/107] org-list: new parsing of lists * org-list.el (org-list-parse-list): rewrite of function to allow text following a sub-list in the same item. See docstring for an example of output. (org-list-to-generic): use new parsing function. (org-list-to-latex,org-list-to-html): minor change for clearer export. --- lisp/org-list.el | 208 +++++++++++++++++++++++++++++++---------------- 1 file changed, 140 insertions(+), 68 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c62319c96..2a73fea8c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2338,46 +2338,103 @@ compare entries." (message "Sorting items...done"))))) ;;; Send and receive lists - (defun org-list-parse-list (&optional delete) "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* ((start (goto-char (org-list-top-point))) - (end (org-list-bottom-point)) - output itemsep ltype) - (while (org-search-forward-unenclosed org-item-beginning-re end t) - (save-excursion - (beginning-of-line) - (setq ltype (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) - ((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-or-at-child end)))) - (nextindent (if (= (point) end) 0 (org-get-indentation))) - (item (if (string-match - "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" - item) - (replace-match (if (equal (match-string 1 item) " ") - "CBOFF" - "CBON") - t nil item 1) - item))) - (push item output) - (when (> nextindent indent1) - (save-restriction - (narrow-to-region (point) nextitem) - (push (org-list-parse-list) output))))) + +Return a list whose car is a symbol of list type, among +`ordered', `unordered' and `descriptive'. Then, each item is a +list whose elements are strings and other sub-lists. Inside +strings, checkboxes are replaced by \"[CBON]\" and \"[CBOFF]\". + +For example, the following list: + +1. first item + + sub-item one + + [X] sub-item two + more text in first item +2. last item + +will be parsed as: + +\(ordered \(\"first item\" + \(unordered \(\"sub-item one\"\) \(\"[CBON] sub-item two\"\)\) + \"more text in first item\"\) + \(\"last item\"\)\) + +Point is left at list end." + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (parents (org-list-struct-parent-alist struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + out + (get-list-type + (function + ;; determine type of list by looking at item at POS. + (lambda (pos) + (save-excursion + (goto-char pos) + (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) + ((org-at-item-description-p) 'descriptive) + (t 'unordered)))))) + (parse-sublist + (function + ;; return a list whose car is list type and cdr a list of + ;; items' body. + (lambda (e) + (cons (funcall get-list-type (car e)) + (mapcar parse-item e))))) + (parse-item + (function + ;; return a list containing text and any sublist inside + ;; item. + (lambda (e) + (let ((start (save-excursion + (goto-char e) + (looking-at org-item-beginning-re) + (match-end 0))) + (childp (org-list-has-child-p e struct)) + (end (org-list-get-item-end e struct))) + (if childp + (let* ((children (org-list-get-children e struct parents)) + (body (list (funcall get-text start childp t)))) + (while children + (let* ((first (car children)) + (sub (org-list-get-all-items first struct prevs)) + (last-c (car (last sub))) + (last-end (org-list-get-item-end last-c struct))) + (push (funcall parse-sublist sub) body) + (setq children (cdr (member last-c children))) + (unless (= (or (car children) end) last-end) + (push (funcall get-text last-end (or (car children) end) nil) + body)))) + (nreverse body)) + (list (funcall get-text start end t))))))) + (get-text + (function + ;; return text between BEG and END, trimmed, with + ;; checkboxes replaced if BOX is true. + (lambda (beg end box) + (let ((text (org-trim (buffer-substring beg end)))) + (if (and box + (string-match + "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" + text)) + (replace-match + (if (equal (match-string 1 text) " ") "CBOFF" "CBON") + t nil text 1) + text)))))) + ;; store output, take care of cursor position and deletion of + ;; list, then return output. + (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) + (goto-char bottom) (when delete - (delete-region start end) + (delete-region top bottom) (save-match-data (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))) + out)) (defun org-list-make-subtree () "Convert the plain list at point into a subtree." @@ -2515,38 +2572,53 @@ Valid parameters PARAMS are (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) - (concat ostart "\n%s" oend "\n")) - ((eq (car list) 'unordered) - (concat ustart "\n%s" uend "\n")) - ((eq (car list) 'descriptive) - (concat dstart "\n%s" dend "\n")))) - rtn term defstart defend) - (while (setq sublist (pop list)) - (cond ((symbolp sublist) nil) - ((stringp sublist) - (when (string-match "^\\(.*\\)[ \t]+::" sublist) - (setq term (org-trim (format (concat dtstart "%s" dtend) - (match-string 1 sublist)))) - (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 sublist iend isep))) - (t (setq rtn (concat rtn ;; previous list - lsep ;; list separator - (org-list-to-generic sublist p) - lsep ;; list separator - ))))) - (format wrapper rtn)))) + (cboff (plist-get p :cboff)) + (export-item + (function + ;; Export an item ITEM of type TYPE. First string in item + ;; is treated in a special way as it can bring extra + ;; information that needs to be processed. + (lambda (item type) + (let ((fmt (if (eq type 'descriptive) + (concat (org-trim istart) "%s" ddend iend isep) + (concat istart "%s" iend isep))) + (first (car item))) + ;; Replace checkbox if any is found. + (cond + ((string-match "\\[CBON\\]" first) + (setq first (replace-match cbon t t first))) + ((string-match "\\[CBOFF\\]" first) + (setq first (replace-match cboff t t first))) + ((string-match "\\[-\\]" first) + (setq first (replace-match "$\\boxminus$" t t first)))) + ;; Insert descriptive term if TYPE is `descriptive'. + (when (and (eq type 'descriptive) + (string-match "^\\(.*\\)[ \t]+::" first)) + (setq first (concat + dtstart (org-trim (match-string 1 first)) dtend + ddstart (org-trim (substring first (match-end 0)))))) + (setcar item first) + (format fmt (mapconcat + (lambda (e) + (if (stringp e) e (funcall export-sublist e))) + item isep)))))) + (export-sublist + (function + ;; Export sublist SUB + (lambda (sub) + (let* ((type (car sub)) + (items (cdr sub)) + (fmt (cond + (splicep "%s") + ((eq type 'ordered) + (concat ostart "\n%s" oend)) + ((eq type 'descriptive) + (concat dstart "\n%s" dend)) + (t (concat ustart "\n%s" uend))))) + (format fmt (mapconcat + (lambda (e) (funcall export-item e type)) + items lsep))))))) + (concat (funcall export-sublist list) "\n"))) (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. @@ -2558,7 +2630,7 @@ with overruling parameters for `org-list-to-generic'." '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" :ustart "\\begin{itemize}" :uend "\\end{itemize}" :dstart "\\begin{description}" :dend "\\end{description}" - :dtstart "[" :dtend "]" + :dtstart "[" :dtend "] " :ddstart "" :ddend "" :istart "\\item " :iend "" :isep "\n" :lsep "\n" @@ -2591,8 +2663,8 @@ with overruling parameters for `org-list-to-generic'." (org-combine-plists '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" :ustart "@enumerate" :uend "@end enumerate" - :dstart "@table" :dend "@end table" - :dtstart "@item " :dtend "\n" + :dstart "@table @asis" :dend "@end table" + :dtstart " " :dtend "\n" :ddstart "" :ddend "" :istart "@item\n" :iend "" :isep "\n" :lsep "\n" From 9230df2e0de0b4082ad2fc4bf820c74ca86a8fed Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 17:58:58 +0100 Subject: [PATCH 039/107] org-list: rewrite of org-apply-on-list * lisp/org-list.el (org-apply-on-list): use new structures. Function is now applied in reverse order so modifications do not change positions of items in buffer. --- lisp/org-list.el | 19 +++++++++++-------- lisp/org-mouse.el | 9 ++++++--- 2 files changed, 17 insertions(+), 11 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2a73fea8c..4ab70a9e6 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2223,20 +2223,23 @@ 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. +FUNCTION is applied on items in reverse order. + 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." - (let* ((pos (copy-marker (point))) - (end (copy-marker (org-list-bottom-point))) - (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point)))) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (item (copy-marker (point-at-bol))) + (all (org-list-get-all-items (marker-position item) struct prevs)) (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) + (mapc (lambda (e) + (goto-char e) + (setq value (apply function value args))) + (nreverse all)) + (goto-char item) value)) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index ef0de24bd..b66043527 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -579,9 +579,12 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (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)))) + (let ((wrap-fun (lambda (c) (funcall funct))) + (item-beg (org-in-item-p))) + (when item-beg + (save-excursion + (goto-char item-beg) + (org-apply-on-list wrap-fun nil))))) (defun org-mouse-bolp () "Return true if there only spaces, tabs, and '*' before point. From 148deffd4e9573a4f6539ba04e0945f770739611 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 18:24:50 +0100 Subject: [PATCH 040/107] org-list: move error messages in interactive indent/outdent functions * list/org-list.el (org-list-indent-item-generic): remove error messages happening before process. This belongs to interactive functions. (org-indent-item,org-indent-item-tree, org-outdent-item,org-outdent-item-tree): ensure point or region is correct before computing list structure. Return an error message otherwise. --- lisp/org-list.el | 185 +++++++++++++++++++++++++---------------------- 1 file changed, 99 insertions(+), 86 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 4ab70a9e6..6cea2cd57 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -660,84 +660,76 @@ Return t if successful." (beginning-of-line) (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 at an item")) - (t - (let* ((top (org-list-get-top-point struct)) - (parents (org-list-struct-parent-alist struct)) - (prevs (org-list-struct-prev-alist struct)) - ;; Are we going to move the whole list? - (specialp (and (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree) - (= top (point))))) - ;; Determine begin and end points of zone to indent. If moving - ;; more than one item, save them for 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)) - (set-marker org-last-indent-end-marker - (cond - (specialp (org-list-get-bottom-point struct)) - (no-subtree (1+ (point))) - (t (org-list-get-item-end (point) struct)))))) - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker))) - (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 (org-list-get-ind beg struct)) - (old-struct (mapcar (lambda (e) (copy-alist e)) struct))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" - (org-list-get-bullet beg struct))) - (org-list-set-bullet beg struct - (org-list-bullet-string "-"))) - ;; Shift every item by OFFSET and fix bullets. Then - ;; apply changes to buffer. - (mapc (lambda (e) - (let ((ind (org-list-get-ind (car e) struct))) - (org-list-set-ind (car e) struct (+ ind offset)))) - struct) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-apply-struct struct old-struct)))) - ;; Forbidden move: - ((and (< arg 0) - ;; If only one item is moved, it mustn't have a child - (or (and no-subtree - (not regionp) - (org-list-has-child-p beg struct)) - ;; If a subtree or region is moved, the last item - ;; of the subtree mustn't have a child - (let ((last-item (caar - (reverse - (org-remove-if - (lambda (e) (>= (car e) end)) - struct))))) - (org-list-has-child-p last-item struct)))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((new-parents - (if (< arg 0) - (org-list-struct-outdent beg end struct parents) - (org-list-struct-indent beg end struct parents prevs)))) - (org-list-struct-fix-struct struct new-parents)) - (org-update-checkbox-count-maybe))))))))) + (rend (and regionp (region-end))) + (top (org-list-get-top-point struct)) + (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-struct-prev-alist struct)) + ;; Are we going to move the whole list? + (specialp (and (cdr (assq 'indent org-list-automatic-rules)) + (not no-subtree) + (= top (point))))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, save them for 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)) + (set-marker org-last-indent-end-marker + (cond + (specialp (org-list-get-bottom-point struct)) + (no-subtree (1+ (point))) + (t (org-list-get-item-end (point) struct)))))) + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker))) + (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 (org-list-get-ind beg struct)) + (old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" + (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct + (org-list-bullet-string "-"))) + ;; Shift every item by OFFSET and fix bullets. Then + ;; apply changes to buffer. + (mapc (lambda (e) + (let ((ind (org-list-get-ind (car e) struct))) + (org-list-set-ind (car e) struct (+ ind offset)))) + struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-apply-struct struct old-struct)))) + ;; Forbidden move: + ((and (< arg 0) + ;; If only one item is moved, it mustn't have a child + (or (and no-subtree + (not regionp) + (org-list-has-child-p beg struct)) + ;; If a subtree or region is moved, the last item + ;; of the subtree mustn't have a child + (let ((last-item (caar + (reverse + (org-remove-if + (lambda (e) (>= (car e) end)) + struct))))) + (org-list-has-child-p last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((new-parents + (if (< arg 0) + (org-list-struct-outdent beg end struct parents) + (org-list-struct-indent beg end struct parents prevs)))) + (org-list-struct-fix-struct struct new-parents)) + (org-update-checkbox-count-maybe)))))) t) ;;; Predicates @@ -1793,29 +1785,50 @@ Initial position of cursor is restored after the changes." "Outdent a local list item, but not its children. If a region is active, all items inside will be moved." (interactive) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic -1 t struct))) + (if (org-at-item-p) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 t struct)) + (error "Not at an item"))) (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) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic 1 t struct))) + (if (org-at-item-p) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 t struct)) + (error "Not at an item"))) (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) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic -1 nil struct))) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and (org-region-active-p) + (goto-char (region-beginning)) + (org-at-item-p))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) (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) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic 1 nil struct))) + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and (org-region-active-p) + (goto-char (region-beginning)) + (org-at-item-p))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) (defvar org-tab-ind-state) (defun org-cycle-item-indentation () From 2adbcfffe1b61aa36bd3ba20b9eb269513c32995 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 18:42:23 +0100 Subject: [PATCH 041/107] Remove uses of deprecated top-point and bottom-point functions * lisp/org.el (org-skip-over-state-notes,org-store-log-note): use new accessors. * list/ob.el (org-babel-result-end): use new accessors. * list/org-exp.el (org-export-mark-list-ending): use new accessors. --- lisp/ob.el | 7 +++++-- lisp/org-exp.el | 3 ++- lisp/org.el | 36 ++++++++++++++++++++---------------- 3 files changed, 27 insertions(+), 19 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 7dce47a42..f52fb6bb5 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -76,7 +76,8 @@ (declare-function org-in-item-p "org-list" ()) (declare-function org-list-parse-list "org-list" (&optional delete)) (declare-function org-list-to-generic "org-list" (LIST PARAMS)) -(declare-function org-list-bottom-point "org-list" ()) +(declare-function org-list-struct "org-list" ()) +(declare-function org-list-get-bottom-point "org-list" (struct)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -1582,7 +1583,9 @@ code ---- the results are extracted in the syntax of the source (save-excursion (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) - ((org-at-item-p) (- (org-list-bottom-point) 1)) + ((org-at-item-p) (save-excursion + (org-beginning-of-item) + (1- (org-list-get-bottom-point (org-list-struct))))) (t (let ((case-fold-search t) (blocks-re (regexp-opt diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 0e525e190..6cc27d4a4 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1678,7 +1678,8 @@ These special cookies will later be interpreted by the backend. (lambda (end-list-marker) (goto-char (point-min)) (while (org-search-forward-unenclosed org-item-beginning-re nil t) - (goto-char (org-list-bottom-point)) + (beginning-of-line) + (goto-char (org-list-get-bottom-point (org-list-struct))) (when (and (not (eq org-list-ending-method 'indent)) (looking-at (org-list-end-re))) (replace-match "\n")) diff --git a/lisp/org.el b/lisp/org.el index 39eb60e8f..d11721df6 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11819,11 +11819,13 @@ 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)) - (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))))))) + (let ((itemp (org-in-item-p))) + (when itemp + (let* ((struct (progn (goto-char itemp) (org-list-struct))) + (prevs (org-list-struct-prev-alist struct))) + (while (looking-at "[ \t]*- State") + (goto-char (or (org-list-get-next-item (point) struct prevs) + (org-list-get-item-end (point) struct)))))))) (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." @@ -11909,17 +11911,19 @@ EXTRA is additional text that will be inserted into the notes buffer." (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) (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)))))) + (let ((itemp (org-in-item-p))) + (if itemp + (progn + (goto-char itemp) + (org-list-get-ind + (org-list-get-top-point (org-list-struct)))) + (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)) From fa1ed96d0045a4736e5c8f75aae27c44ce6b219a Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 20:16:00 +0100 Subject: [PATCH 042/107] org-list: code comments and doc-strings improvements --- lisp/org-list.el | 113 +++++++++++++++++++++++++++++++++-------------- 1 file changed, 80 insertions(+), 33 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6cea2cd57..8188861e6 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -29,6 +29,32 @@ ;; This file contains the code dealing with plain lists in Org-mode. +;; The fundamental idea behind lists work is to use structures. A +;; structure is a snapshot of the list, in the shape of data tree (see +;; `org-list-struct'). + +;; Once the list structure is stored, it is possible to make changes +;; directly on it or get useful information on the list, with helper +;; functions `org-list-struct-parent-alist' and +;; `org-list-struct-prev-alist', and using accessors provided in the +;; file. + +;; Structure is repaired with `org-list-struct-fix-struct'. Then +;; changes are applied to buffer with `org-list-struct-apply-struct'. + +;; So any function working on plain lists should follow this template: +;; 1. Verify point is in a list and grab item beginning (with the same +;; function `org-in-item-p') ; +;; 2. Get list structure ; +;; 3. Compute one, or both, helper functions depending on required +;; accessors ; +;; 4. Proceed with the modifications ; +;; 5. Then fix the structure one last time and apply it on buffer. + +;; It is usally a bad idea to use directly an interactive function +;; inside a function, as those read the whole list structure another +;; time. + ;;; Code: (eval-when-compile @@ -169,12 +195,11 @@ 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 determine what will end lists. This is -the fastest method. +`org-list-end-regexp', to determine what will end lists. 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. +the first item of the list. When set to `both', each of the preceding methods is applied to determine lists endings. This is the default method." @@ -323,7 +348,7 @@ Context is determined by reading `org-context' text property if applicable, or looking at Org syntax around. Context will be an alist like (MIN MAX CONTEXT) where MIN and MAX -are boundaries and CONTEXT is a symbol among `nil', `drawer', +are boundaries and CONTEXT is a symbol among nil, `drawer', `block', `invalid' and `inlinetask'. Symbols `block' and `invalid' refer to `org-list-blocks'." @@ -463,7 +488,9 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in (defun org-list-separating-blank-lines-number (pos struct prevs) "Return number of blank lines that should separate items in list. -POS is the position at item beginning to be considered. +POS is the position at item beginning to be considered. STRUCT is +the list structure. PREVS is the alist of previous items. See +`org-list-struct-prev-alist'. Assume point is at item's beginning. If the item is alone, apply some heuristics to guess the result." @@ -655,7 +682,7 @@ 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." +STRUCT is the list structure. Return t if successful." (save-excursion (beginning-of-line) (let* ((regionp (org-region-active-p)) @@ -735,7 +762,7 @@ Return t if successful." ;;; Predicates (defun org-in-item-p () - "Is the cursor inside a plain list? + "Return item beginning position when in a plain list, nil otherwise. This checks `org-list-ending-method'." (save-excursion (beginning-of-line) @@ -1027,16 +1054,6 @@ item is invisible." ;;; 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, using `org-list-struct'. - -;; 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 () "Return structure of list at point. @@ -1048,6 +1065,23 @@ values are: 4. checkbox, if any, 5. position at item end. +Thus the following list, where numbers in parens are +point-at-bol: + +- [X] first item (1) + 1. sub-item 1 (18) + 5. [@5] sub-item 2 (34) + some other text belonging to first item (55) +- last item (97) + (109) + +will get the following structure: + +\(\(1 0 \"- \" nil [X] 92) + \(18 2 \"1. \" nil nil 34\) + \(34 2 \"5. \" \"5\" nil 55\) + \(97 0 \"- \" nil nil 109\)\) + Assume point is at an item." (save-excursion (beginning-of-line) @@ -1289,7 +1323,7 @@ PARENTS is the alist of items' parent. See (defun org-list-has-child-p (item struct) "Return a non-nil value if ITEM in STRUCT has a child. -The value returned is the position of the first child of ITEM." +Value returned is the position of the first child of ITEM." (let ((ind (org-list-get-ind item struct)) (child-maybe (car (nth 1 (member (assq item struct) struct))))) (when (and child-maybe @@ -1310,8 +1344,7 @@ PREVS is the alist of previous items. See (defun org-list-get-subtree (item struct) "Return all items with ITEM as a common ancestor or nil. -PREVS is the alist of previous items. See -`org-list-struct-prev-alist'." +STRUCT is the list structure considered." (let* ((item-end (org-list-get-item-end item struct)) (sub-struct (cdr (member (assq item struct) struct))) subtree) @@ -1420,7 +1453,7 @@ previous items. See `org-list-struct-prev-alist'." (org-list-get-nth 5 item struct)) (defun org-list-get-item-end-before-blank (item struct) - "Return point at end of item, before any blank line. + "Return point at end of ITEM in STRUCT, before any blank line. Point returned is at end of line." (save-excursion (goto-char (org-list-get-item-end item struct)) @@ -1429,7 +1462,10 @@ Point returned is at end of line." (defun org-list-struct-fix-bul (struct prevs) "Verify and correct bullets for every association in STRUCT. -\nThis function modifies STRUCT." +PREVS is the alist of previous items. See +`org-list-struct-prev-alist'. + +This function modifies STRUCT." (let ((fix-bul (function (lambda (item) @@ -1455,6 +1491,9 @@ Point returned is at end of line." (defun org-list-struct-fix-ind (struct parents &optional bullet-size) "Verify and correct indentation for every association in STRUCT. +PARENTS is the alist of items' parents. See +`org-list-struct-parent-alist'. + If numeric optional argument BULLET-SIZE is set, assume all bullets in list have this length to determine new indentation. @@ -1478,10 +1517,14 @@ This function modifies STRUCT." (defun org-list-struct-fix-box (struct parents prevs &optional ordered) "Verify and correct checkboxes for every association in STRUCT. +PARENTS is the alist of items' parents. See +`org-list-struct-parent-alist'. PREVS is the alist of previous +items. See `org-list-struct-prev-alist. + If ORDERED is non-nil, a checkbox can only be checked when every checkbox before it is checked too. If there was an attempt to break this rule, the function will return the blocking item. In -all others cases, the return value will be `nil'. +all others cases, the return value will be nil. This function modifies STRUCT." (let ((all-items (mapcar 'car struct)) @@ -1534,7 +1577,9 @@ This function modifies STRUCT." (nth index all-items))))))) (defun org-list-struct-fix-struct (struct parents) - "Return STRUCT with correct bullets and indentation." + "Return STRUCT with correct bullets and indentation. +PARENTS is the alist of items' parents. See +`org-list-struct-parent-alist'." ;; Order of functions matters here: checkboxes and endings need ;; correct indentation to be set, and indentation needs correct ;; bullets. @@ -1581,9 +1626,12 @@ This function modifies STRUCT." (org-list-struct-apply-struct struct old-struct))) (defun org-list-struct-outdent (start end struct parents) - "Outdent items in a structure. -Items are indented when their key is between START, included, and -END, excluded. STRUCT is the concerned structure." + "Outdent items between START and END in structure STRUCT. + +PARENTS is the alist of items' parents. See +`org-list-struct-parent-alist'. + +START is included, END excluded." (let* (acc (out (lambda (cell) (let* ((item (car cell)) @@ -1610,17 +1658,16 @@ END, excluded. STRUCT is the concerned structure." (mapcar out parents))) (defun org-list-struct-indent (start end struct parents prevs) - "Indent items in a structure. -Items are indented when their key is between START, included, and -END, excluded. + "Indent items between START and END in structure STRUCT. PARENTS is the alist of parents. See `org-list-struct-parent-alist'. PREVS is the alist of previous items. See `org-list-struct-prev-alist'. -STRUCT is the concerned structure. It may be modified if -`org-list-demote-modify-bullet' matches bullets between START and -END." +START is included and END excluded. + +STRUCT may be modified if `org-list-demote-modify-bullet' matches +bullets between START and END." (let* (acc (set-assoc (lambda (cell) (setq acc (cons cell acc)) cell)) (change-bullet-maybe From 6c81e8cc059a99c0464b517ae2263330c3169c43 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 29 Dec 2010 23:16:37 +0100 Subject: [PATCH 043/107] Move org-get-string-indentation out of org-list.el * lisp/org.el (org-get-string-indentation): moved in generally useful functions section, as it wasn't specific to plain lists and that no code was using it in org-list.el. --- lisp/org-list.el | 11 ----------- lisp/org.el | 11 +++++++++++ 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 8188861e6..2c09555da 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1817,17 +1817,6 @@ Initial position of cursor is restored after the changes." ;;; 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)) - (defun org-outdent-item () "Outdent a local list item, but not its children. If a region is active, all items inside will be moved." diff --git a/lisp/org.el b/lisp/org.el index d11721df6..42b49159d 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18191,6 +18191,17 @@ When LINE is given, assume it represents a line and compute its indentation." (skip-chars-forward " \t") (current-column)))) +(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-remove-tabs (s &optional width) "Replace tabulators in S with spaces. Assumes that s is a single line, starting in column 0." From 0f589a33b22876b4fd118d688cf0abeed42a70fd Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 30 Dec 2010 18:39:36 +0100 Subject: [PATCH 044/107] org-list: added description tag as data in structures --- lisp/org-list.el | 105 +++++++++++++++++++++++++---------------------- 1 file changed, 56 insertions(+), 49 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2c09555da..3fb79b33f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -333,13 +333,15 @@ of `org-plain-list-ordered-item-terminator'." "Regexp matching the beginning of a plain list item.") (defconst org-list-full-item-re - (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" + (concat "^[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?") + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?") "Matches a list item and puts everything into groups: -group 1: the bullet -group 2: the counter -group 3: the checkbox") +group 1: bullet +group 2: counter +group 3: checkbox +group 4: description tag") (defun org-list-context () "Determine context, and its boundaries, around point. @@ -573,8 +575,7 @@ function ends." (prevs (org-list-struct-prev-alist struct)) (item-end (org-list-get-item-end item struct)) (item-end-no-blank (org-list-get-item-end-before-blank item struct)) - (beforep (and (or (org-at-item-description-p) - (looking-at org-list-full-item-re)) + (beforep (and (looking-at org-list-full-item-re) (<= pos (match-end 0)))) (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) (blank-nb (org-list-separating-blank-lines-number @@ -613,19 +614,19 @@ function ends." ;; 5. Add new item to STRUCT. (mapc (lambda (e) (let ((p (car e)) - (end (nth 5 e))) + (end (nth 6 e))) (cond ;; Before inserted item, positions don't change but ;; an item ending after insertion has its end shifted ;; by SIZE-OFFSET. ((< p item) - (when (> end item) (setcar (nthcdr 5 e) (+ end size-offset)))) + (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) ;; Trivial cases where current item isn't split in ;; two. Just shift every item after new one by ;; ITEM-SIZE. ((or beforep (not split-line-p)) (setcar e (+ p item-size)) - (setcar (nthcdr 5 e) (+ end item-size))) + (setcar (nthcdr 6 e) (+ end item-size))) ;; Item is split in two: elements before POS are just ;; shifted by ITEM-SIZE. In the case item would end ;; after split POS, ending is only shifted by @@ -633,22 +634,22 @@ function ends." ((< p pos) (setcar e (+ p item-size)) (if (< end pos) - (setcar (nthcdr 5 e) (+ end item-size)) - (setcar (nthcdr 5 e) (+ end size-offset)))) + (setcar (nthcdr 6 e) (+ end item-size)) + (setcar (nthcdr 6 e) (+ end size-offset)))) ;; Elements after POS are moved into new item. Length ;; of ITEM-SEP has to be removed as ITEM-SEP ;; doesn't appear in buffer yet. ((< p item-end) (setcar e (+ p size-offset (- item pos (length item-sep)))) (if (= end item-end) - (setcar (nthcdr 5 e) (+ item item-size)) - (setcar (nthcdr 5 e) + (setcar (nthcdr 6 e) (+ item item-size)) + (setcar (nthcdr 6 e) (+ end size-offset (- item pos (length item-sep)))))) ;; Elements at ITEM-END or after are only shifted by ;; SIZE-OFFSET. (t (setcar e (+ p size-offset)) - (setcar (nthcdr 5 e) (+ end size-offset)))))) + (setcar (nthcdr 6 e) (+ end size-offset)))))) struct) (setq struct (sort (cons (list item ind bullet nil box (+ item item-size)) @@ -664,8 +665,7 @@ function ends." item struct (org-list-struct-prev-alist struct)))) (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) (when checkbox (org-update-checkbox-count-maybe)) - (or (org-at-item-description-p) - (looking-at org-list-full-item-re)) + (looking-at org-list-full-item-re) (goto-char (match-end 0)) t))) @@ -943,22 +943,22 @@ This function modifies STRUCT." (cond ((< pos beg-A)) ((memq pos sub-A) - (let ((end-e (nth 5 e))) + (let ((end-e (nth 6 e))) (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) - (setcar (nthcdr 5 e) + (setcar (nthcdr 6 e) (+ end-e (- end-B-no-blank end-A-no-blank))) - (when (= end-e end-A) (setcar (nthcdr 5 e) end-B)))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) ((memq pos sub-B) - (let ((end-e (nth 5 e))) + (let ((end-e (nth 6 e))) (setcar e (- (+ pos beg-A) beg-B)) - (setcar (nthcdr 5 e) (+ end-e (- beg-A beg-B))) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) (when (= end-e end-B) - (setcar (nthcdr 5 e) + (setcar (nthcdr 6 e) (+ beg-A size-B (- end-A end-A-no-blank)))))) ((< pos beg-B) - (let ((end-e (nth 5 e))) + (let ((end-e (nth 6 e))) (setcar e (+ pos (- size-B size-A))) - (setcar (nthcdr 5 e) (+ end-e (- size-B size-A)))))))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) struct) (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) @@ -1063,7 +1063,8 @@ values are: 2. bullet with trailing whitespace, 3. bullet counter, if any, 4. checkbox, if any, -5. position at item end. +5. position at item end, +6. description tag, if any. Thus the following list, where numbers in parens are point-at-bol: @@ -1073,14 +1074,16 @@ point-at-bol: 5. [@5] sub-item 2 (34) some other text belonging to first item (55) - last item (97) - (109) + + tag :: description (109) + (131) will get the following structure: -\(\(1 0 \"- \" nil [X] 92) - \(18 2 \"1. \" nil nil 34\) - \(34 2 \"5. \" \"5\" nil 55\) - \(97 0 \"- \" nil nil 109\)\) +\(\(1 0 \"- \" nil [X] nil 97) + \(18 2 \"1. \" nil nil nil 34\) + \(34 2 \"5. \" \"5\" nil nil 55\) + \(97 0 \"- \" nil nil nil 131\) + \(109 2 \"+ \" nil nil \"tag\" 131\) Assume point is at an item." (save-excursion @@ -1106,9 +1109,10 @@ Assume point is at an item." (looking-at org-list-full-item-re) (list (point) ind - (match-string-no-properties 1) ; bullet - (match-string-no-properties 2) ; counter - (match-string-no-properties 3))))) ; checkbox + (match-string-no-properties 1) ; bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + (match-string-no-properties 4))))) ; description tag (end-before-blank ;; Ensure list ends at the first blank line. (function @@ -1276,7 +1280,7 @@ This function modifies STRUCT." (while (or (<= (cdar endings) pos)) (pop endings)) ;; add end position to item assoc - (let ((old-end (nthcdr 5 elt)) + (let ((old-end (nthcdr 6 elt)) (new-end (assoc-default ind endings '<=))) (if old-end (setcar old-end new-end) @@ -1285,7 +1289,7 @@ This function modifies STRUCT." (defun org-list-struct-prev-alist (struct) "Return alist between item and previous item in STRUCT." - (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 5 e))) + (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e))) struct))) (mapcar (lambda (e) (let ((prev (car (rassq (car e) item-end-alist)))) @@ -1448,10 +1452,14 @@ previous items. See `org-list-struct-prev-alist'." \nThis function modifies STRUCT." (org-list-set-nth 4 item struct checkbox)) -(defun org-list-get-item-end (item struct) +(defun org-list-get-tag (item struct) "Return end position of ITEM in STRUCT." (org-list-get-nth 5 item struct)) +(defun org-list-get-item-end (item struct) + "Return end position of ITEM in STRUCT." + (org-list-get-nth 6 item struct)) + (defun org-list-get-item-end-before-blank (item struct) "Return point at end of ITEM in STRUCT, before any blank line. Point returned is at end of line." @@ -1879,10 +1887,9 @@ Return t at each successful move." (struct (org-list-struct)) (ind (org-list-get-ind (point-at-bol) struct))) ;; Check that item is really empty - (when (and (or (org-at-item-description-p) - (save-excursion - (beginning-of-line) - (looking-at org-list-full-item-re))) + (when (and (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re)) (>= (match-end 0) (save-excursion (goto-char (org-list-get-item-end (point-at-bol) struct)) @@ -2422,19 +2429,19 @@ Point is left at list end." out (get-list-type (function - ;; determine type of list by looking at item at POS. - (lambda (pos) - (save-excursion - (goto-char pos) - (cond ((org-looking-at-p "^[ \t]*[0-9]") 'ordered) - ((org-at-item-description-p) 'descriptive) - (t 'unordered)))))) + ;; determine type of list by getting info on item POS in + ;; STRUCT. + (lambda (pos struct) + (cond ((string-match "[0-9]" (org-list-get-bullet pos struct)) + 'ordered) + ((org-list-get-tag pos struct) 'descriptive) + (t 'unordered))))) (parse-sublist (function ;; return a list whose car is list type and cdr a list of ;; items' body. (lambda (e) - (cons (funcall get-list-type (car e)) + (cons (funcall get-list-type (car e) struct) (mapcar parse-item e))))) (parse-item (function From bf1776b494422bcc29eb2173f04bbd570ba395b9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 30 Dec 2010 18:41:19 +0100 Subject: [PATCH 045/107] org-list: added new accessors * lisp/org-list.el (org-list-get-first-item): new alias for org-list-get-list-begin (org-list-get-last-item): new function (org-list-get-list-end): use org-list-get-last-item --- 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 3fb79b33f..d99811b55 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1403,14 +1403,22 @@ previous items. See `org-list-struct-prev-alist'." (setq first-item prev-item)) first-item)) -(defun org-list-get-list-end (item struct prevs) - "Return point at end of sub-list ITEM belongs. +(defalias 'org-list-get-first-item 'org-list-get-list-begin) + +(defun org-list-get-last-item (item struct prevs) + "Return point at last item of sub-list ITEM belongs. STRUCT is the structure of the list. PREVS is the alist of previous items. See `org-list-struct-prev-alist'." (let ((last-item item) next-item) (while (setq next-item (org-list-get-next-item last-item struct prevs)) (setq last-item next-item)) - (org-list-get-item-end last-item struct))) + last-item)) + +(defun org-list-get-list-end (item struct prevs) + "Return point at end of sub-list ITEM belongs. +STRUCT is the structure of the list. PREVS is the alist of +previous items. See `org-list-struct-prev-alist'." + (org-list-get-item-end (org-list-get-list-last item struct prevs) struct)) (defun org-list-get-nth (n key struct) "Return the Nth value of KEY in STRUCT." From 69e02a73de7423bafa4df473cb746865c305b7ae Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 2 Jan 2011 13:52:16 +0100 Subject: [PATCH 046/107] Modified export engines for lists * lisp/org-exp.el (org-export-mark-lists): new function, replacing org-export-mark-list-ending. It adds information as text properties to every list, before changes done by exporter destruct them. * lisp/org-html.el (org-export-as-html): delegate list handling to external function org-html-export-list-line. (org-html-export-list-line): new function. * lisp/org-latex.el (org-export-latex-lists): small modification. --- lisp/org-docbook.el | 203 ++++++++++++++++++++------------------------ lisp/org-exp.el | 90 +++++++++++++------- lisp/org-html.el | 183 ++++++++++++++++++++------------------- lisp/org-latex.el | 56 ++++++++---- lisp/org-list.el | 9 +- 5 files changed, 297 insertions(+), 244 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 7412315ea..ac3d7f103 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -499,9 +499,6 @@ publishing directory." (inquote nil) (infixed nil) (inverse nil) - (in-local-list nil) - (local-list-type nil) - (local-list-indent nil) (llt org-plain-list-ordered-item-terminator) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) @@ -671,22 +668,6 @@ publishing directory." (org-export-docbook-open-para)) (throw 'nextline nil)) - ;; 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") "\n") - ((equal listtype "u") "\n") - ((equal listtype "d") "\n")))) - (pop local-list-type)) - ;; We did close a list, normal text follows: need - (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) (let (par (ind (get-text-property 0 'original-indentation line))) @@ -1008,93 +989,15 @@ publishing directory." (org-format-table-html table-buffer table-orig-buffer 'no-css))))) + ;; Normal lines (t - ;; Normal lines - (when (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line) - (setq ind (or (get-text-property 0 'original-indentation line) - (org-get-string-indentation line)) - item-type (if (match-beginning 4) "o" "u") - starter (if (match-beginning 2) - (substring (match-string 2 line) 0 -1)) - line (substring line (match-beginning 5)) - item-tag nil - item-number nil) - (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)) - (setq item-type "d" - item-tag (match-string 1 line) - line (substring line (match-end 0)))) - (cond - ((and starter - (or (not in-local-list) - (> ind (car local-list-indent)))) - ;; Start new (level of) list - (org-export-docbook-close-para-maybe) - (insert (cond - ((equal item-type "u") "\n\n") - ((and (equal item-type "o") item-number) - ;; Check for a specific start number. If it - ;; is specified, we use the ``override'' - ;; attribute of element to pass the - ;; info to DocBook. We could also use the - ;; ``startingnumber'' attribute of element - ;; , but the former works on both - ;; DocBook 5.0 and prior versions. - (format "\n\n" item-number)) - ((equal item-type "o") "\n\n") - ((equal item-type "d") - (format "\n%s\n" item-tag)))) - ;; For DocBook, we need to open a para right after tag - ;; . - (org-export-docbook-open-para) - (push item-type local-list-type) - (push ind local-list-indent) - (setq in-local-list t)) - ;; Continue current list - (starter - ;; 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) - (insert (cond - ((equal listtype "o") "\n") - ((equal listtype "u") "\n") - ((equal listtype "d") "\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 - ((and (equal listtype "o") item-number) - (format "" item-number)) - ((equal listtype "o") "") - ((equal listtype "u") "") - ((equal listtype "d") (format - "%s" - (or item-tag - "???")))))) - ;; For DocBook, we need to open a para right after tag - ;; . - (org-export-docbook-open-para))) - ;; Checkboxes. - (if (string-match "^[ \t]*\\(\\[[X -]\\]\\)" line) - (setq line - (replace-match (concat checkbox-start - (match-string 1 line) - checkbox-end) - t t line)))) + ;; This line either is list item or end a list. + (when (when (get-text-property 0 'list-item line) + (setq line (org-export-docbook-list-line + line + (get-text-property 0 'list-item line) + (get-text-property 0 'list-struct line) + (get-text-property 0 'list-prevs line))))) ;; Empty lines start a new paragraph. If hand-formatted lists ;; are not fully interpreted, lines starting with "-", "+", "*" @@ -1193,10 +1096,6 @@ publishing directory." (insert "\n") (insert "\n"))) -(defvar in-local-list) -(defvar local-list-indent) -(defvar local-list-type) - (defun org-export-docbook-level-start (level title) "Insert a new level in DocBook export. When TITLE is nil, just close all open levels." @@ -1438,6 +1337,92 @@ that need to be preserved in later phase of DocBook exporting." line (substring line (match-end 0)))) (concat replaced line))) +(defun org-export-docbook-list-line (line pos struct prevs) + "Insert list syntax in export buffer. Return LINE, maybe modified. + +POS is the item position or line position the line had before +modifications to buffer. STRUCT is the list structure. PREVS is +the alist of previous items." + (let* ((get-type + (function + ;; Return type of list containing element POS, among + ;; "ordered", "variable" or "itemized". + (lambda (pos) + (cond + ((string-match "[0-9]" (org-list-get-bullet pos struct)) + "ordered") + ((org-list-get-tag pos struct) "variable") + (t "itemized"))))) + (get-closings + (function + ;; Return list of all items and sublists ending at POS, in + ;; reverse order. + (lambda (pos) + (let (out) + (catch 'exit + (mapc (lambda (e) + (let ((end (nth 6 e)) + (item (car e))) + (cond + ((= end pos) (push item out)) + ((>= item pos) (throw 'exit nil))))) + struct)) + out))))) + ;; First close any previous item, or list, ending at POS. + (mapc (lambda (e) + (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) + (first-item (org-list-get-list-begin e struct prevs)) + (type (funcall get-type first-item))) + ;; Ending for every item + (org-export-docbook-close-para-maybe) + (insert (if (equal type "variable") + "\n" + "\n")) + ;; We're ending last item of the list: end list. + (when lastp (insert (format "\n" type))))) + (funcall get-closings pos)) + (cond + ;; At an item: insert appropriate tags in export buffer. + ((assq pos struct) + (string-match + (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?" + "\\(.*\\)") line) + (let* ((counter (match-string 2 line)) + (checkbox (match-string 3 line)) + (desc-tag (or (match-string 4 line) "???")) + (body (match-string 5 line)) + (list-beg (org-list-get-list-begin pos struct prevs)) + (firstp (= list-beg pos)) + ;; Always refer to first item to determine list type, in + ;; case list is ill-formed. + (type (funcall get-type list-beg))) + ;; When FIRSTP, a new list or sub-list is starting. + (when firstp + (org-export-docbook-close-para-maybe) + (insert (format "<%slist>\n" type))) + (insert (cond + ((equal type "variable") + (format "%s" desc-tag)) + ((and (equal type "ordered") counter) + (format "" counter)) + (t ""))) + ;; For DocBook, we need to open a para right after tag + ;; . + (org-export-docbook-open-para) + ;; If line had a checkbox, some additional modification is required. + (when checkbox (setq body (concat checkbox " " body))) + ;; Return modified line + body)) + ;; At a list ender: normal text follows: need . + ((equal "ORG-LIST-END" line) + (org-export-docbook-open-para) + (throw 'nextline nil)) + ;; Not at an item: return line unchanged (side-effects only). + (t line)))) + (provide 'org-docbook) ;; arch-tag: a24a127c-d365-4c2a-9e9b-f7dcb0ebfdc3 diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 6cc27d4a4..b5715e3a8 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1089,8 +1089,8 @@ 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) + ;; Mark lists + (org-export-mark-lists backend) ;; Export code blocks (org-export-blocks-preprocess) @@ -1670,34 +1670,66 @@ 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. +(defun org-export-mark-lists (backend) + "Mark list with special properties. +These special properties will later be interpreted by the backend. `org-list-end-re' is replaced by a blank line in the process." - (let ((process-buffer - (lambda (end-list-marker) - (goto-char (point-min)) - (while (org-search-forward-unenclosed org-item-beginning-re nil t) - (beginning-of-line) - (goto-char (org-list-get-bottom-point (org-list-struct))) - (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) - (replace-match "\n")) - (unless (bolp) (insert "\n")) - (unless (looking-at end-list-marker) - (insert end-list-marker)) - (unless (eolp) (insert "\n")))))) - ;; 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 ""))))) + (let ((mark-list + (function + ;; Mark a list with 3 properties: `list-item' which is + ;; position at beginning of line, `list-struct' which is + ;; list structure, and `list-prevs' which is the alist of + ;; item and its predecessor. Leave point at list ending. + (lambda (ctxt) + (let* ((struct (org-list-struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + (prevs (org-list-struct-prev-alist struct)) + poi) + ;; Get every item and ending position, without dups and + ;; without bottom point of list. + (mapc (lambda (e) + (let ((pos (car e)) + (end (nth 6 e))) + (unless (memq pos poi) + (push pos poi)) + (unless (or (= end bottom) (memq end poi)) + (push end poi)))) + struct) + (setq poi (sort poi '<)) + ;; For every point of interest, mark the whole line with + ;; its position in list. + (mapc + (lambda (e) + (goto-char e) + (add-text-properties (point-at-bol) (point-at-eol) + (list 'list-item (point-at-bol) + 'list-struct struct + 'list-prevs prevs))) + poi) + ;; Take care of bottom point. As it is probably at an + ;; empty line, insert a virtual ending with required + ;; property. + (goto-char bottom) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "")) + (unless (bolp) (insert "\n")) + (insert + (org-add-props "ORG-LIST-END\n" (list 'list-item bottom + 'list-struct struct + 'list-prevs prevs))) + ;; Add `list-context' as text property between top and + ;; bottom. + (add-text-properties top (point) (list 'list-context ctxt))))))) + ;; Mark lists except for backends not interpreting them. + (unless (eq backend 'ascii) + (mapc + (lambda (e) + (goto-char (point-min)) + (while (re-search-forward org-item-beginning-re nil t) + (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e)))) + '(nil block))))) (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-html.el b/lisp/org-html.el index 23e1316c5..7ed3f2ada 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1116,9 +1116,6 @@ PUB-DIR is set, use this as the publishing directory." (inquote nil) (infixed nil) (inverse nil) - (in-local-list nil) - (local-list-type nil) - (local-list-indent nil) (llt org-plain-list-ordered-item-terminator) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) @@ -1177,8 +1174,9 @@ PUB-DIR is set, use this as the publishing directory." "")) table-open table-buffer table-orig-buffer - ind item-type starter - snumber item-tag item-number + ind + rpl path attr desc descp desc1 desc2 link + snumber fnc footnotes footref-seen href ) @@ -1404,17 +1402,6 @@ lang=\"%s\" xml:lang=\"%s\"> (org-open-par)) (throw 'nextline nil)) - ;; Explicit list closure - (when (equal "ORG-LIST-END" line) - (while local-list-indent - (org-close-li (car local-list-type)) - (insert (format "\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 (and (get-text-property 0 'org-protected line) ;; Make sure it is the entire line that is protected @@ -1595,72 +1582,17 @@ lang=\"%s\" xml:lang=\"%s\"> table-orig-buffer (nreverse table-orig-buffer)) (org-close-par-maybe) (insert (org-format-table-html table-buffer table-orig-buffer)))) + + ;; Normal lines + (t - ;; Normal lines - (when (string-match - (cond - ((eq llt t) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+[.)]\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?.) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+\\.\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - ((= llt ?\)) "^\\([ \t]*\\)\\(\\([-+*] \\)\\|\\([0-9]+)\\) \\)?\\( *[^ \t\n\r]\\|[ \t]*$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))) - line) - (setq ind (or (get-text-property 0 'original-indentation line) - (org-get-string-indentation line)) - item-type (if (match-beginning 4) "o" "u") - starter (if (match-beginning 2) - (substring (match-string 2 line) 0 -1)) - line (substring line (match-beginning 5)) - item-number nil - item-tag nil) - (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)) - (setq item-type "d" - item-tag (match-string 1 line) - line (substring line (match-end 0)))) - (cond - ((and starter - (or (not in-local-list) - (> ind (car local-list-indent)))) - ;; Start new (level of) list - (org-close-par-maybe) - (insert (cond - ((equal item-type "u") "
    \n
  • \n") - ((and (equal item-type "o") item-number) - (format "
      \n
    1. \n" item-number)) - ((equal item-type "o") "
        \n
      1. \n") - ((equal item-type "d") - (format "
        \n
        %s
        \n" item-tag)))) - (push item-type local-list-type) - (push ind local-list-indent) - (setq in-local-list t)) - ;; Continue list - (starter - ;; 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 "\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") - (format "
        %s
        \n" (or item-tag "???"))) - ((and (equal item-type "o") item-number) - (format "
      2. \n" item-number)) - (t "
      3. \n"))))) - (if (string-match "^[ \t]*\\[\\([X ]\\)\\]" line) - (setq line - (replace-match - (if (equal (match-string 1 line) "X") - "[X]" - "[X]") - t t line)))) + ;; This line either is list item or end a list. + (when (get-text-property 0 'list-item line) + (setq line (org-html-export-list-line + line + (get-text-property 0 'list-item line) + (get-text-property 0 'list-struct line) + (get-text-property 0 'list-prevs line)))) ;; Horizontal line (when (string-match "^[ \t]*-\\{5,\\}[ \t]*$" line) @@ -2350,10 +2282,6 @@ If there are links in the string, don't modify these." (org-close-par-maybe) (insert (if (equal type "d") "
        4. \n" "
        4. \n"))) -(defvar in-local-list) -(defvar local-list-indent) -(defvar local-list-type) - (defvar body-only) ; dynamically scoped into this. (defun org-html-level-start (level title umax with-toc head-count) "Insert a new level in HTML export. @@ -2459,6 +2387,91 @@ Replaces invalid characters with \"_\" and then prepends a prefix." (org-close-li) (insert "
\n"))) +(defun org-html-export-list-line (line pos struct prevs) + "Insert list syntax in export buffer. Return LINE, maybe modified. + +POS is the item position or line position the line had before +modifications to buffer. STRUCT is the list structure. PREVS is +the alist of previous items." + (let* ((get-type + (function + ;; Return type of list containing element POS, among "d", + ;; "o" or "u". + (lambda (pos) + (cond + ((string-match "[0-9]" (org-list-get-bullet pos struct)) "o") + ((org-list-get-tag pos struct) "d") + (t "u"))))) + (get-closings + (function + ;; Return list of all items and sublists ending at POS, in + ;; reverse order. + (lambda (pos) + (let (out) + (catch 'exit + (mapc (lambda (e) + (let ((end (nth 6 e)) + (item (car e))) + (cond + ((= end pos) (push item out)) + ((>= item pos) (throw 'exit nil))))) + struct)) + out))))) + ;; First close any previous item, or list, ending at POS. + (mapc (lambda (e) + (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) + (first-item (org-list-get-list-begin e struct prevs)) + (type (funcall get-type first-item))) + (org-close-par-maybe) + ;; Ending for every item + (org-close-li type) + ;; We're ending last item of the list: end list. + (when lastp (insert (format "\n" type))))) + (funcall get-closings pos)) + (cond + ;; At an item: insert appropriate tags in export buffer. + ((assq pos struct) + (string-match + (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?" + "\\(.*\\)") line) + (let* ((counter (match-string 2 line)) + (checkbox (match-string 3 line)) + (desc-tag (or (match-string 4 line) "???")) + (body (match-string 5 line)) + (list-beg (org-list-get-list-begin pos struct prevs)) + (firstp (= list-beg pos)) + ;; Always refer to first item to determine list type, in + ;; case list is ill-formed. + (type (funcall get-type list-beg))) + (when firstp + (org-close-par-maybe) + (insert (format "<%sl>\n" type))) + (insert (cond + ((equal type "d") + (format "
%s
\n" desc-tag)) + ((and (equal type "o") counter) + (format "
  • \n" counter)) + (t "
  • \n"))) + ;; If line had a checkbox, some additional modification is required. + (when checkbox + (setq body + (concat + (cond + ((string-match "X" checkbox) "[X] ") + ((string-match " " checkbox) + "[X] ") + (t "[-] ")) + body))) + ;; Return modified line + body)) + ;; At a list ender: go to next line (side-effects only). + ((equal "ORG-LIST-END" line) (throw 'nextline nil)) + ;; Not at an item: return line unchanged (side-effects only). + (t line)))) + (provide 'org-html) ;; arch-tag: 8109d84d-eb8f-460b-b1a8-f45f3a6c7ea1 diff --git a/lisp/org-latex.el b/lisp/org-latex.el index f803737c6..10d41a1e3 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2460,22 +2460,46 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (defun org-export-latex-lists () "Convert plain text lists in current buffer into LaTeX lists." - (let (res) - (goto-char (point-min)) - (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)) - (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)))) + (mapc + (lambda (e) + ;; For each type of context allowed for list export (E), find + ;; every list, parse it, delete it and insert resulting + ;; conversion to latex (RES). + (let (res) + (goto-char (point-min)) + (while (re-search-forward org-item-beginning-re nil t) + (when (eq (get-text-property (point) 'list-context) e) + (beginning-of-line) + (setq res + (org-list-to-latex + ;; Narrowing is needed because we're converting + ;; inner functions to outer ones. + (save-restriction + (narrow-to-region (point) (point-max)) + ;; `org-list-end-re' output has changed since + ;; preprocess from org-exp.el. Tell it to + ;; `org-list-parse-list'. + (flet ((org-list-end-re nil "^ORG-LIST-END\n")) + (org-list-parse-list t))) + org-export-latex-list-parameters)) + ;; Replace any counter with its latex expression in output + ;; string. + (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))) + ;; Extend previous value of original-indentation to the whole + ;; string + (insert (org-add-props res nil 'original-indentation + (org-find-text-property-in-string + 'original-indentation res))))))) + '(block nil))) (defconst org-latex-entities '("\\!" diff --git a/lisp/org-list.el b/lisp/org-list.el index d99811b55..4e4c87f08 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2494,13 +2494,12 @@ Point is left at list end." ;; store output, take care of cursor position and deletion of ;; list, then return output. (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) - (goto-char bottom) + (goto-char top) (when delete (delete-region top bottom) - (save-match-data - (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) - (replace-match "\n")))) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "\n"))) out)) (defun org-list-make-subtree () From f66e9cbfd55ec159c17fd61f45e5c44e1477d965 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 30 Dec 2010 22:11:27 +0100 Subject: [PATCH 047/107] org-list: fix insert-item with added data to structure --- 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 4e4c87f08..6916fd117 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -652,7 +652,7 @@ function ends." (setcar (nthcdr 6 e) (+ end size-offset)))))) struct) (setq struct (sort - (cons (list item ind bullet nil box (+ item item-size)) + (cons (list item ind bullet nil box nil (+ item item-size)) struct) (lambda (e1 e2) (< (car e1) (car e2))))) ;; 6. If not BEFOREP, new item must appear after ITEM, so From 504b497b7f71ce00b8354cac4f371d678b522ec8 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 30 Dec 2010 22:23:51 +0100 Subject: [PATCH 048/107] org-list: handle case when moving top item without its subtree --- lisp/org-list.el | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 6916fd117..61db2abdd 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -692,9 +692,13 @@ STRUCT is the list structure. Return t if successful." (parents (org-list-struct-parent-alist struct)) (prevs (org-list-struct-prev-alist struct)) ;; Are we going to move the whole list? - (specialp (and (cdr (assq 'indent org-list-automatic-rules)) - (not no-subtree) - (= top (point))))) + (specialp + (and (= top (point)) + (cdr (assq 'indent org-list-automatic-rules)) + (if no-subtree + (error + "First item of list cannot move without its subtree") + t)))) ;; Determine begin and end points of zone to indent. If moving ;; more than one item, save them for subsequent moves. (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) From 8aa95608e5b884ce775fba93f625cde96b189768 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 1 Jan 2011 18:27:31 +0100 Subject: [PATCH 049/107] org-list: small refactoring --- lisp/org-list.el | 282 ++++++++++++++++++++++------------------------- 1 file changed, 129 insertions(+), 153 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 61db2abdd..ba4ce4fbe 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -346,105 +346,91 @@ group 4: description tag") (defun org-list-context () "Determine context, and its boundaries, around point. -Context is determined by reading `org-context' text property if -applicable, or looking at Org syntax around. - Context will be an alist like (MIN MAX CONTEXT) where MIN and MAX -are boundaries and CONTEXT is a symbol among nil, `drawer', -`block', `invalid' and `inlinetask'. +are boundaries and CONTEXT is a symbol among `drawer', `block', +`invalid', `inlinetask' and nil. -Symbols `block' and `invalid' refer to `org-list-blocks'." +Contexts `block' and `invalid' refer to `org-list-blocks'." (save-match-data - (let* ((origin (point)) - (context-prop (get-text-property origin 'org-context))) - (if context-prop - (list - (or (previous-single-property-change - (min (1+ (point)) (point-max)) 'org-context) (point-min)) - (or (next-single-property-change origin 'org-context) (point-max)) - (cond - ((equal (downcase context-prop) "inlinetask") 'inlinetask) - ((member (upcase context-prop) org-list-blocks) 'invalid) - (t 'block))) - (save-excursion - (beginning-of-line) - (let* ((outline-regexp (org-get-limited-outline-regexp)) - ;; can't use org-drawers-regexp as this function might be - ;; called in buffers not in Org mode - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) - (case-fold-search t) - ;; compute position of surrounding headings. this is the - ;; default context. - (heading - (save-excursion - (list - (or (and (org-at-heading-p) (point-at-bol)) - (outline-previous-heading) - (point-min)) - (or (outline-next-heading) - (point-max)) - nil))) - (prev-head (car heading)) - (next-head (nth 1 heading)) - ;; Are we strictly inside a drawer? - (drawerp - (when (and (org-in-regexps-block-p - drawers-re "^[ \t]*:END:" prev-head) - (save-excursion - (beginning-of-line) - (and (not (looking-at drawers-re)) - (not (looking-at "^[ \t]*:END:"))))) - (save-excursion - (list - (progn - (re-search-backward drawers-re prev-head t) - (1+ (point-at-eol))) - (if (re-search-forward "^[ \t]*:END:" next-head t) - (1- (point-at-bol)) - next-head) - 'drawer)))) - ;; Are we strictly in a block, and of which type? - (blockp - (save-excursion - (when (and (org-in-regexps-block-p - "^[ \t]*#\\+begin_" "^[ \t]*#\\+end_" prev-head) - (save-excursion - (beginning-of-line) - (not (looking-at - "^[ \t]*#\\+\\(begin\\|end\\)_")))) - (list - (progn - (re-search-backward - "^[ \t]*#\\+begin_\\(\\S-+\\)" prev-head t) - (1+ (point-at-eol))) - (save-match-data - (if (re-search-forward "^[ \t]*#\\+end_" next-head t) - (1- (point-at-bol)) - next-head)) - (if (member (upcase (match-string 1)) org-list-blocks) - 'invalid - 'block))))) - ;; Are we in an inlinetask? - (inlinetaskp - (when (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (not (looking-at "^\\*+"))) - (save-excursion - (list - (progn (org-inlinetask-goto-beginning) - (1+ (point-at-eol))) - (progn - (org-inlinetask-goto-end) - (forward-line -1) - (1- (point-at-bol))) - 'inlinetask)))) - ;; list actual candidates - (context-list - (delq nil (list heading drawerp blockp inlinetaskp)))) - ;; Return the closest context around - (assq (apply 'max (mapcar 'car context-list)) context-list))))))) + (save-excursion + (beginning-of-line) + (let* ((outline-regexp (org-get-limited-outline-regexp)) + ;; can't use org-drawers-regexp as this function might be + ;; called in buffers not in Org mode + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (case-fold-search t) + ;; compute position of surrounding headings. this is the + ;; default context. + (heading + (save-excursion + (list + (or (and (org-at-heading-p) (point-at-bol)) + (outline-previous-heading) + (point-min)) + (or (outline-next-heading) + (point-max)) + nil))) + (prev-head (car heading)) + (next-head (nth 1 heading)) + ;; Are we strictly inside a drawer? + (drawerp + (when (and (org-in-regexps-block-p + drawers-re "^[ \t]*:END:" prev-head) + (save-excursion + (beginning-of-line) + (and (not (looking-at drawers-re)) + (not (looking-at "^[ \t]*:END:"))))) + (save-excursion + (list + (progn + (re-search-backward drawers-re prev-head t) + (1+ (point-at-eol))) + (if (re-search-forward "^[ \t]*:END:" next-head t) + (1- (point-at-bol)) + next-head) + 'drawer)))) + ;; Are we strictly in a block, and of which type? + (blockp + (save-excursion + (when (and (org-in-regexps-block-p + "^[ \t]*#\\+begin_" "^[ \t]*#\\+end_" prev-head) + (save-excursion + (beginning-of-line) + (not (looking-at + "^[ \t]*#\\+\\(begin\\|end\\)_")))) + (list + (progn + (re-search-backward + "^[ \t]*#\\+begin_\\(\\S-+\\)" prev-head t) + (1+ (point-at-eol))) + (save-match-data + (if (re-search-forward "^[ \t]*#\\+end_" next-head t) + (1- (point-at-bol)) + next-head)) + (if (member (upcase (match-string 1)) org-list-blocks) + 'invalid + 'block))))) + ;; Are we in an inlinetask? + (inlinetaskp + (when (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (not (looking-at "^\\*+"))) + (save-excursion + (list + (progn (org-inlinetask-goto-beginning) + (1+ (point-at-eol))) + (progn + (org-inlinetask-goto-end) + (forward-line -1) + (1- (point-at-bol))) + 'inlinetask)))) + ;; list actual candidates + (context-list + (delq nil (list heading drawerp blockp inlinetaskp)))) + ;; Return the closest context around + (assq (apply 'max (mapcar 'car context-list)) context-list))))) (defun org-list-search-unenclosed-generic (search re bound noerr) "Search a string outside blocks and protected places. @@ -1166,8 +1152,8 @@ Assume point is at an item." ;; ind is less or equal than BEG-CELL and there is no ;; end at this ind or lesser, this item becomes the ;; new BEG-CELL. - (setq itm-lst (cons (funcall assoc-at-point ind) itm-lst) - end-lst (cons (cons ind (point-at-bol)) end-lst)) + (push (funcall assoc-at-point ind) itm-lst) + (push (cons ind (point-at-bol)) end-lst) (when (or (and (eq org-list-ending-method 'regexp) (<= ind (cdr beg-cell))) (< ind text-min-ind)) @@ -1191,7 +1177,7 @@ Assume point is at an item." (memq (assq (car beg-cell) itm-lst) itm-lst)))) (t (when (< ind text-min-ind) (setq text-min-ind ind)) - (setq end-lst (cons (cons ind (point-at-bol)) end-lst)))) + (push (cons ind (point-at-bol)) end-lst))) (forward-line -1))))))) ;; 2. Read list from starting point to its end, that is until we ;; get out of context, or a non-item line is less or equally @@ -1206,16 +1192,12 @@ Assume point is at an item." ;; list. Save point as an ending position, and jump to ;; part 3. (throw 'exit - (setq end-lst-2 - (cons - (cons 0 (funcall end-before-blank)) end-lst-2)))) + (push (cons 0 (funcall end-before-blank)) end-lst-2))) ((and (not (eq org-list-ending-method 'regexp)) (looking-at (org-list-end-re))) ;; Looking at a list ending regexp. Save point as an ;; ending position and jump to part 3. - (throw 'exit - (setq end-lst-2 - (cons (cons ind (point-at-bol)) end-lst-2)))) + (throw 'exit (push (cons ind (point-at-bol)) end-lst-2))) ;; Skip blocks, drawers, inline tasks and blank lines ;; along the way ((looking-at "^[ \t]*#\\+begin_") @@ -1232,8 +1214,8 @@ Assume point is at an item." ((org-at-item-p) ;; Point is at an item. Add data to ITM-LST-2. It may also ;; end a previous item, so save it in END-LST-2. - (setq itm-lst-2 (cons (funcall assoc-at-point ind) itm-lst-2) - end-lst-2 (cons (cons ind (point-at-bol)) end-lst-2)) + (push (funcall assoc-at-point ind) itm-lst-2) + (push (cons ind (point-at-bol)) end-lst-2) (forward-line 1)) (t ;; Point is not at an item. If ending method is not @@ -1248,11 +1230,10 @@ Assume point is at an item." (cond ((eq org-list-ending-method 'regexp)) ((<= ind (cdr beg-cell)) - (setq end-lst-2 - (cons (cons ind (funcall end-before-blank)) end-lst-2)) + (push (cons ind (funcall end-before-blank)) end-lst-2) (throw 'exit nil)) ((<= ind (nth 1 (car itm-lst-2))) - (setq end-lst-2 (cons (cons ind (point-at-bol)) end-lst-2)))) + (push (cons ind (point-at-bol)) end-lst-2))) (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))) (setq end-lst (append end-lst (cdr (nreverse end-lst-2)))) @@ -1309,7 +1290,7 @@ This function modifies STRUCT." (let ((pos (car item)) (ind (nth 1 item)) (prev-ind (caar ind-to-ori))) - (setq prev-pos (cons pos prev-pos)) + (push pos prev-pos) (cond ((> prev-ind ind) (setq ind-to-ori @@ -1317,7 +1298,7 @@ This function modifies STRUCT." (cons pos (cdar ind-to-ori))) ((< prev-ind ind) (let ((origin (nth 1 prev-pos))) - (setq ind-to-ori (cons (cons ind origin) ind-to-ori)) + (push (cons ind origin) ind-to-ori) (cons pos origin))) (t (cons pos (cdar ind-to-ori)))))) (cdr struct))))) @@ -1357,10 +1338,9 @@ STRUCT is the list structure considered." (sub-struct (cdr (member (assq item struct) struct))) subtree) (catch 'exit - (mapc (lambda (e) (let ((pos (car e))) - (if (< pos item-end) - (setq subtree (cons pos subtree)) - (throw 'exit nil)))) + (mapc (lambda (e) + (let ((pos (car e))) + (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) sub-struct)) (nreverse subtree))) @@ -1383,8 +1363,8 @@ PARENTS is the alist of items' parent. See `org-list-struct-parent-alist'." (let (all) (while (setq child (car (rassq item parents))) - (setq parents (cdr (member (assq child parents) parents)) - all (cons child all))) + (setq parents (cdr (member (assq child parents) parents))) + (push child all)) (nreverse all))) (defun org-list-get-top-point (struct) @@ -1571,7 +1551,7 @@ This function modifies STRUCT." (let* ((parent (org-list-get-parent e struct parents)) (parent-box-p (org-list-get-checkbox parent struct))) (when (and parent-box-p (not (memq parent parent-list))) - (setq parent-list (cons parent parent-list))))) + (push parent parent-list)))) all-items) ;; 2. Sort those parents by decreasing indentation (setq parent-list (sort parent-list @@ -1622,16 +1602,13 @@ PARENTS is the alist of items' parents. See ;; to: it is the last item (ITEM-UP), whose ending is ;; further than the position we're interested in. (let ((item-up (assoc-default end-pos acc-end '>))) - (setq end-list - (append - (list (cons - (if item-up - (+ (org-list-get-ind item-up struct) 2) - 0) ; this case is for the bottom point - end-pos)) - end-list)))) - (setq end-list (append (list (cons ind-pos pos)) end-list)) - (setq acc-end (cons (cons end-pos pos) acc-end)))) + (push (cons + ;; else part is for the bottom point + (if item-up (+ (org-list-get-ind item-up struct) 2) 0) + end-pos) + end-list))) + (push (cons ind-pos pos) end-list) + (push (cons end-pos pos) acc-end))) struct) (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) (org-list-struct-assoc-end struct end-list)) @@ -1668,12 +1645,12 @@ START is included, END excluded." (error "Cannot outdent top-level items")) ;; Parent is outdented: keep association ((>= parent start) - (setq acc (cons (cons parent item) acc)) cell) + (push (cons parent item) acc) cell) (t ;; Parent isn't outdented: reparent to grand-parent (let ((grand-parent (org-list-get-parent parent struct parents))) - (setq acc (cons (cons parent item) acc)) + (push (cons parent item) acc) (cons item grand-parent)))))))) (mapcar out parents))) @@ -1689,7 +1666,7 @@ START is included and END excluded. STRUCT may be modified if `org-list-demote-modify-bullet' matches bullets between START and END." (let* (acc - (set-assoc (lambda (cell) (setq acc (cons cell acc)) cell)) + (set-assoc (lambda (cell) (push cell acc) cell)) (change-bullet-maybe (function (lambda (item) @@ -1722,8 +1699,8 @@ bullets between START and END." ((< prev start) (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 parents))) (defun org-list-struct-apply-struct (struct old-struct) @@ -1799,16 +1776,15 @@ Initial position of cursor is restored after the changes." (ind-shift (- (+ ind-pos (length bul-pos)) (+ ind-old (length bul-old)))) (end-pos (org-list-get-item-end pos old-struct))) - (setq itm-shift (cons (cons pos ind-shift) itm-shift)) + (push (cons pos ind-shift) itm-shift) (unless (assq end-pos old-struct) ;; To determine real ind of an ending position that is ;; not at an item, we have to find the item it belongs ;; to: it is the last item (ITEM-UP), whose ending is ;; further than the position we're interested in. (let ((item-up (assoc-default end-pos acc-end '>))) - (setq end-list (append - (list (cons end-pos item-up)) end-list)))) - (setq acc-end (cons (cons end-pos pos) acc-end)))) + (push (cons end-pos item-up) end-list))) + (push (cons end-pos pos) acc-end))) old-struct) ;; 2. Slice the items into parts that should be shifted by the ;; same amount of indentation. The slices are returned in @@ -1823,7 +1799,7 @@ Initial position of cursor is restored after the changes." (ind (if (assq up struct) (cdr (assq up itm-shift)) (cdr (assq (cdr (assq up end-list)) itm-shift))))) - (setq sliced-struct (cons (list down up ind) sliced-struct)))) + (push (list down up ind) sliced-struct))) ;; 3. Modify each slice in buffer, from end to beginning, with a ;; special action when beginning is at item start. (mapc (lambda (e) @@ -2191,12 +2167,12 @@ With optional prefix argument ALL, do this for the whole buffer." (let* ((pre (org-list-struct-prev-alist s)) (par (org-list-struct-parent-alist s)) (items - (if recursivep - (or (and item (org-list-get-subtree item s)) - (mapcar 'car s)) - (or (and item (org-list-get-children item s par)) - (org-list-get-all-items - (org-list-get-top-point s) s pre)))) + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar 'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) (cookies (delq nil (mapcar (lambda (e) (org-list-get-checkbox e s)) @@ -2232,7 +2208,7 @@ With optional prefix argument ALL, do this for the whole buffer." (while (org-search-forward-unenclosed box-re backup-end 'move) (let* ((struct (org-list-struct)) (bottom (org-list-get-bottom-point struct))) - (setq structs-backup (cons struct structs-backup)) + (push struct structs-backup) (goto-char bottom))) (funcall count-boxes nil structs-backup)) ((org-at-item-p) @@ -2243,16 +2219,16 @@ With optional prefix argument ALL, do this for the whole buffer." (if (and backup-end (< item backup-end)) (funcall count-boxes item structs-backup) (let ((struct (org-list-struct))) - (setq end-entry (org-list-get-bottom-point struct) + (setq backup-end (org-list-get-bottom-point struct) structs-backup (list struct))) (funcall count-boxes item structs-backup)))))) ;; Build the cookies list, with appropriate information - (setq cookies-list (cons (list (match-beginning 1) ; cookie start - (match-end 1) ; cookie end - (match-beginning 2) ; percent? - c-on ; checked boxes - c-all) ; total boxes - cookies-list))))) + (push (list (match-beginning 1) ; cookie start + (match-end 1) ; cookie end + (match-beginning 2) ; percent? + c-on ; checked boxes + c-all) ; total boxes + cookies-list)))) ;; 2. Apply alist to buffer, in reverse order so positions stay ;; unchanged after cookie modifications. (mapc (lambda (cookie) From da6a10b02da40cda3066dfb18b5543f085431a6f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 2 Jan 2011 00:26:37 +0100 Subject: [PATCH 050/107] Modified behavior in searches specific to lists * lisp/org-list.el (org-list-search-generic): renamed form org-search-unenclosed-generic to reflect now behavior. Now, match can only be in a valid context for lists, as determined by `org-list-context'. (org-list-search-backward): renamed from org-search-backward-unenclosed. (org-list-search-forward): renamed from org-search-forward-unenclosed. (org-toggle-checkbox,org-update-checkbox-count): use new functions. (org-sort-list): using default regexp search functions as context is not required in this case. * lisp/org-ascii.el (org-export-ascii-preprocess): use new function * lisp/org-capture.el (org-capture-place-item): use new function --- lisp/org-ascii.el | 3 +-- lisp/org-capture.el | 4 ++-- lisp/org-list.el | 58 +++++++++++++++++++++------------------------ 3 files changed, 30 insertions(+), 35 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index c1179eac7..b54868614 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -577,8 +577,7 @@ 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-list-search-forward "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t) (replace-match "")) (remove-text-properties (point-min) (point-max) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 2f9b3796d..cf48bdaf9 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -827,14 +827,14 @@ already gone. Any prefix argument will be passed to the refile comand." (if (org-capture-get :prepend) (progn (goto-char beg) - (if (org-search-forward-unenclosed org-item-beginning-re end t) + (if (org-list-search-forward 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 (org-search-backward-unenclosed org-item-beginning-re beg t) + (if (org-list-search-backward org-item-beginning-re beg t) (progn (setq ind (org-get-indentation)) (org-end-of-item)) diff --git a/lisp/org-list.el b/lisp/org-list.el index ba4ce4fbe..1bedca28b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -432,11 +432,10 @@ Contexts `block' and `invalid' refer to `org-list-blocks'." ;; Return the closest context around (assq (apply 'max (mapcar 'car context-list)) context-list))))) -(defun org-list-search-unenclosed-generic (search re bound noerr) - "Search a string outside blocks and protected places. +(defun org-list-search-generic (search re bound noerr) + "Search a string in valid contexts for lists. Arguments SEARCH, RE, BOUND and NOERR are similar to those in -`search-forward', `search-backward', `re-search-forward' and -`re-search-backward'." +`re-search-forward'." (catch 'exit (let ((origin (point))) (while t @@ -444,25 +443,23 @@ Arguments SEARCH, RE, BOUND and NOERR are similar to those in (unless (funcall search re bound noerr) (throw 'exit (and (goto-char (if (memq noerr '(t nil)) 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))))))) + ;; 2. Match in an `invalid' context: continue searching. Else, + ;; return point. + (unless (eq (org-list-context) 'invalid) (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. +(defun org-list-search-backward (regexp &optional bound noerror) + "Like `re-search-backward' but stop only where lists are recognized. 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)) + (org-list-search-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. +(defun org-list-search-forward (regexp &optional bound noerror) + "Like `re-search-forward' but stop only where lists are recognized. 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)) + (org-list-search-generic #'re-search-forward + 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?" @@ -512,7 +509,7 @@ some heuristics to guess the result." usr-blank) ;; Are there blank lines inside the item ? ((save-excursion - (org-search-forward-unenclosed + (org-list-search-forward "^[ \t]*$" (org-list-get-item-end-before-blank pos struct) t)) 1) ;; No parent: no blank line. @@ -1115,7 +1112,8 @@ Assume point is at an item." (save-excursion (catch 'exit (while t - (let ((ind (org-get-indentation))) + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) (cond ((<= (point) lim-up) ;; At upward limit: if we ended at an item, store it, @@ -1185,7 +1183,8 @@ Assume point is at an item." ;; of items in END-LST-2. (catch 'exit (while t - (let ((ind (org-get-indentation))) + (let ((ind (+ (or (get-text-property (point) 'original-indentation) 0) + (org-get-indentation)))) (cond ((>= (point) lim-down) ;; At downward limit: this is de facto the end of the @@ -2028,8 +2027,7 @@ in subtree, ignoring drawers." ((org-region-active-p) (let ((limit (region-end))) (goto-char (region-beginning)) - (if (org-search-forward-unenclosed org-item-beginning-re - limit t) + (if (org-list-search-forward org-item-beginning-re limit t) (setq lim-up (point-at-bol)) (error "No item in region")) (setq lim-down (copy-marker limit)))) @@ -2039,8 +2037,7 @@ in subtree, ignoring drawers." (forward-line 1) (when (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:" limit nil)) - (if (org-search-forward-unenclosed org-item-beginning-re - limit t) + (if (org-list-search-forward org-item-beginning-re limit t) (setq lim-up (point-at-bol)) (error "No item in subtree")) (setq lim-down (copy-marker limit)))) @@ -2068,8 +2065,8 @@ in subtree, ignoring drawers." ;; list; 3. move point after the list. (goto-char lim-up) (while (and (< (point) lim-down) - (org-search-forward-unenclosed - org-item-beginning-re lim-down 'move)) + (org-list-search-forward org-item-beginning-re + lim-down 'move)) (let* ((struct (org-list-struct)) (struct-copy (mapcar (lambda (e) (copy-alist e)) struct)) (parents (org-list-struct-parent-alist struct)) @@ -2205,7 +2202,7 @@ With optional prefix argument ALL, do this for the whole buffer." ;; This cookie is at an heading. Grab structure of ;; every list containing a checkbox between point and ;; next headline, and save them in STRUCTS-BACKUP - (while (org-search-forward-unenclosed box-re backup-end 'move) + (while (org-list-search-forward box-re backup-end 'move) (let* ((struct (org-list-struct)) (bottom (org-list-get-bottom-point struct))) (push struct structs-backup) @@ -2360,10 +2357,9 @@ compare entries." ;; If it is a timer list, convert timer to seconds ((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) - (org-search-forward-unenclosed org-ts-regexp-both - (point-at-eol) t)) + ((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))) (t (org-float-time now)))) ((= dcst ?f) From 212a7ddcedf73bcbd911ae7b468317bdce922de7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 2 Jan 2011 15:16:16 +0100 Subject: [PATCH 051/107] org-list: small fix in insert function --- 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 1bedca28b..7ee547d61 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -553,7 +553,7 @@ function ends." ;; (BEFOREP), blank lines number separating items (BLANK-NB), ;; position of split (POS) if we're allowed to (SPLIT-LINE-P). (let* ((pos (point)) - (item (goto-char (org-get-item-beginning))) + (item (goto-char (org-list-get-item-begin))) (struct (org-list-struct)) (prevs (org-list-struct-prev-alist struct)) (item-end (org-list-get-item-end item struct)) From b37761715e893af0eeeb2fe7c2418bdcf5467558 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 2 Jan 2011 15:57:15 +0100 Subject: [PATCH 052/107] Added variable to configure where lists should be interpreted * lisp/org-list.el (org-list-forbidden-blocks): variable renamed from org-list-blocks. (org-list-export-context): new variable * list/org-exp.el (org-export-mark-lists): use new variable. * list/org-latex.el (org-export-latex-lists): use new variable --- lisp/org-exp.el | 2 +- lisp/org-latex.el | 2 +- lisp/org-list.el | 19 ++++++++++++++----- 3 files changed, 16 insertions(+), 7 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index b5715e3a8..6db2ee33c 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1729,7 +1729,7 @@ These special properties will later be interpreted by the backend. (goto-char (point-min)) (while (re-search-forward org-item-beginning-re nil t) (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e)))) - '(nil block))))) + (cons nil org-list-export-context))))) (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-latex.el b/lisp/org-latex.el index 10d41a1e3..891b76a74 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2499,7 +2499,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (insert (org-add-props res nil 'original-indentation (org-find-text-property-in-string 'original-indentation res))))))) - '(block nil))) + (append org-list-export-context '(nil)))) (defconst org-latex-entities '("\\!" diff --git a/lisp/org-list.el b/lisp/org-list.el index 7ee547d61..459656b7c 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -304,10 +304,18 @@ list, obtained by prompting the user." (list (symbol :tag "Major mode") (string :tag "Format")))) -;;; Internal functions +(defvar org-list-forbidden-blocks '("example" "verse" "src") + "Names of blocks where lists are not allowed. +Names must be in lower case.") -(defconst org-list-blocks '("EXAMPLE" "VERSE" "SRC") - "Names of blocks where lists are not allowed.") +(defvar org-list-export-context '(block inlinetask) + "Context types where lists will be interpreted during export. + +Valid types are `drawer', `inlinetask' and `block'. More +specifically, type `block' is determined by the variable +`org-list-forbidden-blocks'.") + +;;; Internal functions (defun org-list-end-re () "Return the regex corresponding to the end of a list. @@ -350,7 +358,7 @@ Context will be an alist like (MIN MAX CONTEXT) where MIN and MAX are boundaries and CONTEXT is a symbol among `drawer', `block', `invalid', `inlinetask' and nil. -Contexts `block' and `invalid' refer to `org-list-blocks'." +Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (save-match-data (save-excursion (beginning-of-line) @@ -409,7 +417,8 @@ Contexts `block' and `invalid' refer to `org-list-blocks'." (if (re-search-forward "^[ \t]*#\\+end_" next-head t) (1- (point-at-bol)) next-head)) - (if (member (upcase (match-string 1)) org-list-blocks) + (if (member (downcase (match-string 1)) + org-list-forbidden-blocks) 'invalid 'block))))) ;; Are we in an inlinetask? From 884d983188a09c60787ba2035b4a4c577767a8ec Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 2 Jan 2011 19:07:58 +0100 Subject: [PATCH 053/107] org-list: fix code typo --- 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 459656b7c..aa9a10ad2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1410,7 +1410,7 @@ previous items. See `org-list-struct-prev-alist'." "Return point at end of sub-list ITEM belongs. STRUCT is the structure of the list. PREVS is the alist of previous items. See `org-list-struct-prev-alist'." - (org-list-get-item-end (org-list-get-list-last item struct prevs) struct)) + (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) (defun org-list-get-nth (n key struct) "Return the Nth value of KEY in STRUCT." From c32e39786dcc5e42d49a0195a2b91da3d7733e08 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 2 Jan 2011 19:25:52 +0100 Subject: [PATCH 054/107] org-list: small corrections to sort list * lisp/org-list.el (org-sort-list): fix number of arguments to `org-list-repair', plus make end-record go to end of item before any blank line to keep them from being swallowed in the sorting. --- lisp/org-list.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index aa9a10ad2..4485a423f 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2351,7 +2351,8 @@ compare entries." (skip-chars-forward " \r\t\n") (beginning-of-line))) (end-record (lambda () - (goto-char (org-list-get-item-end (point) struct)))) + (goto-char (org-list-get-item-end-before-blank + (point) struct)))) (value-to-sort (lambda () (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") @@ -2385,7 +2386,9 @@ compare entries." value-to-sort nil sort-func) - (org-list-repair nil) + ;; Read and fix list again, as `sort-subr' probably destroyed + ;; its structure. + (org-list-repair) (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) From 2621fe04619c7ca446b1c2d6821907c8f332972e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 4 Jan 2011 22:10:25 +0100 Subject: [PATCH 055/107] Do not remove empty list items in HTML and DocBook export --- lisp/org-docbook.el | 10 +--------- lisp/org-html.el | 14 +++++++------- 2 files changed, 8 insertions(+), 16 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index ac3d7f103..740a68cb0 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1041,20 +1041,12 @@ publishing directory." (if (eq major-mode (default-value 'major-mode)) (nxml-mode))) - ;; Remove empty paragraphs and lists. Replace them with a - ;; newline. + ;; Remove empty paragraphs. Replace them with a newline. (goto-char (point-min)) (while (re-search-forward "[ \r\n\t]*\\(\\)[ \r\n\t]*[ \r\n\t]*" nil t) (when (not (get-text-property (match-beginning 1) 'org-protected)) (replace-match "\n") - ;; Avoid empty caused by inline tasks. - ;; We should add an empty para to make everything valid. - (when (and (looking-at "") - (save-excursion - (backward-char (length "\n")) - (looking-at ""))) - (insert "")) (backward-char 1))) ;; Fill empty sections with . This is to make sure ;; that the DocBook document generated is valid and well-formed. diff --git a/lisp/org-html.el b/lisp/org-html.el index 7ed3f2ada..a7199e26b 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1719,16 +1719,16 @@ lang=\"%s\" xml:lang=\"%s\"> (goto-char (match-end 0)) (insert "\n"))) (insert "
    \n") - (mapc 'insert thetoc) - (insert "
    \n")) - ;; remove empty paragraphs and lists + (let ((beg (point))) + (mapc 'insert thetoc) + (insert "
    • \n") + (while (re-search-backward "
  • [ \r\n\t]*
    • \n?" beg t) + (replace-match "")))) + ;; remove empty paragraphs (goto-char (point-min)) (while (re-search-forward "

    [ \r\n\t]*

    " nil t) (replace-match "")) (goto-char (point-min)) - (while (re-search-forward "
  • [ \r\n\t]*
    • \n?" nil t) - (replace-match "")) - (goto-char (point-min)) ;; Convert whitespace place holders (goto-char (point-min)) (let (beg end n) @@ -2440,7 +2440,7 @@ the alist of previous items." (let* ((counter (match-string 2 line)) (checkbox (match-string 3 line)) (desc-tag (or (match-string 4 line) "???")) - (body (match-string 5 line)) + (body (or (match-string 5 line) "")) (list-beg (org-list-get-list-begin pos struct prevs)) (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in From 39d85b5e39d85381527a230cb3c0f3457358a9a3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 5 Jan 2011 00:04:11 +0100 Subject: [PATCH 056/107] org-list: small optimization for cookies updating * lisp/org-list.el (org-update-checkbox-count): do not recompute every list before next heading when there are more than one cookie in an headline. Moreover, ignore the case where cookie is inserted neither at an heading nor at an item. --- lisp/org-list.el | 100 +++++++++++++++++++++++++++-------------------- 1 file changed, 57 insertions(+), 43 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 4485a423f..a6532e6f2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2186,55 +2186,69 @@ With optional prefix argument ALL, do this for the whole buffer." (setq c-all (+ (length cookies) c-all) c-on (+ (org-count "[X]" cookies) c-on)))) structs)))) - cookies-list backup-end structs-backup) + (backup-end 1) + cookies-list structs-backup) (goto-char (car bounds)) ;; 1. Build an alist for each cookie found within BOUNDS. The ;; key will be position at beginning of cookie and values ;; ending position, format of cookie, number of checked boxes ;; to report, and total number of boxes. (while (re-search-forward cookie-re (cdr bounds) t) - (save-excursion - (let ((c-on 0) (c-all 0)) - (save-match-data - ;; There are two types of cookies: those at headings and those - ;; at list items. - (cond - ((and (org-on-heading-p) - (string-match "\\" - (downcase - (or (org-entry-get nil "COOKIE_DATA") ""))))) - ;; This cookie is at an heading, but specifically for - ;; todo, not for checkboxes: skip it. - ((org-on-heading-p) - (setq backup-end (save-excursion - (outline-next-heading) (point))) - ;; This cookie is at an heading. Grab structure of - ;; every list containing a checkbox between point and - ;; next headline, and save them in STRUCTS-BACKUP - (while (org-list-search-forward box-re backup-end 'move) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (push struct structs-backup) - (goto-char bottom))) - (funcall count-boxes nil structs-backup)) - ((org-at-item-p) - ;; This cookie is at an item. Look in STRUCTS-BACKUP - ;; to see if we have the structure of list at point in - ;; it. Else compute the structure. - (let ((item (point-at-bol))) - (if (and backup-end (< item backup-end)) - (funcall count-boxes item structs-backup) - (let ((struct (org-list-struct))) - (setq backup-end (org-list-get-bottom-point struct) - structs-backup (list struct))) - (funcall count-boxes item structs-backup)))))) - ;; Build the cookies list, with appropriate information - (push (list (match-beginning 1) ; cookie start - (match-end 1) ; cookie end - (match-beginning 2) ; percent? - c-on ; checked boxes - c-all) ; total boxes - cookies-list)))) + (catch 'skip + (save-excursion + (let ((c-on 0) (c-all 0)) + (save-match-data + ;; There are two types of cookies: those at headings and those + ;; at list items. + (cond + ;; Cookie is at an heading, but specifically for todo, + ;; not for checkboxes: skip it. + ((and (org-on-heading-p) + (string-match "\\" + (downcase + (or (org-entry-get nil "COOKIE_DATA") "")))) + (throw 'skip nil)) + ;; Cookie is at an heading, but all lists before next + ;; heading already have been read. Use data collected + ;; in STRUCTS-BACKUP. This should only happen when + ;; heading has more than one cookie on it. + ((and (org-on-heading-p) + (<= (save-excursion (outline-next-heading) (point)) + backup-end)) + (funcall count-boxes nil structs-backup)) + ;; Cookie is at a fresh heading. Grab structure of + ;; every list containing a checkbox between point and + ;; next headline, and save them in STRUCTS-BACKUP. + ((org-on-heading-p) + (setq backup-end (save-excursion + (outline-next-heading) (point))) + (while (org-list-search-forward box-re backup-end 'move) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (push struct structs-backup) + (goto-char bottom))) + (funcall count-boxes nil structs-backup)) + ;; Cookie is at an item, and we already list structure + ;; stored in STRUCTS-BACKUP. + ((and (org-at-item-p) + (< (point-at-bol) backup-end)) + (funcall count-boxes (point-at-bol) structs-backup)) + ;; Cookie is at an item, but we need to compute list + ;; structure. + ((org-at-item-p) + (let ((struct (org-list-struct))) + (setq backup-end (org-list-get-bottom-point struct) + structs-backup (list struct))) + (funcall count-boxes item structs-backup)) + ;; Else, cookie found is at a wrong place. Skip it. + (t (throw 'skip nil)))) + ;; Build the cookies list, with appropriate information + (push (list (match-beginning 1) ; cookie start + (match-end 1) ; cookie end + (match-string 2) ; percent? + c-on ; checked boxes + c-all) ; total boxes + cookies-list))))) ;; 2. Apply alist to buffer, in reverse order so positions stay ;; unchanged after cookie modifications. (mapc (lambda (cookie) From 23e5d5720e9a0bc591188cd1c59e37d470d350bb Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 6 Jan 2011 17:07:27 +0100 Subject: [PATCH 057/107] org-exp: split list processing in two parts to better handle org-babel * lisp/org-exp.el (org-export-preprocess-string): mark list endings before babel blocks preprocessing starts, so blank lines that may be inserted do not break list's structure. Then, mark list with special properties required by exporters. Thus output from babel can easily be included in lists. (org-export-mark-list-end): new function (org-export-mark-list-properties): new function (org-export-mark-lists): removed function. It was split into the two preceding functions. --- lisp/org-exp.el | 66 ++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 51 insertions(+), 15 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 6db2ee33c..875b9135f 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1089,12 +1089,16 @@ on this string to produce the exported version." (plist-get parameters :exclude-tags)) (run-hooks 'org-export-preprocess-after-tree-selection-hook) - ;; Mark lists - (org-export-mark-lists backend) + ;; Change lists ending. Other parts of export may insert blank + ;; lines and lists' structure could be altered. + (org-export-mark-list-end backend) ;; Export code blocks (org-export-blocks-preprocess) + ;; Mark lists with properties + (org-export-mark-list-properties backend) + ;; Handle source code snippets (org-export-replace-src-segments-and-examples backend) @@ -1670,10 +1674,40 @@ 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-lists (backend) +(defun org-export-mark-list-end (backend) + "Mark all list endings with a special string." + (unless (eq backend 'ascii) + (mapc + (lambda (e) + ;; For each type allowing list export, find every list, remove + ;; ending regexp if needed, and insert org-list-end. + (goto-char (point-min)) + (while (re-search-forward org-item-beginning-re nil t) + (when (eq (nth 2 (org-list-context)) e) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct)) + (top (org-list-get-top-point struct)) + (top-ind (org-list-get-ind top struct))) + (goto-char bottom) + (when (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re))) + (replace-match "")) + (unless (bolp) (insert "\n")) + ;; As org-list-end is inserted at column 0, it would end + ;; by indentation any list. It can be problematic when + ;; there are lists within lists: the inner list end would + ;; also become the outer list end. To avoid this, text + ;; property `original-indentation' is added, as + ;; `org-list-struct' pay attention to it when reading a + ;; list. + (insert (org-add-props + "ORG-LIST-END\n" + (list 'original-indentation top-ind))))))) + (cons nil org-list-export-context)))) + +(defun org-export-mark-list-properties (backend) "Mark list with special properties. -These special properties will later be interpreted by the backend. -`org-list-end-re' is replaced by a blank line in the process." +These special properties will later be interpreted by the backend." (let ((mark-list (function ;; Mark a list with 3 properties: `list-item' which is @@ -1707,28 +1741,30 @@ These special properties will later be interpreted by the backend. 'list-struct struct 'list-prevs prevs))) poi) - ;; Take care of bottom point. As it is probably at an - ;; empty line, insert a virtual ending with required - ;; property. + ;; Take care of bottom point. As babel may have inserted + ;; a new list in buffer, list ending isn't always + ;; marked. Now mark every list ending and add properties + ;; useful to line processing exporters. (goto-char bottom) - (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) + (when (or (looking-at "^ORG-LIST-END\n") + (and (not (eq org-list-ending-method 'indent)) + (looking-at (org-list-end-re)))) (replace-match "")) (unless (bolp) (insert "\n")) (insert (org-add-props "ORG-LIST-END\n" (list 'list-item bottom 'list-struct struct 'list-prevs prevs))) - ;; Add `list-context' as text property between top and - ;; bottom. + ;; Following property is used by LaTeX exporter. (add-text-properties top (point) (list 'list-context ctxt))))))) ;; Mark lists except for backends not interpreting them. (unless (eq backend 'ascii) (mapc (lambda (e) - (goto-char (point-min)) - (while (re-search-forward org-item-beginning-re nil t) - (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e)))) + (flet ((org-list-end-re nil "ORG-LIST-END")) + (goto-char (point-min)) + (while (re-search-forward org-item-beginning-re nil t) + (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e))))) (cons nil org-list-export-context))))) (defun org-export-attach-captions-and-attributes (backend target-alist) From fc6c4187261ef94d75ccea12de86802bd1992e0e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 6 Jan 2011 18:54:30 +0100 Subject: [PATCH 058/107] org-list: remove code preventing insertion of an item in a block * lisp/org-list.el (org-list-automatic-rules): removed insert rule. (org-list-insert-item-generic): removed code preventing user to insert another item in a block within a list. It is because new list context make it impossible to see if a point in a block is also in a list. --- lisp/org-list.el | 36 ++++-------------------------------- 1 file changed, 4 insertions(+), 32 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a6532e6f2..eeeffdc10 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -227,8 +227,7 @@ precedence over it." (defcustom org-list-automatic-rules '((bullet . t) (checkbox . t) - (indent . t) - (insert . t)) + (indent . t)) "Non-nil means apply set of rules when acting on lists. By default, automatic actions are taken when using \\[org-meta-return], \\[org-metaright], \\[org-metaleft], @@ -247,10 +246,7 @@ checkbox when non-nil, checkbox statistics is updated each time 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." + change that bullet to \"-\"." :group 'org-plain-lists :type '(alist :tag "Sets of rules" :key-type @@ -533,31 +529,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 ends." (let ((case-fold-search t)) - (goto-char pos) - ;; 1. Check if a new item can be inserted at point: are we in an - ;; invalid block ? Move outside it if `org-list-automatic' - ;; rules says so. - (when (or (eq (nth 2 (org-list-context)) 'invalid) - (save-excursion - (beginning-of-line) - (or (looking-at "^[ \t]*#\\+\\(begin\\|end\\)_") - (looking-at (concat - "\\(" - org-drawer-regexp - "\\|^[ \t]*:END:[ \t]*$\\)")) - (and (featurep 'org-inlinetask) - (looking-at (org-inlinetask-outline-regexp)))))) - (if (not (cdr (assq 'insert org-list-automatic-rules))) - (error "Cannot insert item inside a block") - (end-of-line) - (if (string-match "^\\*+[ \t]+" (match-string 0)) - (org-inlinetask-goto-beginning) - (let ((block-start (if (string-match "#\\+" (match-string 0)) - "^[ \t]*#\\+begin_" - org-drawer-regexp))) - (re-search-backward block-start nil t))) - (end-of-line 0))) - ;; 2. Get information about list: structure, usual helper + ;; 1. Get information about list: structure, usual helper ;; functions, position of point with regards to item start ;; (BEFOREP), blank lines number separating items (BLANK-NB), ;; position of split (POS) if we're allowed to (SPLIT-LINE-P). @@ -572,7 +544,7 @@ function ends." (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) (blank-nb (org-list-separating-blank-lines-number item struct prevs)) - ;; 3. Build the new item to be created. Concatenate same + ;; 2. Build the new item to be created. Concatenate same ;; bullet as item, checkbox, text AFTER-BULLET if ;; provided, and text cut from point to end of item ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on From c82805fc5751415b49409171188eb4be6a6cf3e0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 9 Jan 2011 15:26:34 +0100 Subject: [PATCH 059/107] org-list: small fixes for org-list-struct --- 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 eeeffdc10..2f6e6d3e4 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1173,11 +1173,11 @@ Assume point is at an item." ;; part 3. (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) - ((and (not (eq org-list-ending-method 'regexp)) + ((and (not (eq org-list-ending-method 'indent)) (looking-at (org-list-end-re))) ;; Looking at a list ending regexp. Save point as an ;; ending position and jump to part 3. - (throw 'exit (push (cons ind (point-at-bol)) end-lst-2))) + (throw 'exit (push (cons 0 (point-at-bol)) end-lst-2))) ;; Skip blocks, drawers, inline tasks and blank lines ;; along the way ((looking-at "^[ \t]*#\\+begin_") From b219690f0554adfe5fa2d2aebf8c0b08b1d04859 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 9 Jan 2011 16:25:01 +0100 Subject: [PATCH 060/107] ob: compute correct end position when results are a list * lisp/ob.el (org-babel-result-end): end position is end of current sublist instead of bottom point, as results might be inserted in a list themselves. --- lisp/ob.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index f52fb6bb5..e0949fcb9 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -77,7 +77,8 @@ (declare-function org-list-parse-list "org-list" (&optional delete)) (declare-function org-list-to-generic "org-list" (LIST PARAMS)) (declare-function org-list-struct "org-list" ()) -(declare-function org-list-get-bottom-point "org-list" (struct)) +(declare-function org-list-struct-prev-alist "org-list" (struct)) +(declare-function org-list-get-list-end "org-list" (item struct prevs)) (defgroup org-babel nil "Code block evaluation and management in `org-mode' documents." @@ -1583,9 +1584,9 @@ code ---- the results are extracted in the syntax of the source (save-excursion (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) - ((org-at-item-p) (save-excursion - (org-beginning-of-item) - (1- (org-list-get-bottom-point (org-list-struct))))) + ((org-at-item-p) (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct))) + (org-list-get-list-end (point-at-bol) struct prevs))) (t (let ((case-fold-search t) (blocks-re (regexp-opt From eeea385b0bc2b0d1b5cbbb3128900d501399d570 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 9 Jan 2011 20:24:56 +0100 Subject: [PATCH 061/107] org-latex: during export process, only unprotected items are valid * lisp/org-latex.el (org-export-latex-lists): Search for unprotected items only, and redefine `org-at-item'. This change is required when verbatim lists are inserted during export, usually by Babel. --- lisp/org-latex.el | 68 ++++++++++++++++++++++++++--------------------- 1 file changed, 37 insertions(+), 31 deletions(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 891b76a74..1c44ace19 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2468,37 +2468,43 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (let (res) (goto-char (point-min)) (while (re-search-forward org-item-beginning-re nil t) - (when (eq (get-text-property (point) 'list-context) e) - (beginning-of-line) - (setq res - (org-list-to-latex - ;; Narrowing is needed because we're converting - ;; inner functions to outer ones. - (save-restriction - (narrow-to-region (point) (point-max)) - ;; `org-list-end-re' output has changed since - ;; preprocess from org-exp.el. Tell it to - ;; `org-list-parse-list'. - (flet ((org-list-end-re nil "^ORG-LIST-END\n")) - (org-list-parse-list t))) - org-export-latex-list-parameters)) - ;; Replace any counter with its latex expression in output - ;; string. - (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))) - ;; Extend previous value of original-indentation to the whole - ;; string - (insert (org-add-props res nil 'original-indentation - (org-find-text-property-in-string - 'original-indentation res))))))) + (org-if-unprotected + (when (eq (get-text-property (point) 'list-context) e) + (beginning-of-line) + (setq res + (org-list-to-latex + ;; Narrowing is needed because we're converting + ;; from inner functions to outer ones. + (save-restriction + (narrow-to-region (point) (point-max)) + ;; `org-list-end-re' output has changed since + ;; preprocess from org-exp.el. Moreover, we now + ;; only consider unprotected item as valid. + (flet ((org-list-end-re nil "^ORG-LIST-END\n") + (org-at-item-p + nil (save-excursion + (beginning-of-line) + (org-if-unprotected + (looking-at org-item-beginning-re))))) + (org-list-parse-list t))) + org-export-latex-list-parameters)) + ;; Replace any counter with its latex expression in output + ;; string. + (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))) + ;; Extend previous value of original-indentation to the whole + ;; string + (insert (org-add-props res nil 'original-indentation + (org-find-text-property-in-string + 'original-indentation res)))))))) (append org-list-export-context '(nil)))) (defconst org-latex-entities From 79553c4764dfa55c835bb811844db12709bf0723 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 9 Jan 2011 23:47:03 +0100 Subject: [PATCH 062/107] org-list: fixes for incorrect number of arguments --- lisp/org-list.el | 43 ++++++++++++++++++++++--------------------- lisp/org.el | 5 +++-- 2 files changed, 25 insertions(+), 23 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 2f6e6d3e4..a683f0da0 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -820,8 +820,9 @@ Return an error if not in a list." (if (not begin) (error "Not in an item") (goto-char begin) - (let ((struct (org-list-struct))) - (goto-char (org-list-get-list-begin begin (org-list-struct))))))) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct))) + (goto-char (org-list-get-list-begin begin struct prevs)))))) (defun org-end-of-item-list () "Go to the end of the current list or sublist. @@ -831,8 +832,9 @@ If the cursor in not in an item, throw an error." (if (not begin) (error "Not in an item") (goto-char begin) - (let ((struct (org-list-struct))) - (goto-char (org-list-get-list-end begin (org-list-struct))))))) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct))) + (goto-char (org-list-get-list-end begin struct prevs)))))) (defun org-end-of-item () "Go to the end of the current hand-formatted item. @@ -1829,7 +1831,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) (interactive) (let ((regionp (org-region-active-p))) (cond @@ -2134,30 +2135,30 @@ With optional prefix argument ALL, do this for the whole buffer." (save-excursion (outline-next-heading) (point))))) (count-boxes (function - ;; add checked boxes and boxes of all types in all - ;; structures in STRUCTS to c-on and c-all, respectively. - ;; This looks at RECURSIVEP value. If ITEM is nil, count - ;; across the whole structure, else count only across - ;; subtree whose ancestor is ITEM. + ;; add checked boxes and boxes of all types in all + ;; structures in STRUCTS to c-on and c-all, respectively. + ;; This looks at RECURSIVEP value. If ITEM is nil, count + ;; across the whole structure, else count only across + ;; subtree whose ancestor is ITEM. (lambda (item structs) (mapc - (lambda (s) - (let* ((pre (org-list-struct-prev-alist s)) + (lambda (s) + (let* ((pre (org-list-struct-prev-alist s)) (par (org-list-struct-parent-alist s)) - (items + (items (cond ((and recursivep item) (org-list-get-subtree item s)) (recursivep (mapcar 'car s)) (item (org-list-get-children item s par)) (t (org-list-get-all-items (org-list-get-top-point s) s pre)))) - (cookies (delq nil (mapcar - (lambda (e) - (org-list-get-checkbox e s)) - items)))) - (setq c-all (+ (length cookies) c-all) - c-on (+ (org-count "[X]" cookies) c-on)))) - structs)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (setq c-all (+ (length cookies) c-all) + c-on (+ (org-count "[X]" cookies) c-on)))) + structs)))) (backup-end 1) cookies-list structs-backup) (goto-char (car bounds)) @@ -2211,7 +2212,7 @@ With optional prefix argument ALL, do this for the whole buffer." (let ((struct (org-list-struct))) (setq backup-end (org-list-get-bottom-point struct) structs-backup (list struct))) - (funcall count-boxes item structs-backup)) + (funcall count-boxes (point-at-bol) structs-backup)) ;; Else, cookie found is at a wrong place. Skip it. (t (throw 'skip nil)))) ;; Build the cookies list, with appropriate information diff --git a/lisp/org.el b/lisp/org.el index 42b49159d..99688484b 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11915,8 +11915,9 @@ EXTRA is additional text that will be inserted into the notes buffer." (if itemp (progn (goto-char itemp) - (org-list-get-ind - (org-list-get-top-point (org-list-struct)))) + (let ((struct (org-list-struct))) + (org-list-get-ind + (org-list-get-top-point struct) struct))) (skip-chars-backward " \r\t\n") (cond ((and (org-at-heading-p) From d7a799cc8627a2d8e9b2988788accbcd464c98a5 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 10 Jan 2011 18:39:06 +0100 Subject: [PATCH 063/107] org-inlinetask: fix export of inline tasks within lists * lisp/org-inlinetask.el (org-inlinetask-export-templates): slightly modify templates so environment boundaries don't interfere with content of task. Unprotect content of task so it might benefit from further transformations. Set original-indentation property to a high value to ensure that task is always in the last item of the list. Also, apply templates later in export process. * lisp/org-list.el (org-list-struct): fix inline task skipping. --- lisp/org-inlinetask.el | 29 +++++++++++++++++------------ lisp/org-list.el | 3 +-- 2 files changed, 18 insertions(+), 14 deletions(-) diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index eb1cfb7d2..483ce5f5c 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -105,12 +105,12 @@ When nil, they will not be exported." :type 'boolean) (defvar org-inlinetask-export-templates - '((html "
    %s%s
    %s
    " + '((html "
    %s%s
    \n%s\n
    " '((unless (eq todo "") (format "%s%s " class todo todo priority)) heading content)) - (latex "\\begin\{description\}\\item[%s%s]%s\\end\{description\}" + (latex "\\begin\{description\}\n\\item[%s%s]~\n%s\n\\end\{description\}" '((unless (eq todo "") (format "\\textsc\{%s%s\} " todo priority)) heading content)) (ascii " -- %s%s%s" @@ -251,7 +251,7 @@ Either remove headline and meta data, or do special formatting." (let* ((nstars (if org-odd-levels-only (1- (* 2 (or org-inlinetask-min-level 200))) (or org-inlinetask-min-level 200))) - (re1 (format "^\\(\\*\\{%d,\\}\\) .*\n" nstars)) + (re1 (format "^\\(\\*\\{%d,\\}\\)[ \t]+.*\n" nstars)) (re2 (concat "^[ \t]*" org-keyword-time-regexp)) headline beg end stars content) (while (re-search-forward re1 nil t) @@ -266,7 +266,7 @@ Either remove headline and meta data, or do special formatting." (if (re-search-forward org-property-end-re nil t) (delete-region beg (1+ (match-end 0))))) (setq beg (point)) - (when (and (re-search-forward "^\\(\\*+\\) " nil t) + (when (and (re-search-forward "^\\(\\*+\\)[ \t]+" nil t) (= (length (match-string 1)) (length stars)) (progn (goto-char (match-end 0)) (looking-at "END[ \t]*$"))) @@ -281,7 +281,10 @@ Either remove headline and meta data, or do special formatting." (if (string-match "[ \t\n]+\\'" content) (setq content (substring content 0 (match-beginning 0)))) (setq content (org-remove-indentation content)))) - (setq content (or content "")) + ;; Prevent from protecting content if there's any + (setq content (or (and content + (org-add-props content '(org-protected nil))) + "")) ;; grab elements to export (when (string-match org-complex-heading-regexp headline) (let* ((todo (or (match-string 2 headline) "")) @@ -291,16 +294,18 @@ Either remove headline and meta data, or do special formatting." (heading (or (match-string 4 headline) "")) (tags (or (match-string 5 headline) "")) (backend-spec (assq backend org-inlinetask-export-templates)) - (format-str (nth 1 backend-spec)) + (format-str (org-add-props (nth 1 backend-spec) + '(org-protected t))) (tokens (cadr (nth 2 backend-spec))) - ;; change nil arguments into empty strings - (nil-to-str (lambda (el) (or (eval el) ""))) - ;; build and protect export string + (nil-to-str + ;; Change nil arguments into empty strings + (lambda (el) (or (eval el) ""))) + ;; Build and ensure export string will not break lists (export-str (org-add-props (eval (append '(format format-str) (mapcar nil-to-str tokens))) - nil 'org-protected t))) - ;; eventually insert it + '(original-indentation 1000)))) + ;; Eventually insert it (insert export-str "\n"))))))) (defun org-inlinetask-get-current-indentation () @@ -337,7 +342,7 @@ Either remove headline and meta data, or do special formatting." (replace-match ""))) (eval-after-load "org-exp" - '(add-hook 'org-export-preprocess-after-tree-selection-hook + '(add-hook 'org-export-preprocess-before-backend-specifics-hook 'org-inlinetask-export-handler)) (eval-after-load "org" '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) diff --git a/lisp/org-list.el b/lisp/org-list.el index a683f0da0..a29e5fa16 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1189,8 +1189,7 @@ Assume point is at an item." (re-search-forward "^[ \t]*:END:" nil t) (forward-line 1)) ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-end) - (forward-line 1)) + (org-inlinetask-goto-end)) ((looking-at "^[ \t]*$") (forward-line 1)) ((org-at-item-p) From 215d3fa0306484d5246b1ddcc8ace7e1a1f18e37 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 10 Jan 2011 18:55:39 +0100 Subject: [PATCH 064/107] Improve usage of `org-in-item-p' When the function needs to know if cursor is in a plain list and move to item beginning if it is the case, a fast way is to ignore errors on (goto-char (org-in-item-p)). --- lisp/org-list.el | 5 ++--- lisp/org-mouse.el | 9 +++------ lisp/org.el | 49 ++++++++++++++++++++--------------------------- 3 files changed, 26 insertions(+), 37 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a29e5fa16..b30ef90c0 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2479,12 +2479,11 @@ Point is left at list end." (defun org-list-make-subtree () "Convert the plain list at point into a subtree." (interactive) - (if (not (org-in-item-p)) + (if (not (ignore-errors (goto-char (org-in-item-p)))) (error "Not in a list") (let ((list (org-list-parse-list t)) nstars) (save-excursion - (if (ignore-errors - (org-back-to-heading)) + (if (ignore-errors (org-back-to-heading)) (progn (looking-at org-complex-heading-regexp) (setq nstars (length (match-string 1)))) (setq nstars 0))) diff --git a/lisp/org-mouse.el b/lisp/org-mouse.el index b66043527..7aa313f94 100644 --- a/lisp/org-mouse.el +++ b/lisp/org-mouse.el @@ -579,12 +579,9 @@ SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" (defun org-mouse-for-each-item (funct) ;; Functions called by `org-apply-on-list' need an argument - (let ((wrap-fun (lambda (c) (funcall funct))) - (item-beg (org-in-item-p))) - (when item-beg - (save-excursion - (goto-char item-beg) - (org-apply-on-list wrap-fun nil))))) + (let ((wrap-fun (lambda (c) (funcall funct)))) + (when (ignore-errors (goto-char (org-in-item-p))) + (save-excursion (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 99688484b..ed415e5d9 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11819,13 +11819,12 @@ 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)) - (let ((itemp (org-in-item-p))) - (when itemp - (let* ((struct (progn (goto-char itemp) (org-list-struct))) - (prevs (org-list-struct-prev-alist struct))) - (while (looking-at "[ \t]*- State") - (goto-char (or (org-list-get-next-item (point) struct prevs) - (org-list-get-item-end (point) struct)))))))) + (when (ignore-errors (goto-char (org-in-item-p))) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct))) + (while (looking-at "[ \t]*- State") + (goto-char (or (org-list-get-next-item (point) struct prevs) + (org-list-get-item-end (point) struct))))))) (defun org-add-log-note (&optional purpose) "Pop up a window for taking a note, and add this note later at point." @@ -11911,20 +11910,17 @@ EXTRA is additional text that will be inserted into the notes buffer." (end-of-line 1) (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) (setq ind (save-excursion - (let ((itemp (org-in-item-p))) - (if itemp - (progn - (goto-char itemp) - (let ((struct (org-list-struct))) - (org-list-get-ind - (org-list-get-top-point struct) struct))) - (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))))))) + (if (ignore-errors (goto-char (org-in-item-p))) + (let ((struct (org-list-struct))) + (org-list-get-ind + (org-list-get-top-point struct) struct)) + (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)) @@ -18833,8 +18829,7 @@ If point is in an inline task, mark that task instead." (org-get-indentation) (org-get-indentation (match-string 0))))) ;; Lists - ((let ((in-item-p (org-in-item-p))) - (and in-item-p (goto-char in-item-p))) + ((ignore-errors (goto-char (org-in-item-p))) (or (org-at-item-description-p) (org-at-item-p)) (setq bpos (match-beginning 1) tpos (match-end 0) bcol (progn (goto-char bpos) (current-column)) @@ -18856,11 +18851,9 @@ If point is in an inline task, mark that task instead." (and (looking-at "[ \t]*#\\+end_") (re-search-backward "[ \t]*#\\+begin_"nil t)) (looking-at "[ \t]*[\n:#|]") - (let ((itemp (org-in-item-p))) - (and itemp - (goto-char itemp) - (goto-char - (org-list-get-top-point (org-list-struct))))) + (and (ignore-errors (goto-char (org-in-item-p))) + (goto-char + (org-list-get-top-point (org-list-struct)))) (and (not inline-task-p) (featurep 'org-inlinetask) (org-inlinetask-in-task-p) From 2c7924468767e272dbfec4ef79c801042ed6b806 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 10 Jan 2011 20:01:51 +0100 Subject: [PATCH 065/107] Change function org-list-end-re into a variable * lisp/org-list.el (org-list-end-re): removed function and made it a variable. There's no need for the overhead of calling the function every at every line in a list. User will have to reload Org if he change value of either `org-list-end-regexp' or `org-empty-line-terminates-plain-lists'. (org-in-item-p,org-list-struct,org-list-parse-list): apply change. * lisp/org-exp.el (org-export-mark-list-end, org-export-mark-list-properties): apply change * lisp/org-latex.el (org-export-latex-lists): apply change. Also prevent items with org-example property to be considered as real items. --- lisp/org-exp.el | 14 +++++----- lisp/org-latex.el | 67 +++++++++++++++++++++-------------------------- lisp/org-list.el | 26 +++++++++--------- 3 files changed, 49 insertions(+), 58 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 875b9135f..9847666d8 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1690,7 +1690,7 @@ These special cookies will later be interpreted by the backend." (top-ind (org-list-get-ind top struct))) (goto-char bottom) (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) + (looking-at org-list-end-re)) (replace-match "")) (unless (bolp) (insert "\n")) ;; As org-list-end is inserted at column 0, it would end @@ -1748,7 +1748,7 @@ These special properties will later be interpreted by the backend." (goto-char bottom) (when (or (looking-at "^ORG-LIST-END\n") (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re)))) + (looking-at org-list-end-re))) (replace-match "")) (unless (bolp) (insert "\n")) (insert @@ -1759,13 +1759,13 @@ These special properties will later be interpreted by the backend." (add-text-properties top (point) (list 'list-context ctxt))))))) ;; Mark lists except for backends not interpreting them. (unless (eq backend 'ascii) - (mapc - (lambda (e) - (flet ((org-list-end-re nil "ORG-LIST-END")) + (let ((org-list-end-re "^ORG-LIST-END\n")) + (mapc + (lambda (e) (goto-char (point-min)) (while (re-search-forward org-item-beginning-re nil t) - (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e))))) - (cons nil org-list-export-context))))) + (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e)))) + (cons nil org-list-export-context)))))) (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-latex.el b/lisp/org-latex.el index 1c44ace19..c96dc258e 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2468,43 +2468,36 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (let (res) (goto-char (point-min)) (while (re-search-forward org-item-beginning-re nil t) - (org-if-unprotected - (when (eq (get-text-property (point) 'list-context) e) - (beginning-of-line) - (setq res - (org-list-to-latex - ;; Narrowing is needed because we're converting - ;; from inner functions to outer ones. - (save-restriction - (narrow-to-region (point) (point-max)) - ;; `org-list-end-re' output has changed since - ;; preprocess from org-exp.el. Moreover, we now - ;; only consider unprotected item as valid. - (flet ((org-list-end-re nil "^ORG-LIST-END\n") - (org-at-item-p - nil (save-excursion - (beginning-of-line) - (org-if-unprotected - (looking-at org-item-beginning-re))))) - (org-list-parse-list t))) - org-export-latex-list-parameters)) - ;; Replace any counter with its latex expression in output - ;; string. - (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))) - ;; Extend previous value of original-indentation to the whole - ;; string - (insert (org-add-props res nil 'original-indentation - (org-find-text-property-in-string - 'original-indentation res)))))))) + (when (and (eq (get-text-property (point) 'list-context) e) + (not (get-text-property (point) 'org-example))) + (beginning-of-line) + (setq res + (org-list-to-latex + ;; Narrowing is needed because we're converting + ;; from inner functions to outer ones. + (save-restriction + (narrow-to-region (point) (point-max)) + ;; `org-list-end-re' output has changed since + ;; preprocess from org-exp.el. + (let ((org-list-end-re "^ORG-LIST-END\n")) + (org-list-parse-list t))) + org-export-latex-list-parameters)) + ;; Replace any counter with its latex expression in string. + (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))) + ;; Extend previous value of original-indentation to the + ;; whole string + (insert (org-add-props res nil 'original-indentation + (org-find-text-property-in-string + 'original-indentation res))))))) (append org-list-export-context '(nil)))) (defconst org-latex-entities diff --git a/lisp/org-list.el b/lisp/org-list.el index b30ef90c0..207363c41 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -313,12 +313,11 @@ specifically, type `block' is determined by the variable ;;; Internal functions -(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" - org-list-end-regexp)) +(defconst org-list-end-re (if org-empty-line-terminates-plain-lists + "^[ \t]*\n" + org-list-end-regexp) + "Regex corresponding to the end of a list. +It depends on `org-empty-line-terminates-plain-lists'.") (defun org-item-re (&optional general) "Return the correct regular expression for plain lists. @@ -736,8 +735,8 @@ This checks `org-list-ending-method'." (beginning-of-line) (unless (or (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re)) - (progn (forward-line -1) (looking-at (org-list-end-re))))) + (looking-at org-list-end-re) + (progn (forward-line -1) (looking-at org-list-end-re)))) (or (and (org-at-item-p) (point-at-bol)) (let* ((case-fold-search t) (context (org-list-context)) @@ -754,7 +753,7 @@ This checks `org-list-ending-method'." ((<= (point) lim-up) (throw 'exit (and (org-at-item-p) (< ind ind-ref) (point)))) ((and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) + (looking-at org-list-end-re)) (throw 'exit nil)) ;; Skip blocks, drawers, inline-tasks, blank lines ((looking-at "^[ \t]*#\\+end_") @@ -779,8 +778,7 @@ This checks `org-list-ending-method'." (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (save-excursion - (beginning-of-line) (looking-at org-item-beginning-re))) + (save-excursion (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?" @@ -1109,7 +1107,7 @@ Assume point is at an item." (setq beg-cell (cons (point) ind)) (cons (funcall assoc-at-point ind) itm-lst))))) ((and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) + (looking-at org-list-end-re)) ;; Looking at a list ending regexp. Dismiss useless ;; data recorded above BEG-CELL. Jump to part 2. (throw 'exit @@ -1176,7 +1174,7 @@ Assume point is at an item." (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) ((and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) + (looking-at org-list-end-re)) ;; Looking at a list ending regexp. Save point as an ;; ending position and jump to part 3. (throw 'exit (push (cons 0 (point-at-bol)) end-lst-2))) @@ -2472,7 +2470,7 @@ Point is left at list end." (when delete (delete-region top bottom) (when (and (not (eq org-list-ending-method 'indent)) - (looking-at (org-list-end-re))) + (looking-at org-list-end-re)) (replace-match "\n"))) out)) From e5293ba34746e4b926a5375323098b54252b19d3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 11 Jan 2011 23:50:44 +0100 Subject: [PATCH 066/107] org-list: checkbox count code cleanup --- lisp/org-list.el | 158 +++++++++++++++++++++++------------------------ 1 file changed, 78 insertions(+), 80 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 207363c41..29b664f0a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2132,101 +2132,99 @@ With optional prefix argument ALL, do this for the whole buffer." (save-excursion (outline-next-heading) (point))))) (count-boxes (function - ;; add checked boxes and boxes of all types in all - ;; structures in STRUCTS to c-on and c-all, respectively. - ;; This looks at RECURSIVEP value. If ITEM is nil, count + ;; Return number of checked boxes and boxes of all types + ;; in all structures in STRUCTS. If RECURSIVEP is non-nil, + ;; also count boxes in sub-lists. If ITEM is nil, count ;; across the whole structure, else count only across ;; subtree whose ancestor is ITEM. - (lambda (item structs) - (mapc - (lambda (s) - (let* ((pre (org-list-struct-prev-alist s)) - (par (org-list-struct-parent-alist s)) - (items - (cond - ((and recursivep item) (org-list-get-subtree item s)) - (recursivep (mapcar 'car s)) - (item (org-list-get-children item s par)) - (t (org-list-get-all-items - (org-list-get-top-point s) s pre)))) - (cookies (delq nil (mapcar - (lambda (e) - (org-list-get-checkbox e s)) - items)))) - (setq c-all (+ (length cookies) c-all) - c-on (+ (org-count "[X]" cookies) c-on)))) - structs)))) + (lambda (item structs recursivep) + (let ((c-on 0) (c-all 0)) + (mapc + (lambda (s) + (let* ((pre (org-list-struct-prev-alist s)) + (par (org-list-struct-parent-alist s)) + (items + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar 'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (setq c-all (+ (length cookies) c-all) + c-on (+ (org-count "[X]" cookies) c-on)))) + structs) + (cons c-on c-all))))) (backup-end 1) - cookies-list structs-backup) + cookies-list structs-bak box-num) (goto-char (car bounds)) ;; 1. Build an alist for each cookie found within BOUNDS. The ;; key will be position at beginning of cookie and values - ;; ending position, format of cookie, number of checked boxes - ;; to report, and total number of boxes. + ;; ending position, format of cookie, and a cell whose car is + ;; number of checked boxes to report, and cdr total number of + ;; boxes. (while (re-search-forward cookie-re (cdr bounds) t) (catch 'skip (save-excursion - (let ((c-on 0) (c-all 0)) - (save-match-data - ;; There are two types of cookies: those at headings and those - ;; at list items. - (cond - ;; Cookie is at an heading, but specifically for todo, - ;; not for checkboxes: skip it. - ((and (org-on-heading-p) - (string-match "\\" - (downcase - (or (org-entry-get nil "COOKIE_DATA") "")))) - (throw 'skip nil)) - ;; Cookie is at an heading, but all lists before next - ;; heading already have been read. Use data collected - ;; in STRUCTS-BACKUP. This should only happen when - ;; heading has more than one cookie on it. - ((and (org-on-heading-p) - (<= (save-excursion (outline-next-heading) (point)) - backup-end)) - (funcall count-boxes nil structs-backup)) - ;; Cookie is at a fresh heading. Grab structure of - ;; every list containing a checkbox between point and - ;; next headline, and save them in STRUCTS-BACKUP. - ((org-on-heading-p) - (setq backup-end (save-excursion - (outline-next-heading) (point))) - (while (org-list-search-forward box-re backup-end 'move) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (push struct structs-backup) - (goto-char bottom))) - (funcall count-boxes nil structs-backup)) - ;; Cookie is at an item, and we already list structure - ;; stored in STRUCTS-BACKUP. - ((and (org-at-item-p) - (< (point-at-bol) backup-end)) - (funcall count-boxes (point-at-bol) structs-backup)) - ;; Cookie is at an item, but we need to compute list - ;; structure. - ((org-at-item-p) - (let ((struct (org-list-struct))) - (setq backup-end (org-list-get-bottom-point struct) - structs-backup (list struct))) - (funcall count-boxes (point-at-bol) structs-backup)) - ;; Else, cookie found is at a wrong place. Skip it. - (t (throw 'skip nil)))) - ;; Build the cookies list, with appropriate information - (push (list (match-beginning 1) ; cookie start - (match-end 1) ; cookie end - (match-string 2) ; percent? - c-on ; checked boxes - c-all) ; total boxes - cookies-list))))) + (push + (list + (match-beginning 1) ; cookie start + (match-end 1) ; cookie end + (match-string 2) ; percent? + (cond ; boxes count + ;; Cookie is at an heading, but specifically for todo, + ;; not for checkboxes: skip it. + ((and (org-on-heading-p) + (string-match "\\" + (downcase + (or (org-entry-get nil "COOKIE_DATA") "")))) + (throw 'skip nil)) + ;; Cookie is at an heading, but all lists before next + ;; heading already have been read. Use data collected + ;; in STRUCTS-BAK. This should only happen when heading + ;; has more than one cookie on it. + ((and (org-on-heading-p) + (<= (save-excursion (outline-next-heading) (point)) + backup-end)) + (funcall count-boxes nil structs-bak recursivep)) + ;; Cookie is at a fresh heading. Grab structure of + ;; every list containing a checkbox between point and + ;; next headline, and save them in STRUCTS-BAK. + ((org-on-heading-p) + (setq backup-end (save-excursion + (outline-next-heading) (point))) + (while (org-list-search-forward box-re backup-end 'move) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (push struct structs-bak) + (goto-char bottom))) + (funcall count-boxes nil structs-bak recursivep)) + ;; Cookie is at an item, and we already have list + ;; structure stored in STRUCTS-BAK. + ((and (org-at-item-p) + (< (point-at-bol) backup-end)) + (funcall count-boxes (point-at-bol) structs-bak recursivep)) + ;; Cookie is at an item, but we need to compute list + ;; structure. + ((org-at-item-p) + (let ((struct (org-list-struct))) + (setq backup-end (org-list-get-bottom-point struct) + structs-bak (list struct))) + (funcall count-boxes (point-at-bol) structs-bak recursivep)) + ;; Else, cookie found is at a wrong place. Skip it. + (t (throw 'skip nil)))) + cookies-list)))) ;; 2. Apply alist to buffer, in reverse order so positions stay ;; unchanged after cookie modifications. (mapc (lambda (cookie) (let* ((beg (car cookie)) (end (nth 1 cookie)) (percentp (nth 2 cookie)) - (checked (nth 3 cookie)) - (total (nth 4 cookie)) + (checked (car (nth 3 cookie))) + (total (cdr (nth 3 cookie))) (new (if percentp (format "[%d%%]" (/ (* 100 checked) (max 1 total))) From 781228183a0e009b8c6c68aafb51681768744d9e Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 13 Jan 2011 23:25:55 +0100 Subject: [PATCH 067/107] org-list: implement alphabetical lists * lisp/org-list.el (org-alphabetical-lists): new variable (org-item-re, org-list-full-item, org-cycle-list-bullet, org-list-struct-fix-bul, org-list-inc-bullet-maybe): reflect introduction of the new variable. (org-item-beginning-re): changed into a function, so any modification of `org-alphabetical-lists' will not require reloading Org. (org-at-item-p, org-toggle-checkbox, org-update-checkbox-count, org-list-parse-list, org-list-send-list): reflect changes to `org-item-beginning-re'. (org-list-use-alpha-bul-p): new function. * lisp/org.el (org-check-for-hidden): reflect changes to `org-item-beginning-re'. * lisp/org-capture.el (org-capture-place-item): reflect changes to `org-item-beginning-re'. * lisp/org-docbook.el (org-export-docbook-list-line): handle new type of items. * lisp/org-exp.el (org-export-mark-list-end, org-export-mark-list-properties): reflect changes to `org-item-beginning-re'. * lisp/org-html.el (org-html-export-list-line): handle new type of items. * lisp/org-latex.el (org-export-latex-lists): handle new type of items and reflect changes to `org-item-beginning-re'. * lisp/org-ascii.el (org-export-ascii-preprocess): handle new counters. Modified from a patch by Nathaniel Flath. --- lisp/org-ascii.el | 3 +- lisp/org-capture.el | 4 +- lisp/org-docbook.el | 39 ++++++--- lisp/org-exp.el | 8 +- lisp/org-html.el | 33 ++++++-- lisp/org-latex.el | 27 ++++--- lisp/org-list.el | 187 +++++++++++++++++++++++++++++++++----------- lisp/org.el | 2 +- 8 files changed, 223 insertions(+), 80 deletions(-) diff --git a/lisp/org-ascii.el b/lisp/org-ascii.el index b54868614..9d53bd204 100644 --- a/lisp/org-ascii.el +++ b/lisp/org-ascii.el @@ -577,7 +577,8 @@ publishing directory." (replace-match "\\1\\2"))) ;; Remove list start counters (goto-char (point-min)) - (while (org-list-search-forward "\\[@\\(?:start:\\)?[0-9]+\\][ \t]*" nil t) + (while (org-list-search-forward + "\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*" nil t) (replace-match "")) (remove-text-properties (point-min) (point-max) diff --git a/lisp/org-capture.el b/lisp/org-capture.el index cf48bdaf9..7296b040c 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -827,14 +827,14 @@ already gone. Any prefix argument will be passed to the refile comand." (if (org-capture-get :prepend) (progn (goto-char beg) - (if (org-list-search-forward org-item-beginning-re end t) + (if (org-list-search-forward (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 (org-list-search-backward org-item-beginning-re beg t) + (if (org-list-search-backward (org-item-beginning-re) beg t) (progn (setq ind (org-get-indentation)) (org-end-of-item)) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 740a68cb0..8190fff39 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1341,7 +1341,7 @@ the alist of previous items." ;; "ordered", "variable" or "itemized". (lambda (pos) (cond - ((string-match "[0-9]" (org-list-get-bullet pos struct)) + ((string-match "[[:alnum:]]" (org-list-get-bullet pos struct)) "ordered") ((org-list-get-tag pos struct) "variable") (t "itemized"))))) @@ -1376,25 +1376,42 @@ the alist of previous items." (cond ;; At an item: insert appropriate tags in export buffer. ((assq pos struct) - (string-match - (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?" - "\\(.*\\)") line) - (let* ((counter (match-string 2 line)) - (checkbox (match-string 3 line)) + (string-match (concat "[ \t]*\\(\\S-+[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?" + "\\(.*\\)") + line) + (let* ((checkbox (match-string 3 line)) (desc-tag (or (match-string 4 line) "???")) (body (match-string 5 line)) (list-beg (org-list-get-list-begin pos struct prevs)) (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in ;; case list is ill-formed. - (type (funcall get-type list-beg))) + (type (funcall get-type list-beg)) + ;; Special variables for ordered lists. + (order-type (let ((bullet (org-list-get-bullet list-beg struct))) + (cond + ((not (equal type "ordered")) nil) + ((string-match "[a-z]" bullet) "loweralpha") + ((string-match "[A-Z]" bullet) "upperalpha") + (t "arabic")))) + (counter (let ((count-tmp (org-list-get-counter pos struct))) + (cond + ((not count-tmp) nil) + ((and (member order-type '("loweralpha" "upperalpha")) + (string-match "[A-Za-z]" count-tmp)) + count-tmp) + ((and (equal order-type "arabic") + (string-match "[0-9]+" count-tmp)) + count-tmp))))) ;; When FIRSTP, a new list or sub-list is starting. (when firstp (org-export-docbook-close-para-maybe) - (insert (format "<%slist>\n" type))) + (insert (if (equal type "ordered") + (concat "\n") + (format "<%slist>\n" type)))) (insert (cond ((equal type "variable") (format "%s" desc-tag)) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index 9847666d8..d90258f89 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1682,11 +1682,11 @@ These special cookies will later be interpreted by the backend." ;; For each type allowing list export, find every list, remove ;; ending regexp if needed, and insert org-list-end. (goto-char (point-min)) - (while (re-search-forward org-item-beginning-re nil t) + (while (re-search-forward (org-item-beginning-re) nil t) (when (eq (nth 2 (org-list-context)) e) (let* ((struct (org-list-struct)) (bottom (org-list-get-bottom-point struct)) - (top (org-list-get-top-point struct)) + (top (point-at-bol)) (top-ind (org-list-get-ind top struct))) (goto-char bottom) (when (and (not (eq org-list-ending-method 'indent)) @@ -1698,7 +1698,7 @@ These special cookies will later be interpreted by the backend." ;; there are lists within lists: the inner list end would ;; also become the outer list end. To avoid this, text ;; property `original-indentation' is added, as - ;; `org-list-struct' pay attention to it when reading a + ;; `org-list-struct' pays attention to it when reading a ;; list. (insert (org-add-props "ORG-LIST-END\n" @@ -1763,7 +1763,7 @@ These special properties will later be interpreted by the backend." (mapc (lambda (e) (goto-char (point-min)) - (while (re-search-forward org-item-beginning-re nil t) + (while (re-search-forward (org-item-beginning-re) nil t) (when (eq (nth 2 (org-list-context)) e) (funcall mark-list e)))) (cons nil org-list-export-context)))))) diff --git a/lisp/org-html.el b/lisp/org-html.el index a7199e26b..5889270f4 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2399,7 +2399,8 @@ the alist of previous items." ;; "o" or "u". (lambda (pos) (cond - ((string-match "[0-9]" (org-list-get-bullet pos struct)) "o") + ((string-match "[[:alnum:]]" (org-list-get-bullet pos struct)) + "o") ((org-list-get-tag pos struct) "d") (t "u"))))) (get-closings @@ -2432,23 +2433,41 @@ the alist of previous items." ;; At an item: insert appropriate tags in export buffer. ((assq pos struct) (string-match - (concat "[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" + (concat "[ \t]*\\(\\S-+[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?" "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?" "\\(.*\\)") line) - (let* ((counter (match-string 2 line)) - (checkbox (match-string 3 line)) + (let* ((checkbox (match-string 3 line)) (desc-tag (or (match-string 4 line) "???")) (body (or (match-string 5 line) "")) (list-beg (org-list-get-list-begin pos struct prevs)) (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in ;; case list is ill-formed. - (type (funcall get-type list-beg))) + (type (funcall get-type list-beg)) + ;; Special variables for ordered lists. + (order-type (let ((bullet (org-list-get-bullet list-beg struct))) + (cond + ((not (equal type "o")) nil) + ((string-match "[a-z]" bullet) "a") + ((string-match "[A-Z]" bullet) "A") + (t "1")))) + (counter (let ((count-tmp (org-list-get-counter pos struct))) + (cond + ((not count-tmp) nil) + ((and (member order-type '("a" "A")) + (string-match "[A-Za-z]" count-tmp)) + (- (string-to-char (upcase count-tmp)) 64)) + ((and (equal order-type "1") + (string-match "[0-9]+" count-tmp)) + count-tmp))))) (when firstp (org-close-par-maybe) - (insert (format "<%sl>\n" type))) + ;; Treat ordered lists differently because of ORDER-TYPE. + (insert (if (equal type "o") + (concat "
      \n") + (format "<%sl>\n" type)))) (insert (cond ((equal type "d") (format "
      %s
      \n" desc-tag)) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index c96dc258e..73520effd 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2467,7 +2467,7 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." ;; conversion to latex (RES). (let (res) (goto-char (point-min)) - (while (re-search-forward org-item-beginning-re nil t) + (while (re-search-forward (org-item-beginning-re) nil t) (when (and (eq (get-text-property (point) 'list-context) e) (not (get-text-property (point) 'org-example))) (beginning-of-line) @@ -2483,16 +2483,25 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (org-list-parse-list t))) org-export-latex-list-parameters)) ;; Replace any counter with its latex expression in string. + ;; + ;; FIXME: enumi is for top list only. Sub-lists are using + ;; enumii, enumiii, enumiv. So, basically, using a + ;; counter within a sublist will break top-level + ;; item numbering. (while (string-match - "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\)\\]" + "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Z-a-z]\\)\\]" 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))) + (let ((count (match-string 2 res))) + (setq res (replace-match + (concat + ;; Filter out non-numeric counters, + ;; unsupported in standard LaTeX. + (if (save-match-data (string-match "[0-9]" count)) + (format "\\setcounter{enumi}{%d}\n" + (1- (string-to-number count))) + "") + (match-string 1 res)) + t t res)))) ;; Extend previous value of original-indentation to the ;; whole string (insert (org-add-props res nil 'original-indentation diff --git a/lisp/org-list.el b/lisp/org-list.el index 29b664f0a..29750f475 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -177,6 +177,13 @@ the safe choice." (const :tag "paren like in \"2)\"" ?\)) (const :tab "both" t))) +(defcustom org-alphabetical-lists nil + "Non-nil means single character alphabetical bullets are allowed. +Both uppercase and lowercase are handled. Lists with more than 26 +items will fallback to standard numbering." + :group 'org-plain-lists + :type 'boolean) + (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. @@ -319,25 +326,24 @@ specifically, type `block' is determined by the variable "Regex corresponding to the end of a list. It depends on `org-empty-line-terminates-plain-lists'.") -(defun org-item-re (&optional general) - "Return the correct regular expression for plain lists. -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]+\\|$\\)") - ((= org-plain-list-ordered-item-terminator ?.) - "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") - ((= org-plain-list-ordered-item-terminator ?\)) - "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)") - (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))) +(defun org-item-re () + "Return the correct regular expression for plain lists." + (let ((term (cond + ((eq org-plain-list-ordered-item-terminator t) "[.)]") + ((= org-plain-list-ordered-item-terminator ?\)) ")") + ((= org-plain-list-ordered-item-terminator ?.) "\\.") + (t "[.)]"))) + (alpha (if org-alphabetical-lists "\\|[A-Za-z]" ""))) + (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term + "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) -(defconst org-item-beginning-re (concat "^" (org-item-re)) - "Regexp matching the beginning of a plain list item.") +(defun org-item-beginning-re () + "Regexp matching the beginning of a plain list item." + (concat "^" (org-item-re))) (defconst org-list-full-item-re - (concat "^[ \t]*\\(\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\)\\]\\)?" + (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?" "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?") "Matches a list item and puts everything into groups: @@ -778,7 +784,7 @@ This checks `org-list-ending-method'." (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (save-excursion (beginning-of-line) (looking-at org-item-beginning-re))) + (save-excursion (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?" @@ -1445,8 +1451,12 @@ PREVS is the alist of previous items. See `org-list-struct-prev-alist'. This function modifies STRUCT." - (let ((fix-bul + (let ((case-fold-search nil) + (fix-bul (function + ;; Set bullet of ITEM in STRUCT, depending on the type of + ;; first item of the list, the previous bullet and counter + ;; if any. (lambda (item) (let* ((prev (org-list-get-prev-item item struct prevs)) (prev-bul (and prev (org-list-get-bullet prev struct))) @@ -1456,14 +1466,51 @@ This function modifies STRUCT." item struct (org-list-bullet-string (cond - ((and prev (string-match "[0-9]+" prev-bul) counter) + ;; Alpha counter in alpha list: use counter. + ((and prev counter + (string-match "[a-zA-Z]" counter) + (string-match "[a-zA-Z]" prev-bul)) + ;; Use cond to be sure `string-match' is used in + ;; both cases. + (let ((real-count + (cond + ((string-match "[a-z]" prev-bul) (downcase counter)) + ((string-match "[A-Z]" prev-bul) (upcase counter))))) + (replace-match real-count nil nil prev-bul))) + ;; Num counter in a num list: use counter. + ((and prev counter + (string-match "[0-9]+" counter) + (string-match "[0-9]+" prev-bul)) (replace-match counter nil nil prev-bul)) + ;; No counter: increase, if needed, previous bullet. (prev (org-list-inc-bullet-maybe (org-list-get-bullet prev struct))) - ((and (string-match "[0-9]+" bullet) counter) + ;; Alpha counter at first item: use counter. + ((and counter (org-list-use-alpha-bul-p item struct prevs) + (string-match "[A-Za-z]" counter) + (string-match "[A-Za-z]" bullet)) + (let ((real-count + (cond + ((string-match "[a-z]" bullet) (downcase counter)) + ((string-match "[A-Z]" bullet) (upcase counter))))) + (replace-match real-count nil nil bullet))) + ;; Num counter at first item: use counter. + ((and counter + (string-match "[0-9]+" counter) + (string-match "[0-9]+" bullet)) (replace-match counter nil nil bullet)) - ((string-match "[0-9]+" bullet) + ;; First bullet is alpha uppercase: use "A". + ((and (org-list-use-alpha-bul-p item struct prevs) + (string-match "[A-Z]" bullet)) + (replace-match "A" nil nil bullet)) + ;; First bullet is alpha lowercase: use "a". + ((and (org-list-use-alpha-bul-p item struct prevs) + (string-match "[a-z]" bullet)) + (replace-match "a" nil nil bullet)) + ;; First bullet is num: use "1". + ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet) (replace-match "1" nil nil bullet)) + ;; Not an ordered list: keep bullet. (t bullet))))))))) (mapc fix-bul (mapcar 'car struct)))) @@ -1911,13 +1958,47 @@ It determines the number of whitespaces to append by looking at " "))) nil nil bullet 1))) +(defun org-list-use-alpha-bul-p (first struct prevs) + "Can list starting at FIRST use alphabetical bullets? + +STRUCT is list structure. See `org-list-struct'. PREVS is the +alist of previous items. See `org-list-struct-prev-alist'." + (and org-alphabetical-lists + (catch 'exit + (let ((item first) (ascii 64) (case-fold-search nil)) + ;; Pretend that bullets are uppercase and checked if + ;; alphabet is sufficient, taking counters into account. + (while item + (let ((bul (org-list-get-bullet item struct)) + (count (org-list-get-counter item struct))) + ;; Virtually determine current bullet + (if (and count (string-match "[a-zA-Z]" count)) + ;; Counters are not case-sensitive. + (setq ascii (string-to-char (upcase count))) + (setq ascii (1+ ascii))) + ;; Test if bullet would be over z or Z. + (if (> ascii 90) + (throw 'exit nil) + (setq item (org-list-get-next-item item struct prevs))))) + ;; All items checked. All good. + t)))) + (defun org-list-inc-bullet-maybe (bullet) "Increment BULLET if applicable." - (if (string-match "[0-9]+" bullet) + (let ((case-fold-search nil)) + (cond + ;; Num bullet: increment it. + ((string-match "[0-9]+" bullet) (replace-match (number-to-string (1+ (string-to-number (match-string 0 bullet)))) - nil nil bullet) - bullet)) + nil nil bullet)) + ;; Alpha bullet: increment it. + ((string-match "[A-Za-z]" bullet) + (replace-match + (char-to-string (1+ (string-to-char (match-string 0 bullet)))) + nil nil bullet)) + ;; Unordered bullet: leave it. + (t bullet)))) (defun org-list-repair () "Make sure all items are correctly indented, with the right bullet. @@ -1944,25 +2025,40 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (let* ((struct (org-list-struct)) (parents (org-list-struct-parent-alist struct)) (prevs (org-list-struct-prev-alist struct)) - (list-beg (org-list-get-list-begin (point) struct prevs)) + (list-beg (org-list-get-first-item (point) struct prevs)) (bullet (org-list-get-bullet list-beg struct)) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) + (case-fold-search nil) (current (cond + ((string-match "[a-z]\\." bullet) "a.") + ((string-match "[a-z])" bullet) "a)") + ((string-match "[A-Z]\\." bullet) "A.") + ((string-match "[A-Z])" bullet) "A)") ((string-match "\\." bullet) "1.") ((string-match ")" bullet) "1)") (t (org-trim bullet)))) - (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) ;; Compute list of possible bullets, depending on context - (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)")))) + (bullet-list + (append '("-" "+" ) + ;; *-bullets are not allowed at column 0 + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) + ;; Description items cannot be numbered + (unless (or (eq org-plain-list-ordered-item-terminator ?\)) + (and bullet-rule-p (org-at-item-description-p))) + '("1.")) + (unless (or (eq org-plain-list-ordered-item-terminator ?.) + (and bullet-rule-p (org-at-item-description-p))) + '("1)")) + (unless (or (not alpha-p) + (eq org-plain-list-ordered-item-terminator ?\)) + (and bullet-rule-p (org-at-item-description-p))) + '("a." "A.")) + (unless (or (not alpha-p) + (eq org-plain-list-ordered-item-terminator ?.) + (and bullet-rule-p (org-at-item-description-p))) + '("a)" "A)")))) (len (length bullet-list)) (item-index (- len (length (member current bullet-list)))) (get-value (lambda (index) (nth (mod index len) bullet-list))) @@ -2006,7 +2102,7 @@ in subtree, ignoring drawers." ((org-region-active-p) (let ((limit (region-end))) (goto-char (region-beginning)) - (if (org-list-search-forward org-item-beginning-re limit t) + (if (org-list-search-forward (org-item-beginning-re) limit t) (setq lim-up (point-at-bol)) (error "No item in region")) (setq lim-down (copy-marker limit)))) @@ -2016,7 +2112,7 @@ in subtree, ignoring drawers." (forward-line 1) (when (looking-at org-drawer-regexp) (re-search-forward "^[ \t]*:END:" limit nil)) - (if (org-list-search-forward org-item-beginning-re limit t) + (if (org-list-search-forward (org-item-beginning-re) limit t) (setq lim-up (point-at-bol)) (error "No item in subtree")) (setq lim-down (copy-marker limit)))) @@ -2044,7 +2140,7 @@ in subtree, ignoring drawers." ;; list; 3. move point after the list. (goto-char lim-up) (while (and (< (point) lim-down) - (org-list-search-forward org-item-beginning-re + (org-list-search-forward (org-item-beginning-re) lim-down 'move)) (let* ((struct (org-list-struct)) (struct-copy (mapcar (lambda (e) (copy-alist e)) struct)) @@ -2118,7 +2214,7 @@ With optional prefix argument ALL, do this for the whole buffer." (interactive "P") (save-excursion (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (box-re "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") (recursivep (or (not org-hierarchical-checkbox-statistics) (string-match "\\" @@ -2410,7 +2506,8 @@ Point is left at list end." ;; determine type of list by getting info on item POS in ;; STRUCT. (lambda (pos struct) - (cond ((string-match "[0-9]" (org-list-get-bullet pos struct)) + (cond ((string-match "[[:alnum:]]" + (org-list-get-bullet pos struct)) 'ordered) ((org-list-get-tag pos struct) 'descriptive) (t 'unordered))))) @@ -2428,7 +2525,7 @@ Point is left at list end." (lambda (e) (let ((start (save-excursion (goto-char e) - (looking-at org-item-beginning-re) + (looking-at (org-item-beginning-re)) (match-end 0))) (childp (org-list-has-child-p e struct)) (end (org-list-get-item-end e struct))) @@ -2455,7 +2552,7 @@ Point is left at list end." (let ((text (org-trim (buffer-substring beg end)))) (if (and box (string-match - "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" + "^\\(?:\\[@\\(?:start:\\)?\\(?:[0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\[\\([xX ]\\)\\]" text)) (replace-match (if (equal (match-string 1 text) " ") "CBOFF" "CBON") @@ -2535,7 +2632,7 @@ this list." (top-point (progn (re-search-backward "#\\+ORGLST" nil t) - (re-search-forward org-item-beginning-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) diff --git a/lisp/org.el b/lisp/org.el index ed415e5d9..1cc7a6294 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17064,7 +17064,7 @@ an outline or item heading and it has a folded subtree below it, this function returns t, nil otherwise." (let ((re (cond ((eq what 'headlines) (concat "^" org-outline-regexp)) - ((eq what 'items) (concat "^" (org-item-re t))) + ((eq what 'items) (org-item-beginning-re)) (t (error "This should not happen")))) beg end) (save-excursion From cddea8c5422d7679db7ab2ef7f6da32bf90db55f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 17 Jan 2011 19:30:04 +0100 Subject: [PATCH 068/107] org-list: new accessor returning type of list * lisp/org-list.el (org-list-get-list-type): new function. (org-list-parse-list): use new function. * lisp/org-html.el (org-html-export-list-line): use new function. * lisp/org-docbook.el (org-export-docbook-list-line): use new function. --- lisp/org-docbook.el | 20 ++++++++++---------- lisp/org-html.el | 20 ++++++++++---------- lisp/org-list.el | 27 ++++++++++++++++----------- 3 files changed, 36 insertions(+), 31 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index 8190fff39..f2518cd4b 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1337,14 +1337,14 @@ modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type (function - ;; Return type of list containing element POS, among - ;; "ordered", "variable" or "itemized". - (lambda (pos) - (cond - ((string-match "[[:alnum:]]" (org-list-get-bullet pos struct)) - "ordered") - ((org-list-get-tag pos struct) "variable") - (t "itemized"))))) + ;; Translate type of list containing POS to "ordered", + ;; "variable" or "itemized". + (lambda (pos struct prevs) + (let ((type (org-list-get-list-type pos struct prevs))) + (cond + ((eq 'ordered type) "ordered") + ((eq 'descriptive type) "variable") + (t "itemized")))))) (get-closings (function ;; Return list of all items and sublists ending at POS, in @@ -1364,7 +1364,7 @@ the alist of previous items." (mapc (lambda (e) (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item))) + (type (funcall get-type first-item struct prevs))) ;; Ending for every item (org-export-docbook-close-para-maybe) (insert (if (equal type "variable") @@ -1389,7 +1389,7 @@ the alist of previous items." (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in ;; case list is ill-formed. - (type (funcall get-type list-beg)) + (type (funcall get-type list-beg struct prevs)) ;; Special variables for ordered lists. (order-type (let ((bullet (org-list-get-bullet list-beg struct))) (cond diff --git a/lisp/org-html.el b/lisp/org-html.el index 5889270f4..7411ea8d1 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2395,14 +2395,14 @@ modifications to buffer. STRUCT is the list structure. PREVS is the alist of previous items." (let* ((get-type (function - ;; Return type of list containing element POS, among "d", - ;; "o" or "u". - (lambda (pos) - (cond - ((string-match "[[:alnum:]]" (org-list-get-bullet pos struct)) - "o") - ((org-list-get-tag pos struct) "d") - (t "u"))))) + ;; Translate type of list containing POS to "d", "o" or + ;; "u". + (lambda (pos struct prevs) + (let ((type (org-list-get-list-type pos struct prevs))) + (cond + ((eq 'ordered type) "o") + ((eq 'descriptive type) "d") + (t "u")))))) (get-closings (function ;; Return list of all items and sublists ending at POS, in @@ -2422,7 +2422,7 @@ the alist of previous items." (mapc (lambda (e) (let* ((lastp (= (org-list-get-last-item e struct prevs) e)) (first-item (org-list-get-list-begin e struct prevs)) - (type (funcall get-type first-item))) + (type (funcall get-type first-item struct prevs))) (org-close-par-maybe) ;; Ending for every item (org-close-li type) @@ -2445,7 +2445,7 @@ the alist of previous items." (firstp (= list-beg pos)) ;; Always refer to first item to determine list type, in ;; case list is ill-formed. - (type (funcall get-type list-beg)) + (type (funcall get-type list-beg struct prevs)) ;; Special variables for ordered lists. (order-type (let ((bullet (org-list-get-bullet list-beg struct))) (cond diff --git a/lisp/org-list.el b/lisp/org-list.el index 29750f475..bfd22dcfb 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1389,6 +1389,21 @@ STRUCT is the structure of the list. PREVS is the alist of previous items. See `org-list-struct-prev-alist'." (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) +(defun org-list-get-list-type (item struct prevs) + "Return the type of the list containing ITEM as a symbol. + +STRUCT is the structure of the list, as returned by +`org-list-struct'. PREVS is the alist of previous items. See +`org-list-struct-prev-alist'. + +Possible types are `descriptive', `ordered' and `unordered'. The +type is determined by the first item of the list." + (let ((first (org-list-get-list-begin item struct prevs))) + (cond + ((org-list-get-tag first struct) 'descriptive) + ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + (t 'unordered)))) + (defun org-list-get-nth (n key struct) "Return the Nth value of KEY in STRUCT." (nth n (assq key struct))) @@ -2501,22 +2516,12 @@ Point is left at list end." (top (org-list-get-top-point struct)) (bottom (org-list-get-bottom-point struct)) out - (get-list-type - (function - ;; determine type of list by getting info on item POS in - ;; STRUCT. - (lambda (pos struct) - (cond ((string-match "[[:alnum:]]" - (org-list-get-bullet pos struct)) - 'ordered) - ((org-list-get-tag pos struct) 'descriptive) - (t 'unordered))))) (parse-sublist (function ;; return a list whose car is list type and cdr a list of ;; items' body. (lambda (e) - (cons (funcall get-list-type (car e) struct) + (cons (org-list-get-list-type (car e) struct prevs) (mapcar parse-item e))))) (parse-item (function From 212828c556acfef3ec95257a4baafe38db8a3554 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 17 Jan 2011 20:15:05 +0100 Subject: [PATCH 069/107] org-list: correctly handle counters in `org-list-parse-list' * lisp/org-list.el (org-at-item-counter-p): new function. (org-list-parse-list): handle counters and list depth. (org-list-to-generic): a special string is used when an item has a counter. (org-list-to-latex): use new special string for counters. This fixes the counter bug in LaTeX export, as the enumi counter was the only one modified. * lisp/org-latex.el (org-export-latex-lists): use new `org-list-parse-list' output. --- lisp/org-latex.el | 20 ------ lisp/org-list.el | 163 ++++++++++++++++++++++++++++++---------------- 2 files changed, 106 insertions(+), 77 deletions(-) diff --git a/lisp/org-latex.el b/lisp/org-latex.el index 73520effd..114cc39f6 100644 --- a/lisp/org-latex.el +++ b/lisp/org-latex.el @@ -2482,26 +2482,6 @@ The conversion is made depending of STRING-BEFORE and STRING-AFTER." (let ((org-list-end-re "^ORG-LIST-END\n")) (org-list-parse-list t))) org-export-latex-list-parameters)) - ;; Replace any counter with its latex expression in string. - ;; - ;; FIXME: enumi is for top list only. Sub-lists are using - ;; enumii, enumiii, enumiv. So, basically, using a - ;; counter within a sublist will break top-level - ;; item numbering. - (while (string-match - "^\\(\\\\item[ \t]+\\)\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Z-a-z]\\)\\]" - res) - (let ((count (match-string 2 res))) - (setq res (replace-match - (concat - ;; Filter out non-numeric counters, - ;; unsupported in standard LaTeX. - (if (save-match-data (string-match "[0-9]" count)) - (format "\\setcounter{enumi}{%d}\n" - (1- (string-to-number count))) - "") - (match-string 1 res)) - t t res)))) ;; Extend previous value of original-indentation to the ;; whole string (insert (org-add-props res nil 'original-indentation diff --git a/lisp/org-list.el b/lisp/org-list.el index bfd22dcfb..b32859a37 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -805,6 +805,12 @@ This checks `org-list-ending-method'." "Is point at a line starting a plain-list item with a checklet?" (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) +(defun org-at-item-counter-p () + "Is point at a line starting a plain-list item with a counter?" + (and (org-at-item-p) + (looking-at org-list-full-item-re) + (match-string 2))) + ;;; Navigate (defalias 'org-list-get-item-begin 'org-in-item-p) @@ -2491,8 +2497,9 @@ compare entries." Return a list whose car is a symbol of list type, among `ordered', `unordered' and `descriptive'. Then, each item is a -list whose elements are strings and other sub-lists. Inside -strings, checkboxes are replaced by \"[CBON]\" and \"[CBOFF]\". +list whose car is counter, and cdr are strings and other +sub-lists. Inside strings, checkboxes are replaced by \"[CBON]\" +and \"[CBOFF]\". For example, the following list: @@ -2500,14 +2507,17 @@ For example, the following list: + sub-item one + [X] sub-item two more text in first item -2. last item +2. [@3] last item will be parsed as: -\(ordered \(\"first item\" - \(unordered \(\"sub-item one\"\) \(\"[CBON] sub-item two\"\)\) - \"more text in first item\"\) - \(\"last item\"\)\) +\(ordered + \(nil \"first item\" + \(unordered + \(nil \"sub-item one\"\) + \(nil \"[CBON] sub-item two\"\)\) + \"more text in first item\"\) + \(3 \"last item\"\)\) Point is left at list end." (let* ((struct (org-list-struct)) @@ -2516,54 +2526,70 @@ Point is left at list end." (top (org-list-get-top-point struct)) (bottom (org-list-get-bottom-point struct)) out + (get-text + (function + ;; Return text between BEG and END, trimmed, with + ;; checkboxes replaced. + (lambda (beg end) + (let ((text (org-trim (buffer-substring beg end)))) + (if (string-match "\\`\\[\\([xX ]\\)\\]" text) + (replace-match + (if (equal (match-string 1 text) " ") "CBOFF" "CBON") + t nil text 1) + text))))) (parse-sublist (function - ;; return a list whose car is list type and cdr a list of + ;; Return a list whose car is list type and cdr a list of ;; items' body. (lambda (e) (cons (org-list-get-list-type (car e) struct prevs) (mapcar parse-item e))))) (parse-item (function - ;; return a list containing text and any sublist inside - ;; item. + ;; Return a list containing conter of item, if any, text + ;; and any sublist inside it. (lambda (e) (let ((start (save-excursion (goto-char e) - (looking-at (org-item-beginning-re)) + (or (org-at-item-counter-p) (org-at-item-p)) (match-end 0))) + ;; Get counter number. For alphabetic counter, get + ;; its position in the alphabet. + (counter (let ((c (org-list-get-counter e struct))) + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c)))))) (childp (org-list-has-child-p e struct)) (end (org-list-get-item-end e struct))) + ;; If item has a child, store text between bullet and + ;; next child, then recursively parse all sublists. At + ;; the end of each sublist, check for the presence of + ;; text belonging to the original item. (if childp (let* ((children (org-list-get-children e struct parents)) - (body (list (funcall get-text start childp t)))) + (body (list (funcall get-text start childp)))) (while children (let* ((first (car children)) (sub (org-list-get-all-items first struct prevs)) (last-c (car (last sub))) (last-end (org-list-get-item-end last-c struct))) (push (funcall parse-sublist sub) body) + ;; Remove children from the list just parsed. (setq children (cdr (member last-c children))) + ;; There is a chunk of text belonging to the + ;; item if last child doesn't end where next + ;; child starts or where item ends. (unless (= (or (car children) end) last-end) - (push (funcall get-text last-end (or (car children) end) nil) + (push (funcall get-text + last-end (or (car children) end)) body)))) - (nreverse body)) - (list (funcall get-text start end t))))))) - (get-text - (function - ;; return text between BEG and END, trimmed, with - ;; checkboxes replaced if BOX is true. - (lambda (beg end box) - (let ((text (org-trim (buffer-substring beg end)))) - (if (and box - (string-match - "^\\(?:\\[@\\(?:start:\\)?\\(?:[0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\[\\([xX ]\\)\\]" - text)) - (replace-match - (if (equal (match-string 1 text) " ") "CBOFF" "CBON") - t nil text 1) - text)))))) - ;; store output, take care of cursor position and deletion of + (cons counter (nreverse body))) + (list counter (funcall get-text start end)))))))) + ;; Store output, take care of cursor position and deletion of ;; list, then return output. (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) (goto-char top) @@ -2684,15 +2710,23 @@ Valid parameters PARAMS are :splice When set to t, return only list body lines, don't wrap them into :[u/o]start and :[u/o]end. Default is nil. -:istart String to start a list item +:istart String to start a list item. +:icount String to start an item with a counter. :iend String to end a list item :isep String to separate items :lsep String to separate sublists :cboff String to insert for an unchecked checkbox -:cbon String to insert for a checked checkbox" +:cbon String to insert for a checked checkbox + +Alternatively, each parameter can also be a form returning a +string. These sexp can use keywords `counter' and `depth', +reprensenting respectively counter associated to the current +item, and depth of the current sub-list, starting at 0. +Obviously, `counter' is only available for parameters applying to +items." (interactive) - (let* ((p params) sublist + (let* ((p params) (splicep (plist-get p :splice)) (ostart (plist-get p :ostart)) (oend (plist-get p :oend)) @@ -2705,6 +2739,7 @@ Valid parameters PARAMS are (ddstart (plist-get p :ddstart)) (ddend (plist-get p :ddend)) (istart (plist-get p :istart)) + (icount (plist-get p :icount)) (iend (plist-get p :iend)) (isep (plist-get p :isep)) (lsep (plist-get p :lsep)) @@ -2712,14 +2747,19 @@ Valid parameters PARAMS are (cboff (plist-get p :cboff)) (export-item (function - ;; Export an item ITEM of type TYPE. First string in item - ;; is treated in a special way as it can bring extra - ;; information that needs to be processed. - (lambda (item type) - (let ((fmt (if (eq type 'descriptive) - (concat (org-trim istart) "%s" ddend iend isep) - (concat istart "%s" iend isep))) - (first (car item))) + ;; Export an item ITEM of type TYPE, at DEPTH. First string + ;; in item is treated in a special way as it can bring + ;; extra information that needs to be processed. + (lambda (item type depth) + (let* ((counter (pop item)) + (fmt (cond + ((eq type 'descriptive) + (mapconcat 'eval `(,(org-trim istart) + "%s" ,ddend ,iend ,isep) "")) + ((and counter (eq type 'ordered)) + (mapconcat 'eval `(,icount "%s" ,iend ,isep) "")) + (t (mapconcat 'eval `(,istart "%s" ,iend ,isep) "")))) + (first (car item))) ;; Replace checkbox if any is found. (cond ((string-match "\\[CBON\\]" first) @@ -2731,31 +2771,33 @@ Valid parameters PARAMS are ;; Insert descriptive term if TYPE is `descriptive'. (when (and (eq type 'descriptive) (string-match "^\\(.*\\)[ \t]+::" first)) - (setq first (concat - dtstart (org-trim (match-string 1 first)) dtend - ddstart (org-trim (substring first (match-end 0)))))) + (setq first (mapconcat + 'eval + `(,dtstart ,(org-trim (match-string 1 first)) ,dtend + ,ddstart ,(org-trim (substring first (match-end 0))))))) (setcar item first) - (format fmt (mapconcat - (lambda (e) - (if (stringp e) e (funcall export-sublist e))) - item isep)))))) + (format fmt + (mapconcat (lambda (e) + (if (stringp e) e + (funcall export-sublist e (1+ depth)))) + item isep)))))) (export-sublist (function - ;; Export sublist SUB - (lambda (sub) + ;; Export sublist SUB at DEPTH + (lambda (sub depth) (let* ((type (car sub)) (items (cdr sub)) (fmt (cond (splicep "%s") ((eq type 'ordered) - (concat ostart "\n%s" oend)) + (mapconcat 'eval `(,ostart "\n%s" ,oend) "")) ((eq type 'descriptive) - (concat dstart "\n%s" dend)) - (t (concat ustart "\n%s" uend))))) - (format fmt (mapconcat - (lambda (e) (funcall export-item e type)) - items lsep))))))) - (concat (funcall export-sublist list) "\n"))) + (mapconcat 'eval `(,dstart "\n%s" ,dend) "")) + (t (mapconcat 'eval `(,ustart "\n%s" ,uend) ""))))) + (format fmt (mapconcat (lambda (e) + (funcall export-item e type depth)) + items lsep))))))) + (concat (funcall export-sublist list 0) "\n"))) (defun org-list-to-latex (list &optional params) "Convert LIST into a LaTeX list. @@ -2770,6 +2812,11 @@ with overruling parameters for `org-list-to-generic'." :dtstart "[" :dtend "] " :ddstart "" :ddend "" :istart "\\item " :iend "" + :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) + (if enum + (format "\\setcounter{enum%s}{%s}\n\\item " + enum counter) + "\\item ")) :isep "\n" :lsep "\n" :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}") params))) @@ -2787,6 +2834,7 @@ with overruling parameters for `org-list-to-generic'." :dtstart "
      " :dtend "
      " :ddstart "
      " :ddend "
      " :istart "
    1. " :iend "
      2. " + :icount (format "
    2. " counter) :isep "\n" :lsep "\n" :cbon "[X]" :cboff "[ ]") params))) @@ -2804,6 +2852,7 @@ with overruling parameters for `org-list-to-generic'." :dtstart " " :dtend "\n" :ddstart "" :ddend "" :istart "@item\n" :iend "" + :icount "@item\n" :isep "\n" :lsep "\n" :cbon "@code{[X]}" :cboff "@code{[ ]}") params))) From 4636453e93ded40507205faa5b2607f9493e5ed2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 18 Jan 2011 22:36:49 +0100 Subject: [PATCH 070/107] Do not enforce type of ordered lists upon exporting * lisp/org-docbook.el (org-export-docbook-list-line): even with alphabetical lists, Org shouldn't enforce a particular list type to exporters. This is a job for style files. * lisp/org-html.el (org-html-export-list-line): ib idem. --- lisp/org-docbook.el | 18 ++++-------------- lisp/org-html.el | 18 +++--------------- 2 files changed, 7 insertions(+), 29 deletions(-) diff --git a/lisp/org-docbook.el b/lisp/org-docbook.el index f2518cd4b..256bafec3 100644 --- a/lisp/org-docbook.el +++ b/lisp/org-docbook.el @@ -1391,27 +1391,17 @@ the alist of previous items." ;; case list is ill-formed. (type (funcall get-type list-beg struct prevs)) ;; Special variables for ordered lists. - (order-type (let ((bullet (org-list-get-bullet list-beg struct))) - (cond - ((not (equal type "ordered")) nil) - ((string-match "[a-z]" bullet) "loweralpha") - ((string-match "[A-Z]" bullet) "upperalpha") - (t "arabic")))) (counter (let ((count-tmp (org-list-get-counter pos struct))) (cond ((not count-tmp) nil) - ((and (member order-type '("loweralpha" "upperalpha")) - (string-match "[A-Za-z]" count-tmp)) - count-tmp) - ((and (equal order-type "arabic") - (string-match "[0-9]+" count-tmp)) + ((string-match "[A-Za-z]" count-tmp) + (- (string-to-char (upcase count-tmp)) 64)) + ((string-match "[0-9]+" count-tmp) count-tmp))))) ;; When FIRSTP, a new list or sub-list is starting. (when firstp (org-export-docbook-close-para-maybe) - (insert (if (equal type "ordered") - (concat "\n") - (format "<%slist>\n" type)))) + (insert (format "<%slist>\n" type))) (insert (cond ((equal type "variable") (format "%s" desc-tag)) diff --git a/lisp/org-html.el b/lisp/org-html.el index 7411ea8d1..4a6bde98b 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2446,28 +2446,16 @@ the alist of previous items." ;; Always refer to first item to determine list type, in ;; case list is ill-formed. (type (funcall get-type list-beg struct prevs)) - ;; Special variables for ordered lists. - (order-type (let ((bullet (org-list-get-bullet list-beg struct))) - (cond - ((not (equal type "o")) nil) - ((string-match "[a-z]" bullet) "a") - ((string-match "[A-Z]" bullet) "A") - (t "1")))) (counter (let ((count-tmp (org-list-get-counter pos struct))) (cond ((not count-tmp) nil) - ((and (member order-type '("a" "A")) - (string-match "[A-Za-z]" count-tmp)) + ((string-match "[A-Za-z]" count-tmp) (- (string-to-char (upcase count-tmp)) 64)) - ((and (equal order-type "1") - (string-match "[0-9]+" count-tmp)) + ((string-match "[0-9]+" count-tmp) count-tmp))))) (when firstp (org-close-par-maybe) - ;; Treat ordered lists differently because of ORDER-TYPE. - (insert (if (equal type "o") - (concat "
        \n") - (format "<%sl>\n" type)))) + (insert (format "<%sl>\n" type))) (insert (cond ((equal type "d") (format "
        %s
        \n" desc-tag)) From 3e274d0290ee0d72c79bb8d0c9e96731547c8014 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 19 Jan 2011 13:58:47 +0100 Subject: [PATCH 071/107] org-list: small refactoring and comments improvements --- lisp/org-list.el | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index b32859a37..91467ce00 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -364,13 +364,13 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (save-excursion (beginning-of-line) (let* ((outline-regexp (org-get-limited-outline-regexp)) - ;; can't use org-drawers-regexp as this function might be + ;; Can't use org-drawers-regexp as this function might be ;; called in buffers not in Org mode (drawers-re (concat "^[ \t]*:\\(" (mapconcat 'regexp-quote org-drawers "\\|") "\\):[ \t]*$")) (case-fold-search t) - ;; compute position of surrounding headings. this is the + ;; Compute position of surrounding headings. This is the ;; default context. (heading (save-excursion @@ -383,7 +383,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." nil))) (prev-head (car heading)) (next-head (nth 1 heading)) - ;; Are we strictly inside a drawer? + ;; Is point inside a drawer? (drawerp (when (and (org-in-regexps-block-p drawers-re "^[ \t]*:END:" prev-head) @@ -400,7 +400,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (1- (point-at-bol)) next-head) 'drawer)))) - ;; Are we strictly in a block, and of which type? + ;; Is point strictly in a block, and of which type? (blockp (save-excursion (when (and (org-in-regexps-block-p @@ -422,7 +422,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." org-list-forbidden-blocks) 'invalid 'block))))) - ;; Are we in an inlinetask? + ;; Is point in an inlinetask? (inlinetaskp (when (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p) @@ -436,7 +436,7 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." (forward-line -1) (1- (point-at-bol))) 'inlinetask)))) - ;; list actual candidates + ;; List actual candidates (context-list (delq nil (list heading drawerp blockp inlinetaskp)))) ;; Return the closest context around @@ -1252,10 +1252,10 @@ This function modifies STRUCT." (lambda (elt) (let ((pos (car elt)) (ind (nth 1 elt))) - ;; remove end candidates behind current item + ;; Remove end candidates behind current item (while (or (<= (cdar endings) pos)) (pop endings)) - ;; add end position to item assoc + ;; Add end position to item assoc (let ((old-end (nthcdr 6 elt)) (new-end (assoc-default ind endings '<=))) (if old-end @@ -1337,7 +1337,7 @@ STRUCT is the list structure considered." (defun org-list-get-all-items (item struct prevs) "List of items in the same sub-list as ITEM in STRUCT. -PREVS, when provided, is the alist of previous items. See +PREVS is the alist of previous items. See `org-list-struct-prev-alist'." (let ((prev-item item) (next-item item) @@ -1482,7 +1482,9 @@ This function modifies STRUCT." (let* ((prev (org-list-get-prev-item item struct prevs)) (prev-bul (and prev (org-list-get-bullet prev struct))) (counter (org-list-get-counter item struct)) - (bullet (org-list-get-bullet item struct))) + (bullet (org-list-get-bullet item struct)) + (alphap (and (not prev) + (org-list-use-alpha-bul-p item struct prevs)))) (org-list-set-bullet item struct (org-list-bullet-string @@ -1521,12 +1523,10 @@ This function modifies STRUCT." (string-match "[0-9]+" bullet)) (replace-match counter nil nil bullet)) ;; First bullet is alpha uppercase: use "A". - ((and (org-list-use-alpha-bul-p item struct prevs) - (string-match "[A-Z]" bullet)) + ((and alphap (string-match "[A-Z]" bullet)) (replace-match "A" nil nil bullet)) ;; First bullet is alpha lowercase: use "a". - ((and (org-list-use-alpha-bul-p item struct prevs) - (string-match "[a-z]" bullet)) + ((and alphap (string-match "[a-z]" bullet)) (replace-match "a" nil nil bullet)) ;; First bullet is num: use "1". ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet) @@ -2143,7 +2143,7 @@ in subtree, ignoring drawers." (setq lim-up (point-at-bol) lim-down (point-at-eol))) (t (error "Not at an item or heading, and no active region")))) - ;; determine the checkbox going to be applied to all items + ;; Determine the checkbox going to be applied to all items ;; within bounds (ref-checkbox (progn From 4efa974264b95673701e3ab55b6fd92df4c72763 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 19 Jan 2011 16:47:36 +0100 Subject: [PATCH 072/107] Fix for `org-beginning-of-line' at an item * lisp/org.el (org-beginning-of-line): apply changes to `org-item-beginning-re' to correct sub-expression reference. --- lisp/org.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 1cc7a6294..f0469eeb5 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -19104,12 +19104,12 @@ beyond the end of the headline." ((org-at-item-p) (goto-char (if (eq special t) - (cond ((> pos (match-end 4)) (match-end 4)) - ((= pos (point)) (match-end 4)) + (cond ((> pos (match-end 0)) (match-end 0)) + ((= pos (point)) (match-end 0)) (t (point))) (cond ((> pos (point)) (point)) ((not (eq last-command this-command)) (point)) - (t (match-end 4)))))))) + (t (match-end 0)))))))) (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t))))) From e7ca7c98dddbdd72ceb39b518df3fe517af9fa30 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 20 Jan 2011 16:32:30 +0100 Subject: [PATCH 073/107] org-list: modifications to org-list-to-generic * lisp/org-list.el (org-list-make-subtree): function now uses org-list-parse-list mechanism. (org-list-make-subtrees): removed function. (org-list-to-generic): added a parameter and every parameter can be a sexp returning a string, for finer control. (org-list-to-html, org-list-to-latex, org-list-to-texinfo): slight modifications to apply changes to org-list-to-generic. (org-list-to-subtree): new function. --- lisp/org-list.el | 120 +++++++++++++++++++++++++++-------------------- 1 file changed, 69 insertions(+), 51 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 91467ce00..9fb658f8d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2605,25 +2605,8 @@ Point is left at list end." (interactive) (if (not (ignore-errors (goto-char (org-in-item-p)))) (error "Not in a list") - (let ((list (org-list-parse-list t)) nstars) - (save-excursion - (if (ignore-errors (org-back-to-heading)) - (progn (looking-at org-complex-heading-regexp) - (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." - (if (symbolp (car list)) - (org-list-make-subtrees (cdr list) level) - (mapcar (lambda (item) - (if (stringp item) - (insert (make-string - (if org-odd-levels-only - (1- (* 2 level)) level) ?*) " " item "\n") - (org-list-make-subtrees item (1+ level)))) - list))) + (let ((list (save-excursion (org-list-parse-list t)))) + (insert (org-list-to-subtree list))))) (defun org-list-insert-radio-list () "Insert a radio list template appropriate for this major mode." @@ -2715,6 +2698,7 @@ Valid parameters PARAMS are :iend String to end a list item :isep String to separate items :lsep String to separate sublists +:csep String to separate text from a sub-list :cboff String to insert for an unchecked checkbox :cbon String to insert for a checked checkbox @@ -2743,6 +2727,7 @@ items." (iend (plist-get p :iend)) (isep (plist-get p :isep)) (lsep (plist-get p :lsep)) + (csep (plist-get p :csep)) (cbon (plist-get p :cbon)) (cboff (plist-get p :cboff)) (export-item @@ -2752,13 +2737,14 @@ items." ;; extra information that needs to be processed. (lambda (item type depth) (let* ((counter (pop item)) - (fmt (cond - ((eq type 'descriptive) - (mapconcat 'eval `(,(org-trim istart) - "%s" ,ddend ,iend ,isep) "")) - ((and counter (eq type 'ordered)) - (mapconcat 'eval `(,icount "%s" ,iend ,isep) "")) - (t (mapconcat 'eval `(,istart "%s" ,iend ,isep) "")))) + (fmt (concat (cond + ((eq type 'descriptive) + (concat (org-trim (eval istart)) "%s" + (eval ddend))) + ((and counter (eq type 'ordered)) + (concat (eval icount) "%s")) + (t (concat (eval istart) "%s"))) + (eval iend))) (first (car item))) ;; Replace checkbox if any is found. (cond @@ -2771,32 +2757,33 @@ items." ;; Insert descriptive term if TYPE is `descriptive'. (when (and (eq type 'descriptive) (string-match "^\\(.*\\)[ \t]+::" first)) - (setq first (mapconcat - 'eval - `(,dtstart ,(org-trim (match-string 1 first)) ,dtend - ,ddstart ,(org-trim (substring first (match-end 0))))))) + (setq first (concat + (eval dtstart) (org-trim (match-string 1 first)) + (eval dtend) (eval ddstart) + (org-trim (substring first (match-end 0))) ""))) (setcar item first) (format fmt (mapconcat (lambda (e) (if (stringp e) e (funcall export-sublist e (1+ depth)))) - item isep)))))) + item (or (eval csep) ""))))))) (export-sublist (function ;; Export sublist SUB at DEPTH (lambda (sub depth) (let* ((type (car sub)) (items (cdr sub)) - (fmt (cond - (splicep "%s") - ((eq type 'ordered) - (mapconcat 'eval `(,ostart "\n%s" ,oend) "")) - ((eq type 'descriptive) - (mapconcat 'eval `(,dstart "\n%s" ,dend) "")) - (t (mapconcat 'eval `(,ustart "\n%s" ,uend) ""))))) + (fmt (concat (cond + (splicep "%s") + ((eq type 'ordered) + (concat (eval ostart) "\n%s" (eval oend))) + ((eq type 'descriptive) + (concat (eval dstart) "\n%s" (eval dend))) + (t (concat (eval ustart) "\n%s" (eval uend)))) + (eval lsep)))) (format fmt (mapconcat (lambda (e) (funcall export-item e type depth)) - items lsep))))))) + items (or (eval isep) "")))))))) (concat (funcall export-sublist list 0) "\n"))) (defun org-list-to-latex (list &optional params) @@ -2806,18 +2793,17 @@ with overruling parameters for `org-list-to-generic'." (org-list-to-generic list (org-combine-plists - '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" + '(:splice nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}" :ustart "\\begin{itemize}" :uend "\\end{itemize}" :dstart "\\begin{description}" :dend "\\end{description}" :dtstart "[" :dtend "] " - :ddstart "" :ddend "" - :istart "\\item " :iend "" + :istart "\\item " :iend "\n" :icount (let ((enum (nth depth '("i" "ii" "iii" "iv")))) (if enum (format "\\setcounter{enum%s}{%s}\n\\item " enum counter) "\\item ")) - :isep "\n" :lsep "\n" + :csep "\n" :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}") params))) @@ -2828,14 +2814,14 @@ with overruling parameters for `org-list-to-generic'." (org-list-to-generic list (org-combine-plists - '(:splicep nil :ostart "
          " :oend "
        " - :ustart "
          " :uend "
        " + '(:splice nil :ostart "
          " :oend "\n
        " + :ustart "
          " :uend "\n
        " :dstart "
        " :dend "
        " - :dtstart "
        " :dtend "
        " + :dtstart "
        " :dtend "
        \n" :ddstart "
        " :ddend "
        " :istart "
      1. " :iend "
        2. " :icount (format "
      2. " counter) - :isep "\n" :lsep "\n" + :isep "\n" :lsep "\n" :csep "\n" :cbon "[X]" :cboff "[ ]") params))) @@ -2846,17 +2832,49 @@ with overruling parameters for `org-list-to-generic'." (org-list-to-generic list (org-combine-plists - '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize" + '(:splice nil :ostart "@itemize @minus" :oend "@end itemize" :ustart "@enumerate" :uend "@end enumerate" :dstart "@table @asis" :dend "@end table" :dtstart " " :dtend "\n" - :ddstart "" :ddend "" - :istart "@item\n" :iend "" + :istart "@item\n" :iend "\n" :icount "@item\n" - :isep "\n" :lsep "\n" + :csep "\n" :cbon "@code{[X]}" :cboff "@code{[ ]}") params))) +(defun org-list-to-subtree (list &optional params) + "Convert LIST into an Org subtree. +LIST is as returned by `org-list-parse-list'. PARAMS is a property list +with overruling parameters for `org-list-to-generic'." + (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) + (level (or (org-current-level) 0)) + (blankp (or (eq rule t) + (and (eq rule 'auto) + (save-excursion + (outline-previous-heading) + (org-previous-line-empty-p))))) + (get-stars + (function + ;; Return the string for the heading, depending on depth D + ;; of current sub-list. + (lambda (d) + (concat + (make-string (+ level + (if org-odd-levels-only (* 2 (1+ d)) (1+ d))) + ?*) + " "))))) + (org-list-to-generic + list + (org-combine-plists + '(:splice t + :dtstart " " :dtend " " + :istart (funcall get-stars depth) + :icount (funcall get-stars depth) + :isep (if blankp "\n\n" "\n") + :csep (if blankp "\n\n" "\n") + :cbon "DONE" :cboff "TODO") + params)))) + (provide 'org-list) ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8 From a02d2ad13e037d1626ba3dc3f488a87dc7df98cf Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 20 Jan 2011 17:20:16 +0100 Subject: [PATCH 074/107] org-list: separate tasks needed to insert a new item more clearly * lisp/org-list.el (org-list-insert-item-generic): change arguments. The function now accepts structure and previous items alist. This allow to insert an item programmatically more easily. (org-insert-item): Apply changes to org-list-insert-item-generic. The function now takes care about repairing structure and updating checkboxes. * lisp/org-timer.el (org-timer-item): Apply changes to org-list-insert-item-generic. The function now takes care about repairing structure. --- lisp/org-list.el | 62 ++++++++++++++++++++++++++--------------------- lisp/org-timer.el | 14 ++++++++--- 2 files changed, 44 insertions(+), 32 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 9fb658f8d..c7d0fd8ca 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -525,23 +525,26 @@ some heuristics to guess the result." ;; No parent: no blank line. (t 0)))))))) -(defun org-list-insert-item-generic (pos &optional checkbox after-bullet) +(defun org-list-insert-item-generic (pos struct prevs &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. +STRUCT is the list structure, as returned by `org-list-struct'. +PREVS is the the alist of previous items. See +`org-list-struct-prev-alist'. + 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." +function ends. + +Return the new structure of the list." (let ((case-fold-search t)) ;; 1. Get information about list: structure, usual helper ;; functions, position of point with regards to item start ;; (BEFOREP), blank lines number separating items (BLANK-NB), ;; position of split (POS) if we're allowed to (SPLIT-LINE-P). - (let* ((pos (point)) - (item (goto-char (org-list-get-item-begin))) - (struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) + (let* ((item (goto-char (org-list-get-item-begin))) (item-end (org-list-get-item-end item struct)) (item-end-no-blank (org-list-get-item-end-before-blank item struct)) (beforep (and (looking-at org-list-full-item-re) @@ -620,10 +623,8 @@ function ends." (t (setcar e (+ p size-offset)) (setcar (nthcdr 6 e) (+ end size-offset)))))) struct) - (setq struct (sort - (cons (list item ind bullet nil box nil (+ item item-size)) - struct) - (lambda (e1 e2) (< (car e1) (car e2))))) + (push (list item ind bullet nil box nil (+ item item-size)) struct) + (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) ;; 6. If not BEFOREP, new item must appear after ITEM, so ;; exchange ITEM with the next item in list. Position cursor ;; after bullet, counter, checkbox, and label. @@ -632,11 +633,7 @@ function ends." (setq struct (org-list-exchange-items item (+ item item-size) struct)) (goto-char (org-list-get-next-item item struct (org-list-struct-prev-alist struct)))) - (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) - (when checkbox (org-update-checkbox-count-maybe)) - (looking-at org-list-full-item-re) - (goto-char (match-end 0)) - t))) + struct))) (defvar org-last-indent-begin-marker (make-marker)) (defvar org-last-indent-end-marker (make-marker)) @@ -1008,7 +1005,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." - (let ((itemp (org-in-item-p))) + (let ((itemp (org-in-item-p)) + (pos (point))) + ;; If cursor isn't is a list or if list is invisible, return nil. (unless (or (not itemp) (save-excursion (goto-char itemp) @@ -1018,18 +1017,25 @@ item is invisible." (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 (goto-char itemp) - (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 - (or (not desc-text) - (not (cdr (assq 'checkbox org-list-automatic-rules))))) - desc-text)))))) + (goto-char itemp) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + ;; If we're in a description list, ask for the new term. + (desc (when (org-list-get-tag itemp struct) + (concat (read-string "Term: ") " :: "))) + ;; Don't insert a checkbox if checkbox rule is applied + ;; and it is a description item. + (checkp (and checkbox + (or (not desc) + (not (cdr (assq 'checkbox + org-list-automatic-rules))))))) + (setq struct + (org-list-insert-item-generic pos struct prevs checkp desc)) + (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) + (when checkp (org-update-checkbox-count-maybe)) + (looking-at org-list-full-item-re) + (goto-char (match-end 0)) + t))))) ;;; Structures diff --git a/lisp/org-timer.el b/lisp/org-timer.el index d3b2572f1..9a804f363 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -209,14 +209,20 @@ it in the buffer." (interactive "P") (let ((itemp (org-in-item-p))) (cond - ;; In a timer list, insert with `org-list-insert-item-generic'. + ;; In a timer list, insert with `org-list-insert-item-generic', + ;; then fix the list. ((and itemp (save-excursion (goto-char itemp) (org-at-item-timer-p))) - (org-list-insert-item-generic - (point) nil (concat (org-timer (when arg '(4)) t) ":: "))) + (let* ((struct (org-list-struct)) + (prevs (org-list-struct-prev-alist struct)) + (s (concat (org-timer (when arg '(4)) t) ":: "))) + (setq struct (org-list-insert-item-generic (point) struct prevs nil s)) + (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) + (looking-at org-list-full-item-re) + (goto-char (match-end 0)))) ;; In a list of another type, don't break anything: throw an error. (itemp (error "This is not a timer list")) - ;; Else, insert the timer correctly indented at bol. + ;; Else, start a new list. (t (beginning-of-line) (org-indent-line-function) From bd68169b4b6676d2a40c858f58a0e2ac842c588d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 20 Jan 2011 19:28:23 +0100 Subject: [PATCH 075/107] org-list: reorder file, rename functions, improve comments * lisp/ob.el (org-babel-result-end): apply renaming. * lisp/org-exp.el (org-export-mark-list-properties): apply renaming. * lisp/org-list.el (org-list-prevs-alist): renamed from org-list-struct-prev-alist. (org-list-parents-alist): renamed from org-list-struct-parent-alist. (org-list-write-struct): renamed from org-list-struct-fix-struct. (org-list-parse-list, org-sort-list, org-list-indent-item-generic, org-toggle-checkbox, org-update-checkbox-count, org-cycle-list-bullet, org-list-repair, org-insert-item, org-move-item-up, org-move-item-up, org-move-item-down, org-next-item, org-previous-item, org-end-of-item-list, org-beginning-of-item-list, org-apply-on-list): apply renaming. (org-get-bullet): removed function, as it is not needed anymore. --- lisp/ob.el | 4 +- lisp/org-exp.el | 2 +- lisp/org-list.el | 2158 +++++++++++++++++++++++---------------------- lisp/org-timer.el | 8 +- lisp/org.el | 10 +- 5 files changed, 1102 insertions(+), 1080 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index e0949fcb9..88226e873 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -77,7 +77,7 @@ (declare-function org-list-parse-list "org-list" (&optional delete)) (declare-function org-list-to-generic "org-list" (LIST PARAMS)) (declare-function org-list-struct "org-list" ()) -(declare-function org-list-struct-prev-alist "org-list" (struct)) +(declare-function org-list-prevs-alist "org-list" (struct)) (declare-function org-list-get-list-end "org-list" (item struct prevs)) (defgroup org-babel nil @@ -1585,7 +1585,7 @@ code ---- the results are extracted in the syntax of the source (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) ((org-at-item-p) (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct))) + (prevs (org-list-prevs-alist struct))) (org-list-get-list-end (point-at-bol) struct prevs))) (t (let ((case-fold-search t) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index d90258f89..ce7ac4ae1 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1718,7 +1718,7 @@ These special properties will later be interpreted by the backend." (let* ((struct (org-list-struct)) (top (org-list-get-top-point struct)) (bottom (org-list-get-bottom-point struct)) - (prevs (org-list-struct-prev-alist struct)) + (prevs (org-list-prevs-alist struct)) poi) ;; Get every item and ending position, without dups and ;; without bottom point of list. diff --git a/lisp/org-list.el b/lisp/org-list.el index c7d0fd8ca..26cb34a8e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -34,25 +34,44 @@ ;; `org-list-struct'). ;; Once the list structure is stored, it is possible to make changes -;; directly on it or get useful information on the list, with helper -;; functions `org-list-struct-parent-alist' and -;; `org-list-struct-prev-alist', and using accessors provided in the -;; file. +;; directly on it or get useful information about the list, with the +;; two helper functions, namely `org-list-parents-alist' and +;; `org-list-prevs-alist', and using accessors or methods. -;; Structure is repaired with `org-list-struct-fix-struct'. Then -;; changes are applied to buffer with `org-list-struct-apply-struct'. +;; Structure is eventually applied to the buffer with +;; `org-list-write-struct'. This function repairs (bullets, +;; indentation, checkboxes) the structure before applying it. It +;; should be called near the end of any function working on +;; structures. + +;; Thus, a function applying to lists should usually follow this +;; template: -;; So any function working on plain lists should follow this template: ;; 1. Verify point is in a list and grab item beginning (with the same -;; function `org-in-item-p') ; -;; 2. Get list structure ; -;; 3. Compute one, or both, helper functions depending on required -;; accessors ; -;; 4. Proceed with the modifications ; -;; 5. Then fix the structure one last time and apply it on buffer. +;; function `org-in-item-p'). If the function requires the cursor +;; to be at item's bullet, `org-at-item-p' is more selective. If +;; the cursor is amidst the buffer, it is possible to find the +;; closest item with `org-list-search-backward', or +;; `org-list-search-forward', applied to `org-item-beginning-re'. -;; It is usally a bad idea to use directly an interactive function -;; inside a function, as those read the whole list structure another +;; 2. Get list structure with `org-list-struct'. + +;; 3. Compute one, or both, helper functions, +;; (`org-list-parents-alist', `org-list-prevs-alist') depending on +;; needed accessors. + +;; 4. Proceed with the modifications, using methods and accessors. + +;; 5. Verify and apply structure to buffer, using +;; `org-list-write-struct'. Possibly use +;; `org-update-checkbox-count-maybe' if checkboxes might have been +;; modified. + +;; Computing a list structure can be a costly operation on huge lists +;; (a few thousand lines long). Thus, code should follow the rule : +;; "collect once, use many". As a corollary, it is usally a bad idea +;; to use directly an interactive function inside the code, as those, +;; being independant entities, read the whole list structure another ;; time. ;;; Code: @@ -97,6 +116,8 @@ (declare-function outline-next-heading "outline" ()) (declare-function outline-previous-heading "outline" ()) +;;; Configuration variables + (defgroup org-plain-lists nil "Options concerning plain lists in Org-mode." :tag "Org Plain lists" @@ -180,7 +201,8 @@ the safe choice." (defcustom org-alphabetical-lists nil "Non-nil means single character alphabetical bullets are allowed. Both uppercase and lowercase are handled. Lists with more than 26 -items will fallback to standard numbering." +items will fallback to standard numbering. Alphabetical counters +like \"[@c]\" will be recognized." :group 'org-plain-lists :type 'boolean) @@ -260,11 +282,17 @@ indent when non-nil, indenting or outdenting list top-item (choice (const :tag "Bullet" bullet) (const :tag "Checkbox" checkbox) - (const :tag "Indent" indent) - (const :tag "Insert" insert)) + (const :tag "Indent" indent)) :value-type (boolean :tag "Activate" :value t))) +(defvar org-checkbox-statistics-hook nil + "Hook that is run whenever Org thinks checkbox statistics should be updated. +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.") + (defcustom org-hierarchical-checkbox-statistics t "Non-nil means checkbox statistics counts only the state of direct children. When nil, all boxes below the cookie are counted. @@ -318,7 +346,8 @@ Valid types are `drawer', `inlinetask' and `block'. More specifically, type `block' is determined by the variable `org-list-forbidden-blocks'.") -;;; Internal functions + +;;; Predicates and regexps (defconst org-list-end-re (if org-empty-line-terminates-plain-lists "^[ \t]*\n" @@ -326,6 +355,17 @@ specifically, type `block' is determined by the variable "Regex corresponding to the end of a list. It depends on `org-empty-line-terminates-plain-lists'.") +(defconst org-list-full-item-re + (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?" + "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" + "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?") + "Matches a list item and puts everything into groups: +group 1: bullet +group 2: counter +group 3: checkbox +group 4: description tag") + (defun org-item-re () "Return the correct regular expression for plain lists." (let ((term (cond @@ -341,25 +381,105 @@ It depends on `org-empty-line-terminates-plain-lists'.") "Regexp matching the beginning of a plain list item." (concat "^" (org-item-re))) -(defconst org-list-full-item-re - (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?" - "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" - "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?") - "Matches a list item and puts everything into groups: -group 1: bullet -group 2: counter -group 3: checkbox -group 4: description tag") +(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)) + ;; Ignore counter if any + (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?") + (goto-char (match-end 0))) + (looking-at regexp)))) + +(defun org-in-item-p () + "Return item beginning position when in a plain list, nil otherwise. +This checks `org-list-ending-method'." + (save-excursion + (beginning-of-line) + (unless (or (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) + (and (not (eq org-list-ending-method 'indent)) + (looking-at org-list-end-re) + (progn (forward-line -1) (looking-at org-list-end-re)))) + (or (and (org-at-item-p) (point-at-bol)) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (ind-ref (if (looking-at "^[ \t]*$") + 10000 + (org-get-indentation)))) + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((<= (point) lim-up) + (throw 'exit (and (org-at-item-p) (< ind ind-ref) (point)))) + ((and (not (eq org-list-ending-method 'indent)) + (looking-at org-list-end-re)) + (throw 'exit nil)) + ;; Skip blocks, drawers, inline-tasks, blank lines + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" nil t)) + ((looking-at "^[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") + (forward-line -1)) + ((< ind ind-ref) + (if (org-at-item-p) + (throw 'exit (point)) + (setq ind-ref ind) + (forward-line -1))) + (t (if (and (eq org-list-ending-method 'regexp) + (org-at-item-p)) + (throw 'exit (point)) + (forward-line -1)))))))))))) + +(defun org-at-item-p () + "Is point in a line starting a hand-formatted item?" + (save-excursion (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?" + (and (org-at-item-p) + (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?" + (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?" + (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?" + (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) + +(defun org-at-item-counter-p () + "Is point at a line starting a plain-list item with a counter?" + (and (org-at-item-p) + (looking-at org-list-full-item-re) + (match-string 2))) + + +;;; Structures and helper functions (defun org-list-context () "Determine context, and its boundaries, around point. -Context will be an alist like (MIN MAX CONTEXT) where MIN and MAX +Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX are boundaries and CONTEXT is a symbol among `drawer', `block', `invalid', `inlinetask' and nil. -Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." +Contexts `block' and `invalid' refer to +`org-list-forbidden-blocks'." (save-match-data (save-excursion (beginning-of-line) @@ -442,604 +562,6 @@ Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." ;; Return the closest context around (assq (apply 'max (mapcar 'car context-list)) context-list))))) -(defun org-list-search-generic (search re bound noerr) - "Search a string in valid contexts for lists. -Arguments SEARCH, RE, BOUND and NOERR are similar to those in -`re-search-forward'." - (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 (memq noerr '(t nil)) origin bound)) - nil))) - ;; 2. Match in an `invalid' context: continue searching. Else, - ;; return point. - (unless (eq (org-list-context) 'invalid) (throw 'exit (point))))))) - -(defun org-list-search-backward (regexp &optional bound noerror) - "Like `re-search-backward' but stop only where lists are recognized. -Arguments REGEXP, BOUND and NOERROR are similar to those used in -`re-search-backward'." - (org-list-search-generic #'re-search-backward - regexp (or bound (point-min)) noerror)) - -(defun org-list-search-forward (regexp &optional bound noerror) - "Like `re-search-forward' but stop only where lists are recognized. -Arguments REGEXP, BOUND and NOERROR are similar to those used in -`re-search-forward'." - (org-list-search-generic #'re-search-forward - 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?" - (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-separating-blank-lines-number (pos struct prevs) - "Return number of blank lines that should separate items in list. -POS is the position at item beginning to be considered. STRUCT is -the list structure. PREVS is the alist of previous items. See -`org-list-struct-prev-alist'. - -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-list-get-next-item (point) struct prevs))) - (cond - ;; Is there a next item? - (next-p (goto-char next-p) - (org-back-over-empty-lines)) - ;; Is there a previous item? - ((org-list-get-prev-item (point) struct prevs) - (org-back-over-empty-lines)) - ;; User inserted blank lines, trust him - ((and (> pos (org-list-get-item-end-before-blank pos struct)) - (> (save-excursion - (goto-char 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-list-search-forward - "^[ \t]*$" (org-list-get-item-end-before-blank pos struct) t)) - 1) - ;; No parent: no blank line. - (t 0)))))))) - -(defun org-list-insert-item-generic (pos struct prevs &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. - -STRUCT is the list structure, as returned by `org-list-struct'. -PREVS is the the alist of previous items. See -`org-list-struct-prev-alist'. - -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. - -Return the new structure of the list." - (let ((case-fold-search t)) - ;; 1. Get information about list: structure, usual helper - ;; functions, position of point with regards to item start - ;; (BEFOREP), blank lines number separating items (BLANK-NB), - ;; position of split (POS) if we're allowed to (SPLIT-LINE-P). - (let* ((item (goto-char (org-list-get-item-begin))) - (item-end (org-list-get-item-end item struct)) - (item-end-no-blank (org-list-get-item-end-before-blank item struct)) - (beforep (and (looking-at org-list-full-item-re) - (<= pos (match-end 0)))) - (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) - (blank-nb (org-list-separating-blank-lines-number - item struct prevs)) - ;; 2. Build the new item to be created. Concatenate same - ;; bullet as item, checkbox, text AFTER-BULLET if - ;; provided, and text cut from point to end of item - ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on - ;; BEFOREP and SPLIT-LINE-P. The difference of size - ;; between what was cut and what was inserted in buffer - ;; is stored in SIZE-OFFSET. - (ind (org-list-get-ind item struct)) - (bullet (org-list-bullet-string (org-list-get-bullet item struct))) - (box (when checkbox "[ ]")) - (text-cut - (and (not beforep) split-line-p - (progn - (goto-char pos) - (skip-chars-backward " \r\t\n") - (setq pos (point)) - (delete-and-extract-region pos item-end-no-blank)))) - (body (concat bullet (when box (concat box " ")) after-bullet - (or (and text-cut - (if (string-match "\\`[ \t]+" text-cut) - (replace-match "" t t text-cut) - text-cut)) - ""))) - (item-sep (make-string (1+ blank-nb) ?\n)) - (item-size (+ ind (length body) (length item-sep))) - (size-offset (- item-size (length text-cut)))) - ;; 4. Insert effectively item into buffer - (goto-char item) - (org-indent-to-column ind) - (insert body) - (insert item-sep) - ;; 5. Add new item to STRUCT. - (mapc (lambda (e) - (let ((p (car e)) - (end (nth 6 e))) - (cond - ;; Before inserted item, positions don't change but - ;; an item ending after insertion has its end shifted - ;; by SIZE-OFFSET. - ((< p item) - (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) - ;; Trivial cases where current item isn't split in - ;; two. Just shift every item after new one by - ;; ITEM-SIZE. - ((or beforep (not split-line-p)) - (setcar e (+ p item-size)) - (setcar (nthcdr 6 e) (+ end item-size))) - ;; Item is split in two: elements before POS are just - ;; shifted by ITEM-SIZE. In the case item would end - ;; after split POS, ending is only shifted by - ;; SIZE-OFFSET. - ((< p pos) - (setcar e (+ p item-size)) - (if (< end pos) - (setcar (nthcdr 6 e) (+ end item-size)) - (setcar (nthcdr 6 e) (+ end size-offset)))) - ;; Elements after POS are moved into new item. Length - ;; of ITEM-SEP has to be removed as ITEM-SEP - ;; doesn't appear in buffer yet. - ((< p item-end) - (setcar e (+ p size-offset (- item pos (length item-sep)))) - (if (= end item-end) - (setcar (nthcdr 6 e) (+ item item-size)) - (setcar (nthcdr 6 e) - (+ end size-offset - (- item pos (length item-sep)))))) - ;; Elements at ITEM-END or after are only shifted by - ;; SIZE-OFFSET. - (t (setcar e (+ p size-offset)) - (setcar (nthcdr 6 e) (+ end size-offset)))))) - struct) - (push (list item ind bullet nil box nil (+ item item-size)) struct) - (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) - ;; 6. If not BEFOREP, new item must appear after ITEM, so - ;; exchange ITEM with the next item in list. Position cursor - ;; after bullet, counter, checkbox, and label. - (if beforep - (goto-char item) - (setq struct (org-list-exchange-items item (+ item item-size) struct)) - (goto-char (org-list-get-next-item - item struct (org-list-struct-prev-alist struct)))) - struct))) - -(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 struct) - "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 inside will be moved. - -If NO-SUBTREE is non-nil, only indent the item itself, not its -children. - -STRUCT is the list structure. Return t if successful." - (save-excursion - (beginning-of-line) - (let* ((regionp (org-region-active-p)) - (rbeg (and regionp (region-beginning))) - (rend (and regionp (region-end))) - (top (org-list-get-top-point struct)) - (parents (org-list-struct-parent-alist struct)) - (prevs (org-list-struct-prev-alist struct)) - ;; Are we going to move the whole list? - (specialp - (and (= top (point)) - (cdr (assq 'indent org-list-automatic-rules)) - (if no-subtree - (error - "First item of list cannot move without its subtree") - t)))) - ;; Determine begin and end points of zone to indent. If moving - ;; more than one item, save them for 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)) - (set-marker org-last-indent-end-marker - (cond - (specialp (org-list-get-bottom-point struct)) - (no-subtree (1+ (point))) - (t (org-list-get-item-end (point) struct)))))) - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker))) - (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 (org-list-get-ind beg struct)) - (old-struct (mapcar (lambda (e) (copy-alist e)) struct))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary - (when (and (= (+ top-ind offset) 0) - (string-match "*" - (org-list-get-bullet beg struct))) - (org-list-set-bullet beg struct - (org-list-bullet-string "-"))) - ;; Shift every item by OFFSET and fix bullets. Then - ;; apply changes to buffer. - (mapc (lambda (e) - (let ((ind (org-list-get-ind (car e) struct))) - (org-list-set-ind (car e) struct (+ ind offset)))) - struct) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-apply-struct struct old-struct)))) - ;; Forbidden move: - ((and (< arg 0) - ;; If only one item is moved, it mustn't have a child - (or (and no-subtree - (not regionp) - (org-list-has-child-p beg struct)) - ;; If a subtree or region is moved, the last item - ;; of the subtree mustn't have a child - (let ((last-item (caar - (reverse - (org-remove-if - (lambda (e) (>= (car e) end)) - struct))))) - (org-list-has-child-p last-item struct)))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((new-parents - (if (< arg 0) - (org-list-struct-outdent beg end struct parents) - (org-list-struct-indent beg end struct parents prevs)))) - (org-list-struct-fix-struct struct new-parents)) - (org-update-checkbox-count-maybe)))))) - t) - -;;; Predicates - -(defun org-in-item-p () - "Return item beginning position when in a plain list, nil otherwise. -This checks `org-list-ending-method'." - (save-excursion - (beginning-of-line) - (unless (or (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) - (and (not (eq org-list-ending-method 'indent)) - (looking-at org-list-end-re) - (progn (forward-line -1) (looking-at org-list-end-re)))) - (or (and (org-at-item-p) (point-at-bol)) - (let* ((case-fold-search t) - (context (org-list-context)) - (lim-up (car context)) - (inlinetask-re (and (featurep 'org-inlinetask) - (org-inlinetask-outline-regexp))) - (ind-ref (if (looking-at "^[ \t]*$") - 10000 - (org-get-indentation)))) - (catch 'exit - (while t - (let ((ind (org-get-indentation))) - (cond - ((<= (point) lim-up) - (throw 'exit (and (org-at-item-p) (< ind ind-ref) (point)))) - ((and (not (eq org-list-ending-method 'indent)) - (looking-at org-list-end-re)) - (throw 'exit nil)) - ;; Skip blocks, drawers, inline-tasks, blank lines - ((looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_" nil t)) - ((looking-at "^[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t) - (beginning-of-line)) - ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-beginning) - (forward-line -1)) - ((looking-at "^[ \t]*$") - (forward-line -1)) - ((< ind ind-ref) - (if (org-at-item-p) - (throw 'exit (point)) - (setq ind-ref ind) - (forward-line -1))) - (t (if (and (eq org-list-ending-method 'regexp) - (org-at-item-p)) - (throw 'exit (point)) - (forward-line -1)))))))))))) - -(defun org-at-item-p () - "Is point in a line starting a hand-formatted item?" - (save-excursion (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?" - (and (org-at-item-p) - (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?" - (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?" - (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?" - (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) - -(defun org-at-item-counter-p () - "Is point at a line starting a plain-list item with a counter?" - (and (org-at-item-p) - (looking-at org-list-full-item-re) - (match-string 2))) - -;;; Navigate - -(defalias 'org-list-get-item-begin 'org-in-item-p) - -(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 ((begin (org-in-item-p))) - (if begin (goto-char begin) (error "Not in an item")))) - -(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) - (let ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct))) - (goto-char (org-list-get-list-begin begin struct prevs)))))) - -(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) - (let ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct))) - (goto-char (org-list-get-list-end begin struct prevs)))))) - -(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 ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let ((struct (org-list-struct))) - (goto-char (org-list-get-item-end begin struct)))))) - -(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 ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - (prevp (org-list-get-prev-item begin struct prevs))) - (if prevp (goto-char prevp) (error "On first item")))))) - -(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 ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - (prevp (org-list-get-next-item begin struct prevs))) - (if prevp (goto-char prevp) (error "On last item")))))) - -;;; Manipulate - -(defun org-list-exchange-items (beg-A beg-B struct) - "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. -Blank lines at the end of items are left in place. Return the new -structure after the changes. - -Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong -to the same sub-list. - -This function modifies STRUCT." - (save-excursion - (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) - (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) - (end-A (org-list-get-item-end beg-A struct)) - (end-B (org-list-get-item-end beg-B struct)) - (size-A (- end-A-no-blank beg-A)) - (size-B (- end-B-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)) - (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) - (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) - ;; 1. Move effectively items in buffer. - (goto-char beg-A) - (delete-region beg-A end-B-no-blank) - (insert (concat body-B between-A-no-blank-and-B body-A)) - ;; 2. Now modify struct. No need to re-read the list, the - ;; transformation is just a shift of positions. Some special - ;; attention is required for items ending at END-A and END-B - ;; as empty spaces are not moved there. In others words, item - ;; BEG-A will end with whitespaces that were at the end of - ;; BEG-B and the same applies to BEG-B. - (mapc (lambda (e) - (let ((pos (car e))) - (cond - ((< pos beg-A)) - ((memq pos sub-A) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) - (setcar (nthcdr 6 e) - (+ end-e (- end-B-no-blank end-A-no-blank))) - (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) - ((memq pos sub-B) - (let ((end-e (nth 6 e))) - (setcar e (- (+ pos beg-A) beg-B)) - (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) - (when (= end-e end-B) - (setcar (nthcdr 6 e) - (+ beg-A size-B (- end-A end-A-no-blank)))))) - ((< pos beg-B) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- size-B size-A))) - (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) - struct) - (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) - -(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) - (unless (org-at-item-p) (error "Not at an item")) - (let* ((pos (point)) - (col (current-column)) - (actual-item (point-at-bol)) - (struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - (next-item (org-list-get-next-item (point-at-bol) struct prevs))) - (if (not next-item) - (progn - (goto-char pos) - (error "Cannot move this item further down")) - (setq struct - (org-list-exchange-items actual-item next-item struct)) - ;; Use a short variation of `org-list-struct-fix-struct' as - ;; there's no need to go through all the steps. - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) - (prevs (org-list-struct-prev-alist struct)) - (parents (org-list-struct-parent-alist struct))) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (org-list-struct-apply-struct struct old-struct) - (goto-char (org-list-get-next-item (point-at-bol) struct prevs))) - (org-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) - (unless (org-at-item-p) (error "Not at an item")) - (let* ((pos (point)) - (col (current-column)) - (actual-item (point-at-bol)) - (struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) - (if (not prev-item) - (progn - (goto-char pos) - (error "Cannot move this item further up")) - (setq struct - (org-list-exchange-items prev-item actual-item struct)) - ;; Use a short variation of `org-list-struct-fix-struct' as - ;; there's no need to go through all the steps. - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) - (prevs (org-list-struct-prev-alist struct)) - (parents (org-list-struct-parent-alist struct))) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (org-list-struct-apply-struct struct old-struct)) - (org-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. - -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." - (let ((itemp (org-in-item-p)) - (pos (point))) - ;; If cursor isn't is a list or if list is invisible, return nil. - (unless (or (not itemp) - (save-excursion - (goto-char itemp) - (org-invisible-p))) - (if (save-excursion - (goto-char itemp) - (org-at-item-timer-p)) - ;; Timer list: delegate to `org-timer-item'. - (progn (org-timer-item) t) - (goto-char itemp) - (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - ;; If we're in a description list, ask for the new term. - (desc (when (org-list-get-tag itemp struct) - (concat (read-string "Term: ") " :: "))) - ;; Don't insert a checkbox if checkbox rule is applied - ;; and it is a description item. - (checkp (and checkbox - (or (not desc) - (not (cdr (assq 'checkbox - org-list-automatic-rules))))))) - (setq struct - (org-list-insert-item-generic pos struct prevs checkp desc)) - (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) - (when checkp (org-update-checkbox-count-maybe)) - (looking-at org-list-full-item-re) - (goto-char (match-end 0)) - t))))) - - -;;; Structures - (defun org-list-struct () "Return structure of list at point. @@ -1065,7 +587,7 @@ point-at-bol: will get the following structure: -\(\(1 0 \"- \" nil [X] nil 97) +\(\(1 0 \"- \" nil \"[X]\" nil 97\) \(18 2 \"1. \" nil nil nil 34\) \(34 2 \"5. \" \"5\" nil nil 55\) \(97 0 \"- \" nil nil nil 131\) @@ -1269,7 +791,7 @@ This function modifies STRUCT." (setcdr elt (append (cdr elt) (list new-end))))))) struct))) -(defun org-list-struct-prev-alist (struct) +(defun org-list-prevs-alist (struct) "Return alist between item and previous item in STRUCT." (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e))) struct))) @@ -1278,7 +800,7 @@ This function modifies STRUCT." (cons (car e) prev))) struct))) -(defun org-list-struct-parent-alist (struct) +(defun org-list-parents-alist (struct) "Return alist between item and parent in STRUCT." (let ((ind-to-ori (list (list (nth 1 (car struct))))) (prev-pos (list (caar struct)))) @@ -1300,121 +822,8 @@ This function modifies STRUCT." (t (cons pos (cdar ind-to-ori)))))) (cdr struct))))) -(defun org-list-get-parent (item struct parents) - "Return parent of ITEM in STRUCT, or nil. -PARENTS is the alist of items' parent. See -`org-list-struct-parent-alist'." - (let ((parents (or parents (org-list-struct-parent-alist struct)))) - (cdr (assq item parents)))) -(defun org-list-has-child-p (item struct) - "Return a non-nil value if ITEM in STRUCT has a child. -Value returned is the position of the first child of ITEM." - (let ((ind (org-list-get-ind item struct)) - (child-maybe (car (nth 1 (member (assq item struct) struct))))) - (when (and child-maybe - (< ind (org-list-get-ind child-maybe struct))) - child-maybe))) - -(defun org-list-get-next-item (item struct prevs) - "Return next item in same sub-list as ITEM in STRUCT, or nil. -PREVS is the alist of previous items. See -`org-list-struct-prev-alist'." - (car (rassq item prevs))) - -(defun org-list-get-prev-item (item struct prevs) - "Return previous item in same sub-list as ITEM in STRUCT, or nil. -PREVS is the alist of previous items. See -`org-list-struct-prev-alist'." - (cdr (assq item prevs))) - -(defun org-list-get-subtree (item struct) - "Return all items with ITEM as a common ancestor or nil. -STRUCT is the list structure considered." - (let* ((item-end (org-list-get-item-end item struct)) - (sub-struct (cdr (member (assq item struct) struct))) - subtree) - (catch 'exit - (mapc (lambda (e) - (let ((pos (car e))) - (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) - sub-struct)) - (nreverse subtree))) - -(defun org-list-get-all-items (item struct prevs) - "List of items in the same sub-list as ITEM in STRUCT. -PREVS is the alist of previous items. See -`org-list-struct-prev-alist'." - (let ((prev-item item) - (next-item item) - before-item after-item) - (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) - (push prev-item before-item)) - (while (setq next-item (org-list-get-next-item next-item struct prevs)) - (push next-item after-item)) - (append before-item (list item) (nreverse after-item)))) - -(defun org-list-get-children (item struct parents) - "List all children of ITEM in STRUCT, or nil. -PARENTS is the alist of items' parent. See -`org-list-struct-parent-alist'." - (let (all) - (while (setq child (car (rassq item parents))) - (setq parents (cdr (member (assq child parents) parents))) - (push child all)) - (nreverse all))) - -(defun org-list-get-top-point (struct) - "Return point at beginning of list. -STRUCT is the structure of the list." - (caar struct)) - -(defun org-list-get-bottom-point (struct) - "Return point at bottom of list. -STRUCT is the structure of the list." - (apply 'max - (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) - -(defun org-list-get-list-begin (item struct prevs) - "Return point at beginning of sub-list ITEM belongs. -STRUCT is the structure of the list. PREVS is the alist of -previous items. See `org-list-struct-prev-alist'." - (let ((first-item item) prev-item) - (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) - (setq first-item prev-item)) - first-item)) - -(defalias 'org-list-get-first-item 'org-list-get-list-begin) - -(defun org-list-get-last-item (item struct prevs) - "Return point at last item of sub-list ITEM belongs. -STRUCT is the structure of the list. PREVS is the alist of -previous items. See `org-list-struct-prev-alist'." - (let ((last-item item) next-item) - (while (setq next-item (org-list-get-next-item last-item struct prevs)) - (setq last-item next-item)) - last-item)) - -(defun org-list-get-list-end (item struct prevs) - "Return point at end of sub-list ITEM belongs. -STRUCT is the structure of the list. PREVS is the alist of -previous items. See `org-list-struct-prev-alist'." - (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) - -(defun org-list-get-list-type (item struct prevs) - "Return the type of the list containing ITEM as a symbol. - -STRUCT is the structure of the list, as returned by -`org-list-struct'. PREVS is the alist of previous items. See -`org-list-struct-prev-alist'. - -Possible types are `descriptive', `ordered' and `unordered'. The -type is determined by the first item of the list." - (let ((first (org-list-get-list-begin item struct prevs))) - (cond - ((org-list-get-tag first struct) 'descriptive) - ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) - (t 'unordered)))) +;;; Accessors (defun org-list-get-nth (n key struct) "Return the Nth value of KEY in STRUCT." @@ -1472,10 +881,496 @@ Point returned is at end of line." (skip-chars-backward " \r\t\n") (point-at-eol))) +(defun org-list-get-parent (item struct parents) + "Return parent of ITEM in STRUCT, or nil. +PARENTS is the alist of items' parent. See +`org-list-parents-alist'." + (let ((parents (or parents (org-list-parents-alist struct)))) + (cdr (assq item parents)))) + +(defun org-list-has-child-p (item struct) + "Return a non-nil value if ITEM in STRUCT has a child. +Value returned is the position of the first child of ITEM." + (let ((ind (org-list-get-ind item struct)) + (child-maybe (car (nth 1 (member (assq item struct) struct))))) + (when (and child-maybe + (< ind (org-list-get-ind child-maybe struct))) + child-maybe))) + +(defun org-list-get-next-item (item struct prevs) + "Return next item in same sub-list as ITEM in STRUCT, or nil. +PREVS is the alist of previous items. See +`org-list-prevs-alist'." + (car (rassq item prevs))) + +(defun org-list-get-prev-item (item struct prevs) + "Return previous item in same sub-list as ITEM in STRUCT, or nil. +PREVS is the alist of previous items. See +`org-list-prevs-alist'." + (cdr (assq item prevs))) + +(defun org-list-get-subtree (item struct) + "Return all items with ITEM as a common ancestor or nil. +STRUCT is the list structure considered." + (let* ((item-end (org-list-get-item-end item struct)) + (sub-struct (cdr (member (assq item struct) struct))) + subtree) + (catch 'exit + (mapc (lambda (e) + (let ((pos (car e))) + (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) + sub-struct)) + (nreverse subtree))) + +(defun org-list-get-all-items (item struct prevs) + "List of items in the same sub-list as ITEM in STRUCT. +PREVS is the alist of previous items. See +`org-list-prevs-alist'." + (let ((prev-item item) + (next-item item) + before-item after-item) + (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) + (push prev-item before-item)) + (while (setq next-item (org-list-get-next-item next-item struct prevs)) + (push next-item after-item)) + (append before-item (list item) (nreverse after-item)))) + +(defun org-list-get-children (item struct parents) + "List all children of ITEM in STRUCT, or nil. +PARENTS is the alist of items' parent. See +`org-list-parents-alist'." + (let (all) + (while (setq child (car (rassq item parents))) + (setq parents (cdr (member (assq child parents) parents))) + (push child all)) + (nreverse all))) + +(defun org-list-get-top-point (struct) + "Return point at beginning of list. +STRUCT is the structure of the list." + (caar struct)) + +(defun org-list-get-bottom-point (struct) + "Return point at bottom of list. +STRUCT is the structure of the list." + (apply 'max + (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) + +(defun org-list-get-list-begin (item struct prevs) + "Return point at beginning of sub-list ITEM belongs. +STRUCT is the structure of the list. PREVS is the alist of +previous items. See `org-list-prevs-alist'." + (let ((first-item item) prev-item) + (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) + (setq first-item prev-item)) + first-item)) + +(defalias 'org-list-get-first-item 'org-list-get-list-begin) + +(defun org-list-get-last-item (item struct prevs) + "Return point at last item of sub-list ITEM belongs. +STRUCT is the structure of the list. PREVS is the alist of +previous items. See `org-list-prevs-alist'." + (let ((last-item item) next-item) + (while (setq next-item (org-list-get-next-item last-item struct prevs)) + (setq last-item next-item)) + last-item)) + +(defun org-list-get-list-end (item struct prevs) + "Return point at end of sub-list ITEM belongs. +STRUCT is the structure of the list. PREVS is the alist of +previous items. See `org-list-prevs-alist'." + (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) + +(defun org-list-get-list-type (item struct prevs) + "Return the type of the list containing ITEM as a symbol. + +STRUCT is the structure of the list, as returned by +`org-list-struct'. PREVS is the alist of previous items. See +`org-list-prevs-alist'. + +Possible types are `descriptive', `ordered' and `unordered'. The +type is determined by the first item of the list." + (let ((first (org-list-get-list-begin item struct prevs))) + (cond + ((org-list-get-tag first struct) 'descriptive) + ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + (t 'unordered)))) + + +;;; Searching + +(defun org-list-search-generic (search re bound noerr) + "Search a string in valid contexts for lists. +Arguments SEARCH, RE, BOUND and NOERR are similar to those in +`re-search-forward'." + (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 (memq noerr '(t nil)) origin bound)) + nil))) + ;; 2. Match in an `invalid' context: continue searching. Else, + ;; return point. + (unless (eq (org-list-context) 'invalid) (throw 'exit (point))))))) + +(defun org-list-search-backward (regexp &optional bound noerror) + "Like `re-search-backward' but stop only where lists are recognized. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-backward'." + (org-list-search-generic #'re-search-backward + regexp (or bound (point-min)) noerror)) + +(defun org-list-search-forward (regexp &optional bound noerror) + "Like `re-search-forward' but stop only where lists are recognized. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-forward'." + (org-list-search-generic #'re-search-forward + regexp (or bound (point-max)) noerror)) + + + +;;; Methods on structures + +(defun org-list-separating-blank-lines-number (pos struct prevs) + "Return number of blank lines that should separate items in list. +POS is the position at item beginning to be considered. STRUCT is +the list structure. PREVS is the alist of previous items. See +`org-list-prevs-alist'. + +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-list-get-next-item (point) struct prevs))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (org-back-over-empty-lines)) + ;; Is there a previous item? + ((org-list-get-prev-item (point) struct prevs) + (org-back-over-empty-lines)) + ;; User inserted blank lines, trust him + ((and (> pos (org-list-get-item-end-before-blank pos struct)) + (> (save-excursion + (goto-char 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-list-search-forward + "^[ \t]*$" (org-list-get-item-end-before-blank pos struct) t)) + 1) + ;; No parent: no blank line. + (t 0)))))))) + +(defun org-list-insert-item (pos struct prevs &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. + +STRUCT is the list structure, as returned by `org-list-struct'. +PREVS is the the alist of previous items. See +`org-list-prevs-alist'. + +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. + +Return the new structure of the list." + (let ((case-fold-search t)) + ;; 1. Get information about list: structure, usual helper + ;; functions, position of point with regards to item start + ;; (BEFOREP), blank lines number separating items (BLANK-NB), + ;; position of split (POS) if we're allowed to (SPLIT-LINE-P). + (let* ((item (goto-char (org-list-get-item-begin))) + (item-end (org-list-get-item-end item struct)) + (item-end-no-blank (org-list-get-item-end-before-blank item struct)) + (beforep (and (looking-at org-list-full-item-re) + (<= pos (match-end 0)))) + (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) + (blank-nb (org-list-separating-blank-lines-number + item struct prevs)) + ;; 2. Build the new item to be created. Concatenate same + ;; bullet as item, checkbox, text AFTER-BULLET if + ;; provided, and text cut from point to end of item + ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on + ;; BEFOREP and SPLIT-LINE-P. The difference of size + ;; between what was cut and what was inserted in buffer + ;; is stored in SIZE-OFFSET. + (ind (org-list-get-ind item struct)) + (bullet (org-list-bullet-string (org-list-get-bullet item struct))) + (box (when checkbox "[ ]")) + (text-cut + (and (not beforep) split-line-p + (progn + (goto-char pos) + (skip-chars-backward " \r\t\n") + (setq pos (point)) + (delete-and-extract-region pos item-end-no-blank)))) + (body (concat bullet (when box (concat box " ")) after-bullet + (or (and text-cut + (if (string-match "\\`[ \t]+" text-cut) + (replace-match "" t t text-cut) + text-cut)) + ""))) + (item-sep (make-string (1+ blank-nb) ?\n)) + (item-size (+ ind (length body) (length item-sep))) + (size-offset (- item-size (length text-cut)))) + ;; 4. Insert effectively item into buffer + (goto-char item) + (org-indent-to-column ind) + (insert body) + (insert item-sep) + ;; 5. Add new item to STRUCT. + (mapc (lambda (e) + (let ((p (car e)) + (end (nth 6 e))) + (cond + ;; Before inserted item, positions don't change but + ;; an item ending after insertion has its end shifted + ;; by SIZE-OFFSET. + ((< p item) + (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Trivial cases where current item isn't split in + ;; two. Just shift every item after new one by + ;; ITEM-SIZE. + ((or beforep (not split-line-p)) + (setcar e (+ p item-size)) + (setcar (nthcdr 6 e) (+ end item-size))) + ;; Item is split in two: elements before POS are just + ;; shifted by ITEM-SIZE. In the case item would end + ;; after split POS, ending is only shifted by + ;; SIZE-OFFSET. + ((< p pos) + (setcar e (+ p item-size)) + (if (< end pos) + (setcar (nthcdr 6 e) (+ end item-size)) + (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Elements after POS are moved into new item. Length + ;; of ITEM-SEP has to be removed as ITEM-SEP + ;; doesn't appear in buffer yet. + ((< p item-end) + (setcar e (+ p size-offset (- item pos (length item-sep)))) + (if (= end item-end) + (setcar (nthcdr 6 e) (+ item item-size)) + (setcar (nthcdr 6 e) + (+ end size-offset + (- item pos (length item-sep)))))) + ;; Elements at ITEM-END or after are only shifted by + ;; SIZE-OFFSET. + (t (setcar e (+ p size-offset)) + (setcar (nthcdr 6 e) (+ end size-offset)))))) + struct) + (push (list item ind bullet nil box nil (+ item item-size)) struct) + (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + ;; 6. If not BEFOREP, new item must appear after ITEM, so + ;; exchange ITEM with the next item in list. Position cursor + ;; after bullet, counter, checkbox, and label. + (if beforep + (goto-char item) + (setq struct (org-list-exchange-items item (+ item item-size) struct)) + (goto-char (org-list-get-next-item + item struct (org-list-prevs-alist struct)))) + struct))) + +(defun org-list-exchange-items (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. +Blank lines at the end of items are left in place. Return the new +structure after the changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. + +This function modifies STRUCT." + (save-excursion + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-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)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))) + ;; 1. Move effectively items in buffer. + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, item + ;; BEG-A will end with whitespaces that were at the end of + ;; BEG-B and the same applies to BEG-B. + (mapc (lambda (e) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + struct) + (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) + +(defun org-list-struct-outdent (start end struct parents) + "Outdent items between START and END in structure STRUCT. + +PARENTS is the alist of items' parents. See +`org-list-parents-alist'. + +START is included, END excluded." + (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 (and parent (assq parent acc)))) + (if convert (cons item (cdr convert)) cell))) + ;; Item has no parent: error + ((not parent) + (error "Cannot outdent top-level items")) + ;; Parent is outdented: keep association + ((>= parent start) + (push (cons parent item) acc) cell) + (t + ;; Parent isn't outdented: reparent to grand-parent + (let ((grand-parent (org-list-get-parent + parent struct parents))) + (push (cons parent item) acc) + (cons item grand-parent)))))))) + (mapcar out parents))) + +(defun org-list-struct-indent (start end struct parents prevs) + "Indent items between START and END in structure STRUCT. + +PARENTS is the alist of parents. See `org-list-parents-alist'. +PREVS is the alist of previous items. See `org-list-prevs-alist'. + +START is included and END excluded. + +STRUCT may be modified if `org-list-demote-modify-bullet' matches +bullets between START and END." + (let* (acc + (set-assoc (lambda (cell) (push cell acc) cell)) + (change-bullet-maybe + (function + (lambda (item) + (let* ((bul (org-trim (org-list-get-bullet item struct))) + (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet)))) + (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) + (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 (org-list-get-prev-item item struct prevs))) + ;; Check if bullet needs to be changed + (funcall change-bullet-maybe item) + (cond + ;; First item indented but not parent: error + ((and (not prev) (< parent start)) + (error "Cannot indent the first item of a list")) + ;; First item and parent indented: keep same parent + ((not prev) (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))))))))))))) + (mapcar ind parents))) + + +;;; Repairing structures + +(defun org-list-use-alpha-bul-p (first struct prevs) + "Can list starting at FIRST use alphabetical bullets? + +STRUCT is list structure. See `org-list-struct'. PREVS is the +alist of previous items. See `org-list-prevs-alist'." + (and org-alphabetical-lists + (catch 'exit + (let ((item first) (ascii 64) (case-fold-search nil)) + ;; Pretend that bullets are uppercase and check if alphabet + ;; is sufficient, taking counters into account. + (while item + (let ((bul (org-list-get-bullet item struct)) + (count (org-list-get-counter item struct))) + ;; Virtually determine current bullet + (if (and count (string-match "[a-zA-Z]" count)) + ;; Counters are not case-sensitive. + (setq ascii (string-to-char (upcase count))) + (setq ascii (1+ ascii))) + ;; Test if bullet would be over z or Z. + (if (> ascii 90) + (throw 'exit nil) + (setq item (org-list-get-next-item item struct prevs))))) + ;; All items checked. All good. + t)))) + +(defun org-list-inc-bullet-maybe (bullet) + "Increment BULLET if applicable." + (let ((case-fold-search nil)) + (cond + ;; Num bullet: increment it. + ((string-match "[0-9]+" bullet) + (replace-match + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) + nil nil bullet)) + ;; Alpha bullet: increment it. + ((string-match "[A-Za-z]" bullet) + (replace-match + (char-to-string (1+ (string-to-char (match-string 0 bullet)))) + nil nil bullet)) + ;; Unordered bullet: leave it. + (t bullet)))) + (defun org-list-struct-fix-bul (struct prevs) "Verify and correct bullets for every association in STRUCT. PREVS is the alist of previous items. See -`org-list-struct-prev-alist'. +`org-list-prevs-alist'. This function modifies STRUCT." (let ((case-fold-search nil) @@ -1545,7 +1440,7 @@ This function modifies STRUCT." "Verify and correct indentation for every association in STRUCT. PARENTS is the alist of items' parents. See -`org-list-struct-parent-alist'. +`org-list-parents-alist'. If numeric optional argument BULLET-SIZE is set, assume all bullets in list have this length to determine new indentation. @@ -1571,8 +1466,8 @@ This function modifies STRUCT." "Verify and correct checkboxes for every association in STRUCT. PARENTS is the alist of items' parents. See -`org-list-struct-parent-alist'. PREVS is the alist of previous -items. See `org-list-struct-prev-alist. +`org-list-parents-alist'. PREVS is the alist of previous items. +See `org-list-prevs-alist'. If ORDERED is non-nil, a checkbox can only be checked when every checkbox before it is checked too. If there was an attempt to @@ -1629,133 +1524,6 @@ This function modifies STRUCT." ;; return blocking item (nth index all-items))))))) -(defun org-list-struct-fix-struct (struct parents) - "Return STRUCT with correct bullets and indentation. -PARENTS is the alist of items' parents. See -`org-list-struct-parent-alist'." - ;; Order of functions matters here: checkboxes and endings need - ;; correct indentation to be set, and indentation needs correct - ;; bullets. - ;; - ;; 0. Save a copy of structure before modifications - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) - ;; 1. Set a temporary, but coherent with PARENTS, indentation in - ;; order to get items endings and bullets properly - (org-list-struct-fix-ind struct parents 2) - ;; 2. Get pseudo-alist of ending positions and sort it by position. - ;; Then associate them to the structure. - (let (end-list acc-end) - (mapc (lambda (e) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (end-pos (org-list-get-item-end pos struct))) - (unless (assq end-pos struct) - ;; to determine real ind of an ending position that is - ;; not at an item, we have to find the item it belongs - ;; to: it is the last item (ITEM-UP), whose ending is - ;; further than the position we're interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) - (push (cons - ;; else part is for the bottom point - (if item-up (+ (org-list-get-ind item-up struct) 2) 0) - end-pos) - end-list))) - (push (cons ind-pos pos) end-list) - (push (cons end-pos pos) acc-end))) - struct) - (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) - (org-list-struct-assoc-end struct end-list)) - ;; 3. Get bullets right - (let ((prevs (org-list-struct-prev-alist struct))) - (org-list-struct-fix-bul struct prevs) - ;; 4. Now get real indentation - (org-list-struct-fix-ind struct parents) - ;; 5. Eventually fix checkboxes - (org-list-struct-fix-box struct parents prevs)) - ;; 6. Apply structure modifications to buffer - (org-list-struct-apply-struct struct old-struct))) - -(defun org-list-struct-outdent (start end struct parents) - "Outdent items between START and END in structure STRUCT. - -PARENTS is the alist of items' parents. See -`org-list-struct-parent-alist'. - -START is included, END excluded." - (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 (and parent (assq parent acc)))) - (if convert (cons item (cdr convert)) cell))) - ;; Item has no parent: error - ((not parent) - (error "Cannot outdent top-level items")) - ;; Parent is outdented: keep association - ((>= parent start) - (push (cons parent item) acc) cell) - (t - ;; Parent isn't outdented: reparent to grand-parent - (let ((grand-parent (org-list-get-parent - parent struct parents))) - (push (cons parent item) acc) - (cons item grand-parent)))))))) - (mapcar out parents))) - -(defun org-list-struct-indent (start end struct parents prevs) - "Indent items between START and END in structure STRUCT. - -PARENTS is the alist of parents. See -`org-list-struct-parent-alist'. PREVS is the alist of previous -items. See `org-list-struct-prev-alist'. - -START is included and END excluded. - -STRUCT may be modified if `org-list-demote-modify-bullet' matches -bullets between START and END." - (let* (acc - (set-assoc (lambda (cell) (push cell acc) cell)) - (change-bullet-maybe - (function - (lambda (item) - (let* ((bul (org-trim (org-list-get-bullet item struct))) - (new-bul-p (cdr (assoc bul org-list-demote-modify-bullet)))) - (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) - (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 (org-list-get-prev-item item struct prevs))) - ;; Check if bullet needs to be changed - (funcall change-bullet-maybe item) - (cond - ;; First item indented but not parent: error - ((and (not prev) (< parent start)) - (error "Cannot indent the first item of a list")) - ;; First item and parent indented: keep same parent - ((not prev) (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))))))))))))) - (mapcar ind parents))) - (defun org-list-struct-apply-struct (struct old-struct) "Apply modifications to list so it mirrors STRUCT. @@ -1864,110 +1632,54 @@ Initial position of cursor is restored after the changes." ;; 4. Go back to initial position (goto-char pos))) -;;; Indentation +(defun org-list-write-struct (struct parents) + "Verify bullets, checkboxes, indentation in STRUCT and apply it to buffer. +PARENTS is the alist of items' parents. See +`org-list-parents-alist'." + ;; Order of functions matters here: checkboxes and endings need + ;; correct indentation to be set, and indentation needs correct + ;; bullets. + ;; + ;; 0. Save a copy of structure before modifications + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + ;; 1. Set a temporary, but coherent with PARENTS, indentation in + ;; order to get items endings and bullets properly + (org-list-struct-fix-ind struct parents 2) + ;; 2. Get pseudo-alist of ending positions and sort it by position. + ;; Then associate them to the structure. + (let (end-list acc-end) + (mapc (lambda (e) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (end-pos (org-list-get-item-end pos struct))) + (unless (assq end-pos struct) + ;; To determine real ind of an ending position that is + ;; not at an item, we have to find the item it belongs + ;; to: it is the last item (ITEM-UP), whose ending is + ;; further than the position we're interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons + ;; Else part is for the bottom point + (if item-up (+ (org-list-get-ind item-up struct) 2) 0) + end-pos) + end-list))) + (push (cons ind-pos pos) end-list) + (push (cons end-pos pos) acc-end))) + struct) + (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) + (org-list-struct-assoc-end struct end-list)) + ;; 3. Get bullets right + (let ((prevs (org-list-prevs-alist struct))) + (org-list-struct-fix-bul struct prevs) + ;; 4. Now get real indentation + (org-list-struct-fix-ind struct parents) + ;; 5. Eventually fix checkboxes + (org-list-struct-fix-box struct parents prevs)) + ;; 6. Apply structure modifications to buffer + (org-list-struct-apply-struct struct old-struct))) -(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) - (if (org-at-item-p) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic -1 t struct)) - (error "Not at an item"))) -(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) - (if (org-at-item-p) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic 1 t struct)) - (error "Not at an item"))) - -(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) - (let ((regionp (org-region-active-p))) - (cond - ((or (org-at-item-p) - (and (org-region-active-p) - (goto-char (region-beginning)) - (org-at-item-p))) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic -1 nil struct))) - (regionp (error "Region not starting at an item")) - (t (error "Not at an item"))))) - -(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) - (let ((regionp (org-region-active-p))) - (cond - ((or (org-at-item-p) - (and (org-region-active-p) - (goto-char (region-beginning)) - (org-at-item-p))) - (let ((struct (org-list-struct))) - (org-list-indent-item-generic 1 nil struct))) - (regionp (error "Region not starting at an item")) - (t (error "Not at an item"))))) - -(defvar org-tab-ind-state) -(defun org-cycle-item-indentation () - "Cycle levels of indentation of an empty item. -The first run indents 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." - (when (org-at-item-p) - (let* ((org-adapt-indentation nil) - (struct (org-list-struct)) - (ind (org-list-get-ind (point-at-bol) struct))) - ;; Check that item is really empty - (when (and (save-excursion - (beginning-of-line) - (looking-at org-list-full-item-re)) - (>= (match-end 0) (save-excursion - (goto-char (org-list-get-item-end - (point-at-bol) struct)) - (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) - (cond - ((ignore-errors (org-list-indent-item-generic -1 t struct))) - ((and (= ind (car org-tab-ind-state)) - (ignore-errors (org-list-indent-item-generic 1 t struct)))) - (t (back-to-indentation) - (org-indent-to-column (car org-tab-ind-state)) - (looking-at "\\S-+") - (replace-match (cdr org-tab-ind-state)) - (end-of-line) - ;; 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-list-indent-item-generic 1 t struct))) - ((ignore-errors (org-list-indent-item-generic -1 t struct))) - (t (error "Cannot move item")))) - t)))) - -;;; Bullets - -(defun org-get-bullet () - "Return the bullet of the item at point. -Assume cursor is at an item." - (save-excursion - (beginning-of-line) - (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))) +;;; Misc Tools (defun org-list-bullet-string (bullet) "Return BULLET with the correct number of whitespaces. @@ -1985,47 +1697,203 @@ It determines the number of whitespaces to append by looking at " "))) nil nil bullet 1))) -(defun org-list-use-alpha-bul-p (first struct prevs) - "Can list starting at FIRST use alphabetical bullets? +(defun org-apply-on-list (function init-value &rest args) + "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. -STRUCT is list structure. See `org-list-struct'. PREVS is the -alist of previous items. See `org-list-struct-prev-alist'." - (and org-alphabetical-lists - (catch 'exit - (let ((item first) (ascii 64) (case-fold-search nil)) - ;; Pretend that bullets are uppercase and checked if - ;; alphabet is sufficient, taking counters into account. - (while item - (let ((bul (org-list-get-bullet item struct)) - (count (org-list-get-counter item struct))) - ;; Virtually determine current bullet - (if (and count (string-match "[a-zA-Z]" count)) - ;; Counters are not case-sensitive. - (setq ascii (string-to-char (upcase count))) - (setq ascii (1+ ascii))) - ;; Test if bullet would be over z or Z. - (if (> ascii 90) - (throw 'exit nil) - (setq item (org-list-get-next-item item struct prevs))))) - ;; All items checked. All good. - t)))) +FUNCTION is applied on items in reverse order. -(defun org-list-inc-bullet-maybe (bullet) - "Increment BULLET if applicable." - (let ((case-fold-search nil)) - (cond - ;; Num bullet: increment it. - ((string-match "[0-9]+" bullet) - (replace-match - (number-to-string (1+ (string-to-number (match-string 0 bullet)))) - nil nil bullet)) - ;; Alpha bullet: increment it. - ((string-match "[A-Za-z]" bullet) - (replace-match - (char-to-string (1+ (string-to-char (match-string 0 bullet)))) - nil nil bullet)) - ;; Unordered bullet: leave it. - (t bullet)))) +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." + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (item (copy-marker (point-at-bol))) + (all (org-list-get-all-items (marker-position item) struct prevs)) + (value init-value)) + (mapc (lambda (e) + (goto-char e) + (setq value (apply function value args))) + (nreverse all)) + (goto-char item) + value)) + + +;;; Interactive functions + +(defalias 'org-list-get-item-begin 'org-in-item-p) + +(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 ((begin (org-in-item-p))) + (if begin (goto-char begin) (error "Not in an item")))) + +(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) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (goto-char (org-list-get-list-begin begin struct prevs)))))) + +(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) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (goto-char (org-list-get-list-end begin struct prevs)))))) + +(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 ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-item-end begin struct)))))) + +(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 ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prevp (org-list-get-prev-item begin struct prevs))) + (if prevp (goto-char prevp) (error "On first item")))))) + +(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 ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prevp (org-list-get-next-item begin struct prevs))) + (if prevp (goto-char prevp) (error "On last item")))))) + +(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) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((pos (point)) + (col (current-column)) + (actual-item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (next-item (org-list-get-next-item (point-at-bol) struct prevs))) + (if (not next-item) + (progn + (goto-char pos) + (error "Cannot move this item further down")) + (setq struct + (org-list-exchange-items actual-item next-item struct)) + ;; Use a short variation of `org-list-write-struct' as there's + ;; no need to go through all the steps. + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct))) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct) + (goto-char (org-list-get-next-item (point-at-bol) struct prevs))) + (org-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) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((pos (point)) + (col (current-column)) + (actual-item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) + (if (not prev-item) + (progn + (goto-char pos) + (error "Cannot move this item further up")) + (setq struct + (org-list-exchange-items prev-item actual-item struct)) + ;; Use a short variation of `org-list-write-struct' as there's + ;; no need to go through all the steps. + (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct))) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct)) + (org-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. + +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." + (let ((itemp (org-in-item-p)) + (pos (point))) + ;; If cursor isn't is a list or if list is invisible, return nil. + (unless (or (not itemp) + (save-excursion + (goto-char itemp) + (org-invisible-p))) + (if (save-excursion + (goto-char itemp) + (org-at-item-timer-p)) + ;; Timer list: delegate to `org-timer-item'. + (progn (org-timer-item) t) + (goto-char itemp) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + ;; If we're in a description list, ask for the new term. + (desc (when (org-list-get-tag itemp struct) + (concat (read-string "Term: ") " :: "))) + ;; Don't insert a checkbox if checkbox rule is applied + ;; and it is a description item. + (checkp (and checkbox + (or (not desc) + (not (cdr (assq 'checkbox + org-list-automatic-rules))))))) + (setq struct + (org-list-insert-item pos struct prevs checkp desc)) + (org-list-write-struct struct (org-list-parents-alist struct)) + (when checkp (org-update-checkbox-count-maybe)) + (looking-at org-list-full-item-re) + (goto-char (match-end 0)) + t))))) (defun org-list-repair () "Make sure all items are correctly indented, with the right bullet. @@ -2033,8 +1901,8 @@ This function scans the list at point, along with any sublist." (interactive) (unless (org-at-item-p) (error "This is not a list")) (let* ((struct (org-list-struct)) - (parents (org-list-struct-parent-alist struct))) - (org-list-struct-fix-struct struct parents))) + (parents (org-list-parents-alist struct))) + (org-list-write-struct struct parents))) (defun org-cycle-list-bullet (&optional which) "Cycle through the different itemize/enumerate bullets. @@ -2050,8 +1918,8 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (save-excursion (beginning-of-line) (let* ((struct (org-list-struct)) - (parents (org-list-struct-parent-alist struct)) - (prevs (org-list-struct-prev-alist struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) (list-beg (org-list-get-first-item (point) struct prevs)) (bullet (org-list-get-bullet list-beg struct)) (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) @@ -2094,16 +1962,14 @@ 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)))))) - ;; Use a short variation of `org-list-struct-fix-struct' as - ;; there's no need to go through all the steps. + ;; Use a short variation of `org-list-write-struct' as there's + ;; no need to go through all the steps. (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) (org-list-set-bullet list-beg struct (org-list-bullet-string new)) (org-list-struct-fix-bul struct prevs) (org-list-struct-fix-ind struct parents) (org-list-struct-apply-struct struct old-struct))))) -;;; Checkboxes - (defun org-toggle-checkbox (&optional toggle-presence) "Toggle the checkbox in the current line. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With @@ -2171,8 +2037,8 @@ in subtree, ignoring drawers." lim-down 'move)) (let* ((struct (org-list-struct)) (struct-copy (mapcar (lambda (e) (copy-alist e)) struct)) - (parents (org-list-struct-parent-alist struct)) - (prevs (org-list-struct-prev-alist struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) (bottom (copy-marker (org-list-get-bottom-point struct))) (items-to-toggle (org-remove-if (lambda (e) (or (< e lim-up) (> e lim-down))) @@ -2219,19 +2085,6 @@ in subtree, ignoring drawers." (beginning-of-line 2)))) (org-update-checkbox-count-maybe))) -(defvar org-checkbox-statistics-hook nil - "Hook that is run whenever Org thinks checkbox statistics should be updated. -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.") - -(defun org-update-checkbox-count-maybe () - "Update checkbox statistics unless turned off by user." - (when (cdr (assq 'checkbox org-list-automatic-rules)) - (org-update-checkbox-count)) - (run-hooks 'org-checkbox-statistics-hook)) - (defun org-update-checkbox-count (&optional all) "Update the checkbox statistics in the current section. This will find all statistic cookies like [57%] and [6/12] and @@ -2264,8 +2117,8 @@ With optional prefix argument ALL, do this for the whole buffer." (let ((c-on 0) (c-all 0)) (mapc (lambda (s) - (let* ((pre (org-list-struct-prev-alist s)) - (par (org-list-struct-parent-alist s)) + (let* ((pre (org-list-prevs-alist s)) + (par (org-list-parents-alist s)) (items (cond ((and recursivep item) (org-list-get-subtree item s)) @@ -2370,32 +2223,199 @@ Otherwise it will be `org-todo'." 'org-checkbox-statistics-done 'org-checkbox-statistics-todo))) -;;; Misc Tools +(defun org-update-checkbox-count-maybe () + "Update checkbox statistics unless turned off by user." + (when (cdr (assq 'checkbox org-list-automatic-rules)) + (org-update-checkbox-count)) + (run-hooks 'org-checkbox-statistics-hook)) -(defun org-apply-on-list (function init-value &rest args) - "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. +(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 struct) + "Indent a local list item including its children. +When number ARG is a negative, item will be outdented, otherwise +it will be indented. -FUNCTION is applied on items in reverse order. +If a region is active, all items inside will be moved. -As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) -will return the number of items in the current list. +If NO-SUBTREE is non-nil, only indent the item itself, not its +children. -Sublists of the list are skipped. Cursor is always at the -beginning of the item." - (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - (item (copy-marker (point-at-bol))) - (all (org-list-get-all-items (marker-position item) struct prevs)) - (value init-value)) - (mapc (lambda (e) - (goto-char e) - (setq value (apply function value args))) - (nreverse all)) - (goto-char item) - value)) +STRUCT is the list structure. Return t if successful." + (save-excursion + (beginning-of-line) + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end))) + (top (org-list-get-top-point struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + ;; Are we going to move the whole list? + (specialp + (and (= top (point)) + (cdr (assq 'indent org-list-automatic-rules)) + (if no-subtree + (error + "First item of list cannot move without its subtree") + t)))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, save them for 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)) + (set-marker org-last-indent-end-marker + (cond + (specialp (org-list-get-bottom-point struct)) + (no-subtree (1+ (point))) + (t (org-list-get-item-end (point) struct)))))) + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker))) + (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 (org-list-get-ind beg struct)) + (old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary + (when (and (= (+ top-ind offset) 0) + (string-match "*" + (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct + (org-list-bullet-string "-"))) + ;; Shift every item by OFFSET and fix bullets. Then + ;; apply changes to buffer. + (mapc (lambda (e) + (let ((ind (org-list-get-ind (car e) struct))) + (org-list-set-ind (car e) struct (+ ind offset)))) + struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-apply-struct struct old-struct)))) + ;; Forbidden move: + ((and (< arg 0) + ;; If only one item is moved, it mustn't have a child + (or (and no-subtree + (not regionp) + (org-list-has-child-p beg struct)) + ;; If a subtree or region is moved, the last item + ;; of the subtree mustn't have a child + (let ((last-item (caar + (reverse + (org-remove-if + (lambda (e) (>= (car e) end)) + struct))))) + (org-list-has-child-p last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((new-parents + (if (< arg 0) + (org-list-struct-outdent beg end struct parents) + (org-list-struct-indent beg end struct parents prevs)))) + (org-list-write-struct struct new-parents)) + (org-update-checkbox-count-maybe)))))) + t) + +(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) + (if (org-at-item-p) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 t struct)) + (error "Not at an item"))) + +(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) + (if (org-at-item-p) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 t struct)) + (error "Not at an item"))) + +(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) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and (org-region-active-p) + (goto-char (region-beginning)) + (org-at-item-p))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic -1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(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) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and (org-region-active-p) + (goto-char (region-beginning)) + (org-at-item-p))) + (let ((struct (org-list-struct))) + (org-list-indent-item-generic 1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defvar org-tab-ind-state) +(defun org-cycle-item-indentation () + "Cycle levels of indentation of an empty item. +The first run indents 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." + (when (org-at-item-p) + (let* ((org-adapt-indentation nil) + (struct (org-list-struct)) + (ind (org-list-get-ind (point-at-bol) struct)) + (bullet (org-list-get-bullet (point-at-bol) struct))) + ;; Check that item is really empty + (when (and (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re)) + (>= (match-end 0) (save-excursion + (goto-char (org-list-get-item-end + (point-at-bol) struct)) + (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) + (cond + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + ((and (= ind (car org-tab-ind-state)) + (ignore-errors (org-list-indent-item-generic 1 t struct)))) + (t (back-to-indentation) + (org-indent-to-column (car org-tab-ind-state)) + (looking-at "\\S-+") + (replace-match (cdr org-tab-ind-state)) + (end-of-line) + ;; 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 bullet)) + (cond + ((ignore-errors (org-list-indent-item-generic 1 t struct))) + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + (t (error "Cannot move item")))) + t)))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) "Sort plain list items. @@ -2428,7 +2448,7 @@ compare entries." (interactive "P") (let* ((case-func (if with-case 'identity 'downcase)) (struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) + (prevs (org-list-prevs-alist struct)) (start (org-list-get-list-begin (point-at-bol) struct prevs)) (end (org-list-get-list-end (point-at-bol) struct prevs)) (sorting-type @@ -2497,7 +2517,9 @@ compare entries." (run-hooks 'org-after-sorting-entries-or-items-hook) (message "Sorting items...done"))))) + ;;; Send and receive lists + (defun org-list-parse-list (&optional delete) "Parse the list at point and maybe DELETE it. @@ -2527,8 +2549,8 @@ will be parsed as: Point is left at list end." (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) - (parents (org-list-struct-parent-alist struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) (top (org-list-get-top-point struct)) (bottom (org-list-get-bottom-point struct)) out diff --git a/lisp/org-timer.el b/lisp/org-timer.el index 9a804f363..e4775a332 100644 --- a/lisp/org-timer.el +++ b/lisp/org-timer.el @@ -209,15 +209,15 @@ it in the buffer." (interactive "P") (let ((itemp (org-in-item-p))) (cond - ;; In a timer list, insert with `org-list-insert-item-generic', + ;; In a timer list, insert with `org-list-insert-item', ;; then fix the list. ((and itemp (save-excursion (goto-char itemp) (org-at-item-timer-p))) (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct)) + (prevs (org-list-prevs-alist struct)) (s (concat (org-timer (when arg '(4)) t) ":: "))) - (setq struct (org-list-insert-item-generic (point) struct prevs nil s)) - (org-list-struct-fix-struct struct (org-list-struct-parent-alist struct)) + (setq struct (org-list-insert-item (point) struct prevs nil s)) + (org-list-write-struct struct (org-list-parents-alist struct)) (looking-at org-list-full-item-re) (goto-char (match-end 0)))) ;; In a list of another type, don't break anything: throw an error. diff --git a/lisp/org.el b/lisp/org.el index f0469eeb5..2e6bd3bde 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -11821,7 +11821,7 @@ EXTRA is additional text that will be inserted into the notes buffer." (if (looking-at "\n[ \t]*- State") (forward-char 1)) (when (ignore-errors (goto-char (org-in-item-p))) (let* ((struct (org-list-struct)) - (prevs (org-list-struct-prev-alist struct))) + (prevs (org-list-prevs-alist struct))) (while (looking-at "[ \t]*- State") (goto-char (or (org-list-get-next-item (point) struct prevs) (org-list-get-item-end (point) struct))))))) @@ -17404,8 +17404,8 @@ This command does many different things, depending on context: (let* ((cbox (match-string 1)) (struct (org-list-struct)) (old-struct (mapcar (lambda (e) (copy-alist e)) struct)) - (parents (org-list-struct-parent-alist struct)) - (prevs (org-list-struct-prev-alist struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) (orderedp (ignore-errors (org-entry-get nil "ORDERED"))) block-item) (org-list-set-checkbox (point-at-bol) struct @@ -17430,8 +17430,8 @@ This command does many different things, depending on context: ;; an argument (let* ((struct (org-list-struct)) (old-struct (mapcar (lambda (e) (copy-alist e)) struct)) - (parents (org-list-struct-parent-alist struct)) - (prevs (org-list-struct-prev-alist struct))) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct))) (org-list-struct-fix-ind struct parents) (org-list-struct-fix-bul struct prevs) (when arg From 12de47aa5a8a56c1335ab2b9ca5b7ef1b89bf984 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 21 Jan 2011 16:31:30 +0100 Subject: [PATCH 076/107] org-list: code cleanup --- lisp/org-list.el | 85 ++++++++++++++++++++++++------------------------ 1 file changed, 42 insertions(+), 43 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 26cb34a8e..29c0a2c7b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -377,7 +377,7 @@ group 4: description tag") (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) -(defun org-item-beginning-re () +(defsubst org-item-beginning-re () "Regexp matching the beginning of a plain list item." (concat "^" (org-item-re))) @@ -601,6 +601,7 @@ Assume point is at an item." (lim-up (car context)) (lim-down (nth 1 context)) (text-min-ind 10000) + (item-re (org-item-re)) (drawers-re (concat "^[ \t]*:\\(" (mapconcat 'regexp-quote org-drawers "\\|") "\\):[ \t]*$")) @@ -642,7 +643,7 @@ Assume point is at an item." ;; Jump to part 2. (throw 'exit (setq itm-lst - (if (not (org-at-item-p)) + (if (not (looking-at item-re)) (memq (assq (car beg-cell) itm-lst) itm-lst) (setq beg-cell (cons (point) ind)) (cons (funcall assoc-at-point ind) itm-lst))))) @@ -665,7 +666,7 @@ Assume point is at an item." (forward-line -1)) ((looking-at "^[ \t]*$") (forward-line -1)) - ((org-at-item-p) + ((looking-at item-re) ;; Point is at an item. Add data to ITM-LST. It may ;; also end a previous item: save it in END-LST. If ;; ind is less or equal than BEG-CELL and there is no @@ -730,7 +731,7 @@ Assume point is at an item." (org-inlinetask-goto-end)) ((looking-at "^[ \t]*$") (forward-line 1)) - ((org-at-item-p) + ((looking-at item-re) ;; Point is at an item. Add data to ITM-LST-2. It may also ;; end a previous item, so save it in END-LST-2. (push (funcall assoc-at-point ind) itm-lst-2) @@ -825,7 +826,7 @@ This function modifies STRUCT." ;;; Accessors -(defun org-list-get-nth (n key struct) +(defsubst org-list-get-nth (n key struct) "Return the Nth value of KEY in STRUCT." (nth n (assq key struct))) @@ -834,7 +835,7 @@ This function modifies STRUCT." \nThis function modifies STRUCT." (setcar (nthcdr n (assq key struct)) new)) -(defun org-list-get-ind (item struct) +(defsubst org-list-get-ind (item struct) "Return indentation of ITEM in STRUCT." (org-list-get-nth 1 item struct)) @@ -843,7 +844,7 @@ This function modifies STRUCT." \nThis function modifies STRUCT." (org-list-set-nth 1 item struct ind)) -(defun org-list-get-bullet (item struct) +(defsubst org-list-get-bullet (item struct) "Return bullet of ITEM in STRUCT." (org-list-get-nth 2 item struct)) @@ -852,11 +853,11 @@ This function modifies STRUCT." \nThis function modifies STRUCT." (org-list-set-nth 2 item struct bullet)) -(defun org-list-get-counter (item struct) +(defsubst org-list-get-counter (item struct) "Return counter of ITEM in STRUCT." (org-list-get-nth 3 item struct)) -(defun org-list-get-checkbox (item struct) +(defsubst org-list-get-checkbox (item struct) "Return checkbox of ITEM in STRUCT or nil." (org-list-get-nth 4 item struct)) @@ -865,7 +866,7 @@ This function modifies STRUCT." \nThis function modifies STRUCT." (org-list-set-nth 4 item struct checkbox)) -(defun org-list-get-tag (item struct) +(defsubst org-list-get-tag (item struct) "Return end position of ITEM in STRUCT." (org-list-get-nth 5 item struct)) @@ -1538,18 +1539,17 @@ Initial position of cursor is restored after the changes." ;; Shift the indentation between END and BEG by DELTA. ;; Start from the line before END. (lambda (end beg delta) - (unless (= delta 0) - (goto-char end) - (forward-line -1) - (while (or (> (point) beg) - (and (= (point) beg) (not (org-at-item-p)))) - (when (org-looking-at-p "^[ \t]*\\S-") - (let ((i (org-get-indentation))) - (org-indent-line-to (+ i delta)))) - (forward-line -1)))))) + (goto-char end) + (forward-line -1) + (while (or (> (point) beg) + (and (= (point) beg) (not (org-at-item-p)))) + (when (org-looking-at-p "^[ \t]*\\S-") + (let ((i (org-get-indentation))) + (org-indent-line-to (+ i delta)))) + (forward-line -1))))) (modify-item (function - ;; Replace item first line elements with new elements from + ;; Replace ITEM first line elements with new elements from ;; STRUCT, if appropriate. (lambda (item) (goto-char item) @@ -1621,12 +1621,14 @@ Initial position of cursor is restored after the changes." (cdr (assq up itm-shift)) (cdr (assq (cdr (assq up end-list)) itm-shift))))) (push (list down up ind) sliced-struct))) - ;; 3. Modify each slice in buffer, from end to beginning, with a - ;; special action when beginning is at item start. + ;; 3. Shift each slice in buffer, provided delta isn't 0, from + ;; end to beginning. Take a special action when beginning is + ;; at item bullet. (mapc (lambda (e) - (apply shift-body-ind e) - (let ((beg (nth 1 e))) - (when (assq beg struct) + (unless (zerop (nth 2 e)) (apply shift-body-ind e)) + (let* ((beg (nth 1 e)) + (cell (assq beg struct))) + (unless (or (not cell) (equal cell (assq beg old-struct))) (funcall modify-item beg)))) sliced-struct)) ;; 4. Go back to initial position @@ -1641,7 +1643,7 @@ PARENTS is the alist of items' parents. See ;; bullets. ;; ;; 0. Save a copy of structure before modifications - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (let ((old-struct (copy-tree struct))) ;; 1. Set a temporary, but coherent with PARENTS, indentation in ;; order to get items endings and bullets properly (org-list-struct-fix-ind struct parents 2) @@ -1681,21 +1683,18 @@ PARENTS is the alist of items' parents. See ;;; Misc Tools -(defun org-list-bullet-string (bullet) +(defsubst org-list-bullet-string (bullet) "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 - (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))) + (let ((spaces (if (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 spaces nil nil bullet 1)))) (defun org-apply-on-list (function init-value &rest args) "Call FUNCTION on each item of the list at point. @@ -1817,7 +1816,7 @@ so this really moves item trees." (org-list-exchange-items actual-item next-item struct)) ;; Use a short variation of `org-list-write-struct' as there's ;; no need to go through all the steps. - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (let ((old-struct (copy-tree struct)) (prevs (org-list-prevs-alist struct)) (parents (org-list-parents-alist struct))) (org-list-struct-fix-bul struct prevs) @@ -1846,7 +1845,7 @@ so this really moves item trees." (org-list-exchange-items prev-item actual-item struct)) ;; Use a short variation of `org-list-write-struct' as there's ;; no need to go through all the steps. - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (let ((old-struct (copy-tree struct)) (prevs (org-list-prevs-alist struct)) (parents (org-list-parents-alist struct))) (org-list-struct-fix-bul struct prevs) @@ -1964,7 +1963,7 @@ is an integer, 0 means `-', 1 means `+' etc. If WHICH is (t (funcall get-value (1+ item-index)))))) ;; Use a short variation of `org-list-write-struct' as there's ;; no need to go through all the steps. - (let ((old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (let ((old-struct (copy-tree struct))) (org-list-set-bullet list-beg struct (org-list-bullet-string new)) (org-list-struct-fix-bul struct prevs) (org-list-struct-fix-ind struct parents) @@ -2036,7 +2035,7 @@ in subtree, ignoring drawers." (org-list-search-forward (org-item-beginning-re) lim-down 'move)) (let* ((struct (org-list-struct)) - (struct-copy (mapcar (lambda (e) (copy-alist e)) struct)) + (struct-copy (copy-tree struct)) (parents (org-list-parents-alist struct)) (prevs (org-list-prevs-alist struct)) (bottom (copy-marker (org-list-get-bottom-point struct))) @@ -2280,7 +2279,7 @@ STRUCT is the list structure. Return t if successful." (let* ((level-skip (org-level-increment)) (offset (if (< arg 0) (- level-skip) level-skip)) (top-ind (org-list-get-ind beg struct)) - (old-struct (mapcar (lambda (e) (copy-alist e)) struct))) + (old-struct (copy-tree struct))) (if (< (+ top-ind offset) 0) (error "Cannot outdent beyond margin") ;; Change bullet if necessary @@ -2560,7 +2559,7 @@ Point is left at list end." ;; checkboxes replaced. (lambda (beg end) (let ((text (org-trim (buffer-substring beg end)))) - (if (string-match "\\`\\[\\([xX ]\\)\\]" text) + (if (string-match "\\`\\[\\([X ]\\)\\]" text) (replace-match (if (equal (match-string 1 text) " ") "CBOFF" "CBON") t nil text 1) From d309256afffa208d936355bb88cdb6b83125bfb9 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 21 Jan 2011 17:11:58 +0100 Subject: [PATCH 077/107] org-list: fix corner cases in org-in-item-p * lisp/org-list.el (org-in-item-p): handle special cases when function is called with cursor amidst `org-list-end-re' or at an inline task. --- lisp/org-list.el | 34 ++++++++++++++++++++++++++-------- 1 file changed, 26 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 29c0a2c7b..ed77f71d1 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -97,6 +97,7 @@ (pom property &optional inherit literal-nil)) (declare-function org-get-indentation "org" (&optional line)) (declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-in-regexp "org" (re &optional nlines visually)) (declare-function org-in-regexps-block-p "org" (start-re end-re &optional bound)) (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) @@ -397,16 +398,33 @@ This checks `org-list-ending-method'." (save-excursion (beginning-of-line) (unless (or (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) - (and (not (eq org-list-ending-method 'indent)) - (looking-at org-list-end-re) - (progn (forward-line -1) (looking-at org-list-end-re)))) + (org-looking-back org-list-end-re)) + ;; Detect if cursor in amidst `org-list-end-re'. First, count + ;; number HL of hard lines it takes, then call `org-in-regexp' + ;; to compute its boundaries END-BOUNDS. When point is + ;; in-between, move cursor before regexp beginning. + (let ((hl 0) (i -1) end-bounds) + (when (and (not (eq org-list-ending-method 'indent)) + (progn + (while (setq i (string-match + "[\r\n]" org-list-end-re (1+ i))) + (setq hl (1+ hl))) + (setq end-bounds (org-in-regexp org-list-end-re hl))) + (>= (point) (car end-bounds)) + (< (point) (cdr end-bounds))) + (goto-char (car end-bounds)) + (forward-line -1))) (or (and (org-at-item-p) (point-at-bol)) (let* ((case-fold-search t) (context (org-list-context)) (lim-up (car context)) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) - (ind-ref (if (looking-at "^[ \t]*$") + ;; Indentation isn't meaningful when point starts at + ;; an empty line or an inline task. + (ind-ref (if (or (looking-at "^[ \t]*$") + (and inlinetask-re + (looking-at inlinetask-re))) 10000 (org-get-indentation)))) (catch 'exit @@ -430,10 +448,10 @@ This checks `org-list-ending-method'." ((looking-at "^[ \t]*$") (forward-line -1)) ((< ind ind-ref) - (if (org-at-item-p) - (throw 'exit (point)) - (setq ind-ref ind) - (forward-line -1))) + (cond + ((org-at-item-p) (throw 'exit (point))) + ((zerop ind) (throw 'exit nil)) + (t (setq ind-ref ind) (forward-line -1)))) (t (if (and (eq org-list-ending-method 'regexp) (org-at-item-p)) (throw 'exit (point)) From dcf23c416f8c132e716a718357fd398dc93bc09c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 23 Jan 2011 00:32:03 +0100 Subject: [PATCH 078/107] org-list: ignore lines with org-example property when creating structure * lisp/org-list.el (org-list-struct): when a line has org-example property, skip the entire block. This is needed during export, for example when src blocks in org markup contain lists, and are returned verbatim because org isn't in the list of interpreted languages. --- lisp/org-list.el | 44 +++++++++++++++++++++++++++++--------------- 1 file changed, 29 insertions(+), 15 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index ed77f71d1..361ae1bfe 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -621,8 +621,8 @@ Assume point is at an item." (text-min-ind 10000) (item-re (org-item-re)) (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) (beg-cell (cons (point) (org-get-indentation))) @@ -661,14 +661,22 @@ Assume point is at an item." ;; Jump to part 2. (throw 'exit (setq itm-lst - (if (not (looking-at item-re)) + (if (or (not (looking-at item-re)) + (get-text-property (point) 'org-example)) (memq (assq (car beg-cell) itm-lst) itm-lst) (setq beg-cell (cons (point) ind)) (cons (funcall assoc-at-point ind) itm-lst))))) + ;; At a verbatim block, go before its beginning. Move + ;; from eol to ensure `previous-single-property-change' + ;; will return a value. + ((get-text-property (point) 'org-example) + (goto-char (previous-single-property-change + (point-at-eol) 'org-example nil lim-up)) + (forward-line -1)) + ;; Looking at a list ending regexp. Dismiss useless + ;; data recorded above BEG-CELL. Jump to part 2. ((and (not (eq org-list-ending-method 'indent)) (looking-at org-list-end-re)) - ;; Looking at a list ending regexp. Dismiss useless - ;; data recorded above BEG-CELL. Jump to part 2. (throw 'exit (setq itm-lst (memq (assq (car beg-cell) itm-lst) itm-lst)))) @@ -732,10 +740,16 @@ Assume point is at an item." ;; part 3. (throw 'exit (push (cons 0 (funcall end-before-blank)) end-lst-2))) + ;; At a verbatim block, move to its end. Point is at bol + ;; and 'org-example property is set by whole lines: + ;; `next-single-property-change' always return a value. + ((get-text-property (point) 'org-example) + (goto-char + (next-single-property-change (point) 'org-example nil lim-down))) + ;; Looking at a list ending regexp. Save point as an + ;; ending position and jump to part 3. ((and (not (eq org-list-ending-method 'indent)) (looking-at org-list-end-re)) - ;; Looking at a list ending regexp. Save point as an - ;; ending position and jump to part 3. (throw 'exit (push (cons 0 (point-at-bol)) end-lst-2))) ;; Skip blocks, drawers, inline tasks and blank lines ;; along the way @@ -765,14 +779,14 @@ Assume point is at an item." ;; ;; - ind is lesser or equal than previous item's. This ;; is an ending position. Store it and proceed. - (cond - ((eq org-list-ending-method 'regexp)) - ((<= ind (cdr beg-cell)) - (push (cons ind (funcall end-before-blank)) end-lst-2) - (throw 'exit nil)) - ((<= ind (nth 1 (car itm-lst-2))) - (push (cons ind (point-at-bol)) end-lst-2))) - (forward-line 1)))))) + (cond + ((eq org-list-ending-method 'regexp)) + ((<= ind (cdr beg-cell)) + (push (cons ind (funcall end-before-blank)) end-lst-2) + (throw 'exit nil)) + ((<= ind (nth 1 (car itm-lst-2))) + (push (cons ind (point-at-bol)) end-lst-2))) + (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))) (setq end-lst (append end-lst (cdr (nreverse end-lst-2)))) ;; 3. Correct ill-formed lists by making sure top item has the From 89c066a10cee93b80998b64a64911e71c3f5ddf7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 23 Jan 2011 12:06:32 +0100 Subject: [PATCH 079/107] Newline-and-indent respects list structure * lisp/org.el (org-return): when called from inside an item with the indent flag, function should keep text moved inside the item. This allows to use C-j to separate lines in an item: cursor won't go back to column 0. --- lisp/org.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/lisp/org.el b/lisp/org.el index 2e6bd3bde..2b2501a44 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17490,6 +17490,18 @@ See the individual commands for more information." ((org-at-table-p) (org-table-justify-field-maybe) (call-interactively 'org-table-next-row)) + ;; when `newline-and-indent' is called within a list, make sure + ;; text moved stays inside the item. + ((and (org-in-item-p) indent) + (if (and (org-at-item-p) (>= (point) (match-end 0))) + (progn + (newline) + (org-indent-line-to (length (match-string 0)))) + (let ((ind (org-get-indentation))) + (newline) + (if (org-looking-back org-list-end-re) + (org-indent-line-function) + (org-indent-line-to ind))))) ((and org-return-follows-link (eq (get-text-property (point) 'face) 'org-link)) (call-interactively 'org-open-at-point)) From af6037a69599b5a8b848708b1a7e7d496e68ffcd Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 23 Jan 2011 13:34:06 +0100 Subject: [PATCH 080/107] Documentation changes for lists --- doc/org.texi | 52 +++++++++++++++++++++++++++-------------------- doc/orgguide.texi | 5 +++-- 2 files changed, 33 insertions(+), 24 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index c8e0597f7..c8a0c8884 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -1493,38 +1493,41 @@ visually indistinguishable from true headlines. In short: even though as bullets. @item @vindex org-plain-list-ordered-item-terminator +@vindex org-alphabetical-lists @emph{Ordered} list items start with a numeral followed by either a period or a right parenthesis@footnote{You can filter out any of them by configuring @code{org-plain-list-ordered-item-terminator}.}, such as @samp{1.} or -@samp{1)}. If you want a list to start with a different value (e.g.@: 20), start -the text of the item with @code{[@@20]}@footnote{If there's a checkbox in the -item, the cookie must be put @emph{before} the checkbox.}. Those constructs -can be used in any item of the list in order to enforce a particular -numbering. +@samp{1)}@footnote{You can also get @samp{a.}, @samp{A.}, @samp{a)} and +@samp{A)} by configuring @code{org-alphabetical-lists}. To minimize +confusion with normal text, those are limited to one character only. Beyond +that limit, items will automatically fallback to numbers.}. If you want a +list to start with a different value (e.g.@: 20), start the text of the item +with @code{[@@20]}@footnote{If there's a checkbox in the item, the cookie +must be put @emph{before} the checkbox. If you have activated alphabetical +lists, you can also use counters like @code{[@@b}.}. Those constructs can be +used in any item of the list in order to enforce a particular numbering. @item @emph{Description} list items are unordered list items, and contain the -separator @samp{ :: } to separate the description @emph{term} from the +separator @samp{ :: } to distinguish the description @emph{term} from the description. @end itemize Items belonging to the same list must have the same indentation on the first line. In particular, if an ordered list reaches number @samp{10.}, then the 2--digit numbers must be written left-aligned with the other numbers in the -list. +list. An item ends before the next line that is less or equally indented +than the bullet/number. @vindex org-list-ending-method @vindex org-list-end-regexp @vindex org-empty-line-terminates-plain-lists Two methods@footnote{To disable either of them, configure @code{org-list-ending-method}.} are provided to terminate lists. A list ends -before the next line that is indented like the bullet/number or less, or it -ends before two blank lines@footnote{See also -@code{org-empty-line-terminates-plain-lists}.}. In both cases, all levels of -the list are closed@footnote{So you cannot have a sublist, some text and then -another sublist while still in the same top-level list item. This used to be -possible, but it was only supported in the HTML exporter and difficult to -manage with automatic indentation.}. For finer control, you can end lists -with any pattern set in @code{org-list-end-regexp}. Here is an example: +whenever every item has ended, which means before any line less or equally +indented than items at top level. It also ends before two blank +lines@footnote{See also @code{org-empty-line-terminates-plain-lists}.}. In +that case, all items are closed. For finer control, you can end lists with +any pattern set in @code{org-list-end-regexp}. Here is an example: @example @group @@ -1535,8 +1538,8 @@ with any pattern set in @code{org-list-end-regexp}. Here is an example: + this was already my favorite scene in the book + I really like Miranda Otto. 3. Peter Jackson being shot by Legolas - He makes a really funny face when it happens. - on DVD only + He makes a really funny face when it happens. But in the end, no individual scenes matter but the film as a whole. Important actors in this film are: - @b{Elijah Wood} :: He plays Frodo @@ -1651,14 +1654,20 @@ depending on @code{org-plain-list-ordered-item-terminator}, the type of list, and its position@footnote{See @code{bullet} rule in @code{org-list-automatic-rules} for more information.}. With a numeric prefix argument N, select the Nth bullet from this list. If there is an -active region when calling this, all lines will be converted to list items. -If the first line already was a list item, any item markers will be removed -from the list. Finally, even without an active region, a normal line will be +active region when calling this, selected text will be changed into an item. +With a prefix argument, all lines will be converted to list items. If the +first line already was a list item, any item markers will be removed from the +list. Finally, even without an active region, a normal line will be converted into a list item. @kindex C-c * @item C-c * Turn a plain list item into a headline (so that it becomes a subheading at its location). @xref{Structure editing}, for a detailed explanation. +@kindex C-c C-* +@item C-c C-* +Turn the whole plain list into a subtree of the current heading. Checkboxes +(@pxref{Checkboxes}) will become TODO (resp. DONE) keywords when unchecked +(resp. checked). @kindex S-@key{left} @kindex S-@key{right} @item S-@key{left}/@key{right} @@ -4282,9 +4291,8 @@ this headline and the next (so @emph{not} the entire subtree). If there is no active region, just toggle the checkbox at point. @end itemize @orgcmd{M-S-@key{RET},org-insert-todo-heading} -Insert a new item with a checkbox. -This works only if the cursor is already in a plain list item -(@pxref{Plain lists}). +Insert a new item with a checkbox. This works only if the cursor is already +in a plain list item (@pxref{Plain lists}). @orgcmd{C-c C-x o,org-toggle-ordered-property} @vindex org-track-ordered-property-with-tag @cindex property, ORDERED diff --git a/doc/orgguide.texi b/doc/orgguide.texi index 0e6295a12..18671f9c2 100644 --- a/doc/orgguide.texi +++ b/doc/orgguide.texi @@ -494,8 +494,9 @@ description. @end itemize Items belonging to the same list must have the same indentation on the first -line. A list ends before the next line that is indented like the -bullet/number, or less. It also ends before two blank lines. An example: +line. An item ends before the next line that is indented like the +bullet/number, or less. A list ends when all items are closed, or before two +blank lines. An example: @smallexample @group From 304e8f1cd28ffae20d4f6da8315ed91c7442006b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 23 Jan 2011 18:23:22 +0100 Subject: [PATCH 081/107] Change behavior of org-toggle-item when used with normal text. * lisp/org.el (org-toggle-item): Now accepts a prefix argument. When used without argument on normal text, it will make the whole region one item. With an argument, it defaults to old behavior: change each line in region into an item. --- lisp/org.el | 44 ++++++++++++++++++++++++++++++++------------ 1 file changed, 32 insertions(+), 12 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 2b2501a44..f5a33c752 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17548,16 +17548,20 @@ Calls `org-table-insert-hline', `org-toggle-item', or (t (call-interactively 'org-toggle-item)))) -(defun org-toggle-item () +(defun org-toggle-item (arg) "Convert headings or normal lines to items, items to normal lines. If there is no active region, only the current line is considered. -If the first line in the region is a headline, convert all headlines to items. +If the first line in the region is a headline, convert all +headlines to items. -If the first line in the region is an item, convert all items to normal lines. +If the first line in the region is an item, convert all items to +normal lines. -If the first line is normal text, add an item bullet to each line." - (interactive) +If the first line is normal text, change region into an +item. With a prefix argument ARG, change each line in region into +an item." + (interactive "P") (let (l2 l beg end) (if (org-region-active-p) (setq beg (region-beginning) end (region-end)) @@ -17568,6 +17572,9 @@ If the first line is normal text, add an item bullet to each line." (setq l2 (org-current-line)) (goto-char beg) (beginning-of-line 1) + ;; Ignore blank lines at beginning of region + (skip-chars-forward " \t\r\n") + (beginning-of-line 1) (setq l (1- (org-current-line))) (if (org-at-item-p) ;; We already have items, de-itemize @@ -17582,13 +17589,26 @@ If the first line is normal text, add an item bullet to each line." (if (looking-at org-outline-regexp) (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 - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (beginning-of-line 2))))))) + ;; normal lines, with ARG, turn all of them into items + ;; unless they are already one. + (if arg + (while (< (setq l (1+ l)) l2) + (unless (org-at-item-p) + (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (beginning-of-line 2)) + ;; Without ARG, make the first line of region an item, and + ;; shift indentation of others lines to set them as item's + ;; body. + (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul))) + (skip-chars-forward " \t") + (insert bul) + (beginning-of-line 2) + (while (and (< (setq l (1+ l)) l2) (< (point) end)) + (org-indent-line-to (+ (org-get-indentation) bul-len)) + (beginning-of-line 2))))))))) (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. From 0850948deaa0fb57ba1050cfe073a821f3a23ea3 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 23 Jan 2011 21:59:36 +0100 Subject: [PATCH 082/107] org-list: small bug fix in org-list-struct-apply-struct * lisp/org-list.el (org-list-struct-apply-struct): if end of list was at eol, for example, with list inside a block, the last list wouldn't be shifted. Thus, the patch ensures no blank lines is skipped. --- 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 361ae1bfe..079a7b18a 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1572,7 +1572,8 @@ Initial position of cursor is restored after the changes." ;; Start from the line before END. (lambda (end beg delta) (goto-char end) - (forward-line -1) + (skip-chars-backward " \r\t\n") + (beginning-of-line) (while (or (> (point) beg) (and (= (point) beg) (not (org-at-item-p)))) (when (org-looking-at-p "^[ \t]*\\S-") From f7dbea5989cca4f83c8a6f33199f38a5ed1e7bbe Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 24 Jan 2011 19:15:22 +0100 Subject: [PATCH 083/107] Fix small bug in org-toggle-item * lisp/org.el (org-toggle-item): when used on normal text, ensure every line in region is included in the new item, regardless of its original indentation. --- lisp/org.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index f5a33c752..06b74ab27 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17602,12 +17602,16 @@ an item." ;; shift indentation of others lines to set them as item's ;; body. (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul))) + (bul-len (length bul)) + (ref-ind (org-get-indentation))) (skip-chars-forward " \t") (insert bul) (beginning-of-line 2) (while (and (< (setq l (1+ l)) l2) (< (point) end)) - (org-indent-line-to (+ (org-get-indentation) bul-len)) + ;; Ensure that lines less indented than first one + ;; still get included in item body. + (org-indent-line-to (+ (max ref-ind (org-get-indentation)) + bul-len)) (beginning-of-line 2))))))))) (defun org-toggle-heading (&optional nstars) From 3017425c483bbf85de94b98cba99345d13a5e657 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 24 Jan 2011 21:06:12 +0100 Subject: [PATCH 084/107] org-list: fix org-in-item-p when point is just after an ending regexp * lisp/org-list.el (org-in-item-p): When point was just after org-list-end-re, check wouldn't be done for starting line. So, if the first line was an item, it wouln't be noticed and function would return nil. Simplify and comment code. --- lisp/org-list.el | 124 +++++++++++++++++++++++++---------------------- 1 file changed, 65 insertions(+), 59 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 079a7b18a..96b1102e3 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -397,65 +397,71 @@ group 4: description tag") This checks `org-list-ending-method'." (save-excursion (beginning-of-line) - (unless (or (let ((outline-regexp org-outline-regexp)) (org-at-heading-p)) - (org-looking-back org-list-end-re)) - ;; Detect if cursor in amidst `org-list-end-re'. First, count - ;; number HL of hard lines it takes, then call `org-in-regexp' - ;; to compute its boundaries END-BOUNDS. When point is - ;; in-between, move cursor before regexp beginning. - (let ((hl 0) (i -1) end-bounds) - (when (and (not (eq org-list-ending-method 'indent)) - (progn - (while (setq i (string-match - "[\r\n]" org-list-end-re (1+ i))) - (setq hl (1+ hl))) - (setq end-bounds (org-in-regexp org-list-end-re hl))) - (>= (point) (car end-bounds)) - (< (point) (cdr end-bounds))) - (goto-char (car end-bounds)) - (forward-line -1))) - (or (and (org-at-item-p) (point-at-bol)) - (let* ((case-fold-search t) - (context (org-list-context)) - (lim-up (car context)) - (inlinetask-re (and (featurep 'org-inlinetask) - (org-inlinetask-outline-regexp))) - ;; Indentation isn't meaningful when point starts at - ;; an empty line or an inline task. - (ind-ref (if (or (looking-at "^[ \t]*$") - (and inlinetask-re - (looking-at inlinetask-re))) - 10000 - (org-get-indentation)))) - (catch 'exit - (while t - (let ((ind (org-get-indentation))) - (cond - ((<= (point) lim-up) - (throw 'exit (and (org-at-item-p) (< ind ind-ref) (point)))) - ((and (not (eq org-list-ending-method 'indent)) - (looking-at org-list-end-re)) - (throw 'exit nil)) - ;; Skip blocks, drawers, inline-tasks, blank lines - ((looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_" nil t)) - ((looking-at "^[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t) - (beginning-of-line)) - ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-beginning) - (forward-line -1)) - ((looking-at "^[ \t]*$") - (forward-line -1)) - ((< ind ind-ref) - (cond - ((org-at-item-p) (throw 'exit (point))) - ((zerop ind) (throw 'exit nil)) - (t (setq ind-ref ind) (forward-line -1)))) - (t (if (and (eq org-list-ending-method 'regexp) - (org-at-item-p)) - (throw 'exit (point)) - (forward-line -1)))))))))))) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + ;; Indentation isn't meaningful when point starts at an empty + ;; line or an inline task. + (ind-ref (if (or (looking-at "^[ \t]*$") + (and inlinetask-re (looking-at inlinetask-re))) + 10000 + (org-get-indentation)))) + (cond + ((eq (nth 2 context) 'invalid) nil) + ((org-at-item-p) (point)) + (t + ;; Detect if cursor in amidst `org-list-end-re'. First, count + ;; number HL of hard lines it takes, then call `org-in-regexp' + ;; to compute its boundaries END-BOUNDS. When point is + ;; in-between, move cursor before regexp beginning. + (let ((hl 0) (i -1) end-bounds) + (when (and (not (eq org-list-ending-method 'indent)) + (progn + (while (setq i (string-match + "[\r\n]" org-list-end-re (1+ i))) + (setq hl (1+ hl))) + (setq end-bounds (org-in-regexp org-list-end-re hl))) + (>= (point) (car end-bounds)) + (< (point) (cdr end-bounds))) + (goto-char (car end-bounds)) + (forward-line -1))) + ;; Look for an item, less indented that reference line if + ;; `org-list-ending-method' isn't `regexp'. + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ;; This is exactly what we want. + ((and (org-at-item-p) + (or (< ind ind-ref) + (eq org-list-ending-method 'regexp))) + (throw 'exit (point))) + ;; At upper bound of search or looking at the end of a + ;; previous list: search is over. + ((<= (point) lim-up) (throw 'exit nil)) + ((and (not (eq org-list-ending-method 'indent)) + (looking-at org-list-end-re)) + (throw 'exit nil)) + ;; Skip blocks, drawers, inline-tasks, blank lines + ((looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" nil t)) + ((looking-at "^[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") (forward-line -1)) + ;; Text at column 0 cannot belong to a list: stop. + ((zerop ind) (throw 'exit nil)) + ;; Normal text less indented than reference line, take + ;; it as new reference. + ((< ind ind-ref) + (setq ind-ref ind) + (forward-line -1)) + (t (forward-line -1))))))))))) (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" From 0bec47e9abad2d323a7ea389a3fda104bdf5b54f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 24 Jan 2011 21:21:51 +0100 Subject: [PATCH 085/107] org-list: keep byte-compiler happy --- lisp/org-list.el | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 96b1102e3..7b953f960 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -82,8 +82,10 @@ (require 'org-compat) (defvar org-blank-before-new-entry) -(defvar org-M-RET-may-split-line) (defvar org-complex-heading-regexp) +(defvar org-drawer-regexp) +(defvar org-drawers) +(defvar org-M-RET-may-split-line) (defvar org-odd-levels-only) (defvar org-outline-regexp) (defvar org-ts-regexp) @@ -93,6 +95,8 @@ (declare-function org-back-over-empty-lines "org" ()) (declare-function org-back-to-heading "org" (&optional invisible-ok)) (declare-function org-combine-plists "org" (&rest plists)) +(declare-function org-count "org" (cl-item cl-seq)) +(declare-function org-current-level "org" ()) (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) (declare-function org-get-indentation "org" (&optional line)) @@ -103,10 +107,12 @@ (declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) (declare-function org-inlinetask-goto-end "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) (declare-function org-invisible-p "org" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-on-heading-p "org" (&optional invisible-ok)) +(declare-function org-previous-line-empty-p "org" ()) (declare-function org-remove-if "org" (predicate seq)) (declare-function org-show-subtree "org" ()) (declare-function org-time-string-to-seconds "org" (s)) @@ -978,7 +984,7 @@ PREVS is the alist of previous items. See "List all children of ITEM in STRUCT, or nil. PARENTS is the alist of items' parent. See `org-list-parents-alist'." - (let (all) + (let (all child) (while (setq child (car (rassq item parents))) (setq parents (cdr (member (assq child parents) parents))) (push child all)) @@ -1072,6 +1078,19 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in ;;; Methods on structures +(defsubst org-list-bullet-string (bullet) + "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 + (let ((spaces (if (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 spaces nil nil bullet 1)))) + (defun org-list-separating-blank-lines-number (pos struct prevs) "Return number of blank lines that should separate items in list. POS is the position at item beginning to be considered. STRUCT is @@ -1722,19 +1741,6 @@ PARENTS is the alist of items' parents. See ;;; Misc Tools -(defsubst org-list-bullet-string (bullet) - "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 - (let ((spaces (if (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 spaces nil nil bullet 1)))) - (defun org-apply-on-list (function init-value &rest args) "Call FUNCTION on each item of the list at point. FUNCTION must be called with at least one argument: INIT-VALUE, @@ -2592,6 +2598,7 @@ Point is left at list end." (top (org-list-get-top-point struct)) (bottom (org-list-get-bottom-point struct)) out + parse-item ; for byte-compiler (get-text (function ;; Return text between BEG and END, trimmed, with @@ -2796,6 +2803,7 @@ items." (csep (plist-get p :csep)) (cbon (plist-get p :cbon)) (cboff (plist-get p :cboff)) + export-sublist ; for byte-compiler (export-item (function ;; Export an item ITEM of type TYPE, at DEPTH. First string From 0148fac717a978e49edd119d462637235d75f54f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Mon, 24 Jan 2011 23:37:35 +0100 Subject: [PATCH 086/107] org-list: make org-at-item-p less permissive * lisp/org-list.el (org-at-item-p): also verify context is valid. Otherwise it would recognize valid items where org-in-item-p wouldn't. (org-in-item-p, org-list-struct-apply-struct): use shorter version of org-at-item-p. (org-cycle-list-bullet): fix typo. (org-list-parse-list): avoid calling org-at-item-p two times by using an appropriate regexp * lisp/org.el (org-indent-line-function): use an appropriate regexp instead of calling org-at-item-p two times. --- lisp/org-list.el | 20 +++++++++++++------- lisp/org.el | 2 +- 2 files changed, 14 insertions(+), 8 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 7b953f960..c6e554de9 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -408,6 +408,7 @@ This checks `org-list-ending-method'." (lim-up (car context)) (inlinetask-re (and (featurep 'org-inlinetask) (org-inlinetask-outline-regexp))) + (item-re (org-item-re)) ;; Indentation isn't meaningful when point starts at an empty ;; line or an inline task. (ind-ref (if (or (looking-at "^[ \t]*$") @@ -416,7 +417,7 @@ This checks `org-list-ending-method'." (org-get-indentation)))) (cond ((eq (nth 2 context) 'invalid) nil) - ((org-at-item-p) (point)) + ((looking-at item-re) (point)) (t ;; Detect if cursor in amidst `org-list-end-re'. First, count ;; number HL of hard lines it takes, then call `org-in-regexp' @@ -440,7 +441,7 @@ This checks `org-list-ending-method'." (let ((ind (org-get-indentation))) (cond ;; This is exactly what we want. - ((and (org-at-item-p) + ((and (looking-at item-re) (or (< ind ind-ref) (eq org-list-ending-method 'regexp))) (throw 'exit (point))) @@ -471,7 +472,10 @@ This checks `org-list-ending-method'." (defun org-at-item-p () "Is point in a line starting a hand-formatted item?" - (save-excursion (beginning-of-line) (looking-at (org-item-beginning-re)))) + (save-excursion + (beginning-of-line) + (and (not (eq (nth 2 (org-list-context)) 'invalid)) + (looking-at (org-item-re))))) (defun org-at-item-bullet-p () "Is point at the bullet of a plain list item?" @@ -1591,6 +1595,7 @@ have changed. Initial position of cursor is restored after the changes." (let* ((pos (copy-marker (point))) + (item-re (org-item-re)) (shift-body-ind (function ;; Shift the indentation between END and BEG by DELTA. @@ -1600,7 +1605,8 @@ Initial position of cursor is restored after the changes." (skip-chars-backward " \r\t\n") (beginning-of-line) (while (or (> (point) beg) - (and (= (point) beg) (not (org-at-item-p)))) + (and (= (point) beg) + (not (looking-at item-re)))) (when (org-looking-at-p "^[ \t]*\\S-") (let ((i (org-get-indentation))) (org-indent-line-to (+ i delta)))) @@ -1958,7 +1964,7 @@ 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") - (unless (org-at-item-p) (error "This is not a list")) + (unless (org-at-item-p) (error "Not at an item")) (save-excursion (beginning-of-line) (let* ((struct (org-list-struct)) @@ -2619,12 +2625,12 @@ Point is left at list end." (mapcar parse-item e))))) (parse-item (function - ;; Return a list containing conter of item, if any, text + ;; Return a list containing counter of item, if any, text ;; and any sublist inside it. (lambda (e) (let ((start (save-excursion (goto-char e) - (or (org-at-item-counter-p) (org-at-item-p)) + (looking-at "[ \t]*\\S-+[ \t]+\\(\\[@[:[:alnum:]]+\\][ \t]*\\)?") (match-end 0))) ;; Get counter number. For alphabetic counter, get ;; its position in the alphabet. diff --git a/lisp/org.el b/lisp/org.el index 06b74ab27..64a597977 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18866,7 +18866,7 @@ If point is in an inline task, mark that task instead." (org-get-indentation (match-string 0))))) ;; Lists ((ignore-errors (goto-char (org-in-item-p))) - (or (org-at-item-description-p) (org-at-item-p)) + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \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 7ce76a7acc18f0073e116de856457fed404812da Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 26 Jan 2011 13:11:39 +0100 Subject: [PATCH 087/107] org-list: refactor org-list-struct --- lisp/org-list.el | 82 +++++++++++++++++++++--------------------------- 1 file changed, 36 insertions(+), 46 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index c6e554de9..2547a4d6b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -599,7 +599,7 @@ Contexts `block' and `invalid' refer to (defun org-list-struct () "Return structure of list at point. -A list structure is an alist where keys is point at item, and +A list structure is an alist where key is point at item, and values are: 1. indentation, 2. bullet with trailing whitespace, @@ -644,10 +644,8 @@ Assume point is at an item." (beg-cell (cons (point) (org-get-indentation))) ind itm-lst itm-lst-2 end-lst end-lst-2 struct (assoc-at-point - ;; Return an association whose key is point and values are - ;; indentation, bullet string, bullet counter, and - ;; checkbox. (function + ;; Return association at point. (lambda (ind) (looking-at org-list-full-item-re) (list (point) @@ -657,8 +655,8 @@ Assume point is at an item." (match-string-no-properties 3) ; checkbox (match-string-no-properties 4))))) ; description tag (end-before-blank - ;; Ensure list ends at the first blank line. (function + ;; Ensure list ends at the first blank line. (lambda () (skip-chars-backward " \r\t\n") (min (1+ (point-at-eol)) lim-down))))) @@ -715,31 +713,27 @@ Assume point is at an item." ;; end at this ind or lesser, this item becomes the ;; new BEG-CELL. (push (funcall assoc-at-point ind) itm-lst) - (push (cons ind (point-at-bol)) end-lst) + (push (cons ind (point)) end-lst) (when (or (and (eq org-list-ending-method 'regexp) (<= ind (cdr beg-cell))) (< ind text-min-ind)) - (setq beg-cell (cons (point-at-bol) ind))) + (setq beg-cell (cons (point) ind))) (forward-line -1)) + ;; From there, point is not at an item. Unless ending + ;; method is `regexp', interpret line's indentation: + ;; - text at column 0 is necessarily out of any list. + ;; Dismiss data recorded above BEG-CELL. Jump to + ;; part 2. + ;; - any other case, it can possibly be an ending + ;; position for an item above. Save it and proceed. + ((eq org-list-ending-method 'regexp) (forward-line -1)) + ((zerop ind) + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) (t - ;; Point is not at an item. Unless ending method is - ;; `regexp', interpret line's indentation: - ;; - ;; - text at column 0 is necessarily out of any list. - ;; Dismiss data recorded above BEG-CELL. Jump to - ;; part 2. - ;; - ;; - any other case, it can possibly be an ending - ;; position for an item above. Save it and proceed. - (cond - ((eq org-list-ending-method 'regexp)) - ((= ind 0) - (throw 'exit - (setq itm-lst - (memq (assq (car beg-cell) itm-lst) itm-lst)))) - (t - (when (< ind text-min-ind) (setq text-min-ind ind)) - (push (cons ind (point-at-bol)) end-lst))) + (when (< ind text-min-ind) (setq text-min-ind ind)) + (push (cons ind (point)) end-lst) (forward-line -1))))))) ;; 2. Read list from starting point to its end, that is until we ;; get out of context, or a non-item line is less or equally @@ -766,7 +760,7 @@ Assume point is at an item." ;; ending position and jump to part 3. ((and (not (eq org-list-ending-method 'indent)) (looking-at org-list-end-re)) - (throw 'exit (push (cons 0 (point-at-bol)) end-lst-2))) + (throw 'exit (push (cons 0 (point)) end-lst-2))) ;; Skip blocks, drawers, inline tasks and blank lines ;; along the way ((looking-at "^[ \t]*#\\+begin_") @@ -783,30 +777,26 @@ Assume point is at an item." ;; Point is at an item. Add data to ITM-LST-2. It may also ;; end a previous item, so save it in END-LST-2. (push (funcall assoc-at-point ind) itm-lst-2) - (push (cons ind (point-at-bol)) end-lst-2) + (push (cons ind (point)) end-lst-2) (forward-line 1)) - (t - ;; Point is not at an item. If ending method is not - ;; `regexp', two situations are of interest: - ;; - ;; - ind is lesser or equal than BEG-CELL's. The list is - ;; over. Store point as an ending position and jump to - ;; part 3. - ;; - ;; - ind is lesser or equal than previous item's. This - ;; is an ending position. Store it and proceed. - (cond - ((eq org-list-ending-method 'regexp)) - ((<= ind (cdr beg-cell)) - (push (cons ind (funcall end-before-blank)) end-lst-2) - (throw 'exit nil)) - ((<= ind (nth 1 (car itm-lst-2))) - (push (cons ind (point-at-bol)) end-lst-2))) + ;; From there, point is not at an item. If ending method + ;; is not `regexp', two situations are of interest: + ;; - ind is lesser or equal than BEG-CELL's. The list is + ;; over. Store point as an ending position and jump to + ;; part 3. + ;; - ind is lesser or equal than previous item's. This + ;; is an ending position. Store it and proceed. + ((eq org-list-ending-method 'regexp) (forward-line 1)) + ((<= ind (cdr beg-cell)) + (throw 'exit + (push (cons 0 (funcall end-before-blank)) end-lst-2))) + ((<= ind (nth 1 (car itm-lst-2))) + (push (cons ind (point)) end-lst-2) (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))) (setq end-lst (append end-lst (cdr (nreverse end-lst-2)))) - ;; 3. Correct ill-formed lists by making sure top item has the - ;; least indentation of the list + ;; 3. Correct ill-formed lists by ensuring top item is the least + ;; indented. (let ((min-ind (nth 1 (car struct)))) (mapc (lambda (item) (let ((ind (nth 1 item))) From 349196def43d45e4789a4504bdf057a6a19817bf Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 26 Jan 2011 13:25:37 +0100 Subject: [PATCH 088/107] org-list: forgot a default case in org-list-struct --- 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 2547a4d6b..a6f7ff73e 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -792,7 +792,8 @@ Assume point is at an item." (push (cons 0 (funcall end-before-blank)) end-lst-2))) ((<= ind (nth 1 (car itm-lst-2))) (push (cons ind (point)) end-lst-2) - (forward-line 1)))))) + (forward-line 1)) + (t (forward-line 1)))))) (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))) (setq end-lst (append end-lst (cdr (nreverse end-lst-2)))) ;; 3. Correct ill-formed lists by ensuring top item is the least From f7ebd6bcf0ab741d0cd1c840a3fb7e7b21e84d41 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 26 Jan 2011 21:36:39 +0100 Subject: [PATCH 089/107] org-list: ignore inline tasks when shifting an item, and fix indentation * lisp/org-list.el (org-list-struct-apply-struct): inline tasks along with their content must stay at column 0 even if the item is gaining indentation. Moreover, fix indentation of text in an inline task, now it can be in such a task within a list. --- lisp/org-list.el | 11 +++++++++-- lisp/org.el | 10 ++++++++-- 2 files changed, 17 insertions(+), 4 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a6f7ff73e..f5e04fef6 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1586,6 +1586,8 @@ have changed. Initial position of cursor is restored after the changes." (let* ((pos (copy-marker (point))) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) (item-re (org-item-re)) (shift-body-ind (function @@ -1598,9 +1600,14 @@ Initial position of cursor is restored after the changes." (while (or (> (point) beg) (and (= (point) beg) (not (looking-at item-re)))) - (when (org-looking-at-p "^[ \t]*\\S-") + (cond + ;; Skip inline tasks + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning)) + ;; Shift only non-empty lines + ((org-looking-at-p "^[ \t]*\\S-") (let ((i (org-get-indentation))) - (org-indent-line-to (+ i delta)))) + (org-indent-line-to (+ i delta))))) (forward-line -1))))) (modify-item (function diff --git a/lisp/org.el b/lisp/org.el index 64a597977..23137ecd5 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18833,6 +18833,8 @@ If point is in an inline task, mark that task instead." (org-drawer-regexp (or org-drawer-regexp "\000")) (inline-task-p (and (featurep 'org-inlinetask) (org-inlinetask-in-task-p))) + (inline-re (and inline-task-p + (org-inlinetask-outline-regexp))) column bpos bcol tpos tcol) (beginning-of-line 1) (cond @@ -18880,8 +18882,12 @@ If point is in an inline task, mark that task instead." (beginning-of-line 0) (while (and (not (bobp)) (not (looking-at org-drawer-regexp)) - ;; skip comments, verbatim, empty lines, tables, - ;; inline tasks, lists, drawers and blocks + ;; When point started in an inline task, do not move + ;; above task starting line. + (not (and inline-task-p + (looking-at inline-re))) + ;; Skip comments, verbatim, empty lines, tables, + ;; inline tasks, lists, drawers and blocks. (or (and (looking-at "[ \t]*:END:") (re-search-backward org-drawer-regexp nil t)) (and (looking-at "[ \t]*#\\+end_") From e5a61ab260281bc5c8e10896aca918b3bfb69f1b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 27 Jan 2011 21:11:47 +0100 Subject: [PATCH 090/107] org-list: update cookies in special contexts * lisp/org-list.el (org-update-checkbox-count): when a part of the buffer is processed to count checkboxes, lists are read from top to bottom, but inside lists (in drawers, blocks, or inline tasks) are skipped. Thus, cookies cannot be updated. This patch enforces reading of such lists if counter is itself in a special context. --- 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 f5e04fef6..ab10b7776 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2229,7 +2229,9 @@ With optional prefix argument ALL, do this for the whole buffer." ;; Cookie is at an item, and we already have list ;; structure stored in STRUCTS-BAK. ((and (org-at-item-p) - (< (point-at-bol) backup-end)) + (< (point-at-bol) backup-end) + ;; Only lists in no special context are stored. + (not (nth 2 (org-list-context)))) (funcall count-boxes (point-at-bol) structs-bak recursivep)) ;; Cookie is at an item, but we need to compute list ;; structure. From 69cc51fa43851dd6fcd856aea8e39805f46a26c1 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 30 Jan 2011 13:39:40 +0100 Subject: [PATCH 091/107] C-c C-c also repairs ill-formed lists * lisp/org-list.el (org-list-struct): mark items less indented than top item of the list, so that they will be modified. (org-list-struct-apply-struct): compare struct's indentation with line's indentation instead of old-struct's. This is needed because `org-list-struct' automatically fixes indentation so changes might not be seen otherwise. * lisp/org.el (org-ctrl-c-ctrl-c): small refactoring. --- lisp/org-list.el | 10 +++++++--- lisp/org.el | 2 +- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index ab10b7776..eec719d5d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -800,8 +800,12 @@ Assume point is at an item." ;; indented. (let ((min-ind (nth 1 (car struct)))) (mapc (lambda (item) - (let ((ind (nth 1 item))) - (when (< ind min-ind) (setcar (cdr item) min-ind)))) + (let ((ind (nth 1 item)) + (bul (nth 2 item))) + (when (< ind min-ind) + (setcar (cdr item) min-ind) + ;; Modify bullet to be sure item will be modified + (setcar (nthcdr 2 item) (org-trim bul))))) struct)) ;; 4. Associate each item to its end pos. (org-list-struct-assoc-end struct end-lst) @@ -1616,7 +1620,7 @@ Initial position of cursor is restored after the changes." (lambda (item) (goto-char item) (let* ((new-ind (org-list-get-ind item struct)) - (old-ind (org-list-get-ind item old-struct)) + (old-ind (org-get-indentation)) (new-bul (org-list-bullet-string (org-list-get-bullet item struct))) (old-bul (org-list-get-bullet item old-struct)) diff --git a/lisp/org.el b/lisp/org.el index 23137ecd5..8ef3bf51f 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17429,7 +17429,7 @@ This command does many different things, depending on context: ;; Do checkbox related actions only if function was called with ;; an argument (let* ((struct (org-list-struct)) - (old-struct (mapcar (lambda (e) (copy-alist e)) struct)) + (old-struct (copy-tree struct)) (parents (org-list-parents-alist struct)) (prevs (org-list-prevs-alist struct))) (org-list-struct-fix-ind struct parents) From b7f6a916b347eb0e766d02b24d444f081c11fc94 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 30 Jan 2011 17:42:38 +0100 Subject: [PATCH 092/107] Fix toggling and cycling visibility for items and inline tasks * lisp/org-inlinetask.el (org-inlinetask-at-task-p, org-inlinetask-toggle-visibility): new functions. * lisp/org-list.el (org-list-set-item-visibility): new function. * lisp/org.el (org-cycle, org-cycle-internal-local): separate lists and inline tasks from headlines. (org-outline-level): do not consider lists as headlines. Cycling visibility is using different tools. --- lisp/org-inlinetask.el | 27 ++++++++- lisp/org-list.el | 24 ++++++++ lisp/org.el | 125 ++++++++++++++++++++++++----------------- 3 files changed, 122 insertions(+), 54 deletions(-) diff --git a/lisp/org-inlinetask.el b/lisp/org-inlinetask.el index 483ce5f5c..31a5dbef7 100644 --- a/lisp/org-inlinetask.el +++ b/lisp/org-inlinetask.el @@ -42,7 +42,9 @@ ;; ;; Export commands do not treat these nodes as part of the sectioning ;; structure, but as a special inline text that is either removed, or -;; formatted in some special way. +;; formatted in some special way. This in handled by +;; `org-inlinetask-export' and `org-inlinetask-export-templates' +;; variables. ;; ;; Special fontification of inline tasks, so that they can be immediately ;; recognized. From the stars of the headline, only the first and the @@ -197,6 +199,13 @@ The number of levels is controlled by `org-inlinetask-min-level'." org-inlinetask-min-level))) (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) +(defun org-inlinetask-at-task-p () + "Return true if point is at beginning of an inline task." + (save-excursion + (beginning-of-line) + (and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) + (not (string-match "^end[ \t]*$" (downcase (match-string 2))))))) + (defun org-inlinetask-in-task-p () "Return true if point is inside an inline task." (save-excursion @@ -335,6 +344,22 @@ Either remove headline and meta data, or do special formatting." (add-text-properties (match-beginning 3) (match-end 3) '(face shadow font-lock-fontified t))))) +(defun org-inlinetask-toggle-visibility () + "Toggle visibility of inline task at point." + (let ((end (save-excursion + (org-inlinetask-goto-end) + (if (bolp) (1- (point)) (point)))) + (start (save-excursion + (org-inlinetask-goto-beginning) + (point-at-eol)))) + (cond + ;; Nothing to show/hide. + ((= end start)) + ;; Inlinetask was folded: expand it. + ((get-char-property (1+ start) 'invisible) + (outline-flag-region start end nil)) + (t (outline-flag-region start end t))))) + (defun org-inlinetask-remove-END-maybe () "Remove an END line when present." (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" diff --git a/lisp/org-list.el b/lisp/org-list.el index eec719d5d..a186c6319 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1774,6 +1774,30 @@ beginning of the item." (goto-char item) value)) +(defun org-list-set-item-visibility (item struct view) + "Set visibility of ITEM in STRUCT. + +Symbol VIEW determines visibility. Possible values are: `folded', +`children' or `subtree'. See `org-cycle' for more information." + (cond + ((eq view 'folded) + (let ((item-end (org-list-get-item-end-before-blank item struct))) + ;; Hide from eol + (outline-flag-region (save-excursion (goto-char item) (point-at-eol)) + item-end t))) + ((eq view 'children) + ;; First show everything. + (org-list-set-item-visibility item struct 'subtree) + ;; Then fold every child. + (let* ((parents (org-list-parents-alist struct)) + (children (org-list-get-children item struct parents))) + (mapc (lambda (e) + (org-list-set-item-visibility e struct 'folded)) + children))) + ((eq view 'subtree) + ;; Show everything + (let ((item-end (org-list-get-item-end item struct))) + (outline-flag-region item item-end nil))))) ;;; Interactive functions diff --git a/lisp/org.el b/lisp/org.el index 8ef3bf51f..2dd5cb3d6 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5455,14 +5455,10 @@ between words." This function assumes that the cursor is at the beginning of a line matched by `outline-regexp'. Otherwise it returns garbage. If this is called at a normal headline, the level is the number of stars. -Use `org-reduced-level' to remove the effect of `org-odd-levels'. -For plain list items, if they are matched by `outline-regexp', this returns -1000 plus the line indentation." +Use `org-reduced-level' to remove the effect of `org-odd-levels'." (save-excursion (looking-at outline-regexp) - (if (match-beginning 1) - (+ (org-get-string-indentation (match-string 1)) 1000) - (1- (- (match-end 0) (match-beginning 0)))))) + (1- (- (match-end 0) (match-beginning 0))))) (defvar org-font-lock-keywords nil) @@ -5839,14 +5835,9 @@ in special contexts. (and limit-level (1- (* limit-level 2))) limit-level))) (outline-regexp - (cond - ((not (org-mode-p)) outline-regexp) - ((or (eq org-cycle-include-plain-lists 'integrate) - (and org-cycle-include-plain-lists (org-at-item-p))) - (concat "\\(?:\\*" - (if nstars (format "\\{1,%d\\}" nstars) "+") - " \\|\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) \\)")) - (t (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))))) + (if (not (org-mode-p)) + outline-regexp + (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) (bob-special (and org-cycle-global-at-bob (not arg) (bobp) (not (looking-at outline-regexp)))) (org-cycle-hook @@ -5871,8 +5862,8 @@ in special contexts. (show-all) (message "Entire buffer visible, including drawers")) + ;; Table: enter it or move to the next field. ((org-at-table-p 'any) - ;; Enter the table or move to the next field in the table (if (org-at-table.el-p) (message "Use C-c ' to edit table.el tables") (if arg (org-table-edit-field t) @@ -5882,31 +5873,39 @@ in special contexts. ((run-hook-with-args-until-success 'org-tab-after-check-for-table-hook)) - ((eq arg t) ;; Global cycling - (org-cycle-internal-global)) + ;; Global cycling: delegate to `org-cycle-internal-global'. + ((eq arg t) (org-cycle-internal-global)) + ;; Drawers: delegate to `org-flag-drawer'. ((and org-drawers org-drawer-regexp (save-excursion (beginning-of-line 1) (looking-at org-drawer-regexp))) - ;; Toggle block visibility - (org-flag-drawer + (org-flag-drawer ; toggle block visibility (not (get-char-property (match-end 0) 'invisible)))) + ;; Show-subtree, ARG levels up from here. ((integerp arg) - ;; Show-subtree, ARG levels up from here. (save-excursion (org-back-to-heading) (outline-up-heading (if (< arg 0) (- arg) (- (funcall outline-level) arg))) (org-show-subtree))) - ((and (save-excursion (beginning-of-line 1) (looking-at outline-regexp)) + ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. + ((and (featurep 'org-inlinetask) + (org-inlinetask-at-task-p) (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-inlinetask-toggle-visibility)) + ;; At an item/headline: delegate to `org-cycle-internal-local'. + ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) + (save-excursion (beginning-of-line 1) + (looking-at outline-regexp))) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) (org-cycle-internal-local)) - ;; TAB emulation and template completion + ;; From there: TAB emulation and template completion. (buffer-read-only (org-back-to-heading)) ((run-hook-with-args-until-success @@ -5971,38 +5970,44 @@ in special contexts. (defun org-cycle-internal-local () "Do the local cycling action." - (let ((goal-column 0) eoh eol eos level has-children children-skipped) - ;; First, some boundaries + (let ((goal-column 0) eoh eol eos has-children children-skipped struct) + ;; First, determine end of headline (EOH), end of subtree or item + ;; (EOS), and if item or heading has children (HAS-CHILDREN). (save-excursion - (org-back-to-heading) - (setq level (funcall outline-level)) - (save-excursion - (beginning-of-line 2) - (if (or (featurep 'xemacs) (<= emacs-major-version 21)) - ; XEmacs does not have `next-single-char-property-change' - ; I'm not sure about Emacs 21. - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) + (if (org-at-item-p) + (progn + (beginning-of-line) + (setq struct (org-list-struct)) + (setq eoh (point-at-eol)) + (setq eos (org-list-get-item-end-before-blank (point) struct)) + (setq has-children (org-list-has-child-p (point) struct))) + (org-back-to-heading) + (setq eoh (save-excursion (outline-end-of-heading) (point))) + (setq eos (save-excursion + (org-end-of-subtree t) + (unless (eobp) + (skip-chars-forward " \t\n")) + (if (eobp) (point) (1- (point))))) + (setq has-children + (or (save-excursion + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (org-at-heading-p t) + (> (funcall outline-level) level)))) + (save-excursion + (org-list-search-forward (org-item-beginning-re) eos t))))) + ;; Determine end invisible part of buffer (EOL) + (beginning-of-line 2) + ;; XEmacs doesn't have `next-single-char-property-change' + (if (featurep 'xemacs) (while (and (not (eobp)) ;; this is like `next-line' (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2)))) - (setq eol (point))) - (outline-end-of-heading) (setq eoh (point)) - (save-excursion - (outline-next-heading) - (setq has-children (and (org-at-heading-p t) - (> (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 (if (and (org-end-of-item) (bolp)) - (1- (point)) - (point))) - (org-end-of-subtree t) - (unless (eobp) - (skip-chars-forward " \t\n")) - (setq eos (if (eobp) (point) (1- (point)))))) + (beginning-of-line 2)) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2)))) + (setq eol (point))) ;; Find out what to do next and set `this-command' (cond ((= eos eoh) @@ -6021,8 +6026,22 @@ in special contexts. org-cycle-skip-children-state-if-no-children)))) ;; Entire subtree is hidden in one line: children view (run-hook-with-args 'org-pre-cycle-hook 'children) - (org-show-entry) - (show-children) + (if (org-at-item-p) + (org-list-set-item-visibility (point-at-bol) struct 'children) + (org-show-entry) + (show-children) + ;; Fold every list in subtree to top-level items. + (when (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-back-to-heading) + (while (org-list-search-forward (org-item-beginning-re) eos t) + (beginning-of-line 1) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (end (org-list-get-bottom-point struct))) + (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) + (org-list-get-all-items (point) struct prevs)) + (goto-char end)))))) (message "CHILDREN") (save-excursion (goto-char eos) From 5adafe0c8df3c579b0b1e15592018d7859488107 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 30 Jan 2011 20:22:35 +0100 Subject: [PATCH 093/107] Changes to filling in items * lisp/org.el (org-set-autofill-regexps): use `org-item-re' in `paragraph-start' to recognize alphabetical lists. (org-fill-paragraph): enforce a pre-computed fill-prefix before calling fill-paragraph when point in in an item. Also prevent paragraphs getting merged into an adjacent list upon filling. (org-adaptive-fill-function): make sure to determine real fill-prefix for auto-fill. (org-auto-fill-function): use a pre-computed fill-prefix before calling do-auto-fill. * lisp/org-list.el (org-list-item-body-column): new function --- lisp/org-list.el | 15 +++++ lisp/org.el | 147 +++++++++++++++++++++++++++++++++++------------ 2 files changed, 124 insertions(+), 38 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index a186c6319..6a2da1790 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -83,6 +83,7 @@ (defvar org-blank-before-new-entry) (defvar org-complex-heading-regexp) +(defvar org-description-max-indent) (defvar org-drawer-regexp) (defvar org-drawers) (defvar org-M-RET-may-split-line) @@ -1799,6 +1800,20 @@ Symbol VIEW determines visibility. Possible values are: `folded', (let ((item-end (org-list-get-item-end item struct))) (outline-flag-region item item-end nil))))) +(defun org-list-item-body-column (item) + "Return column where body of ITEM should start." + (let (bpos bcol tpos tcol) + (save-excursion + (goto-char item) + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+") + (setq bpos (match-beginning 1) tpos (match-end 0) + bcol (progn (goto-char bpos) (current-column)) + tcol (progn (goto-char tpos) (current-column))) + (when (> tcol (+ bcol org-description-max-indent)) + (setq tcol (+ bcol 5)))) + tcol)) + + ;;; Interactive functions (defalias 'org-list-get-item-begin 'org-in-item-p) diff --git a/lisp/org.el b/lisp/org.el index 2dd5cb3d6..41019c7d3 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -18854,7 +18854,7 @@ If point is in an inline task, mark that task instead." (org-inlinetask-in-task-p))) (inline-re (and inline-task-p (org-inlinetask-outline-regexp))) - column bpos bcol tpos tcol) + column) (beginning-of-line 1) (cond ;; Comments @@ -18887,14 +18887,10 @@ If point is in an inline task, mark that task instead." (org-get-indentation (match-string 0))))) ;; Lists ((ignore-errors (goto-char (org-in-item-p))) - (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?[ \t]+") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column))) - (if (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5))) - (goto-char pos) - (setq column (if itemp (org-get-indentation) tcol))) + (setq column (if itemp + (org-get-indentation) + (org-list-item-body-column (point)))) + (goto-char pos)) ;; This line has nothing special, look at the previous relevant ;; line to compute indentation (t @@ -18970,7 +18966,7 @@ the functionality can be provided as a fall-back.") "[ ]*$" "\\|" "\\*+ " "\\|" "[ \t]*#" "\\|" - "[ \t]*\\([-+*][ \t]+\\|[0-9]+[.)][ \t]+\\)" "\\|" + (org-item-re) "\\|" "[ \t]*[:|]" "\\|" "\\$\\$" "\\|" "\\\\\\(begin\\|end\\|[][]\\)")) @@ -18996,6 +18992,7 @@ the functionality can be provided as a fall-back.") (org-set-local 'org-adaptive-fill-regexp-backup adaptive-fill-regexp)) (org-set-local 'adaptive-fill-regexp "\000") + (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) (org-set-local @@ -19007,42 +19004,116 @@ the functionality can be provided as a fall-back.") (defun org-fill-paragraph (&optional justify) "Re-align a table, pass through to fill-paragraph if no table." (let ((table-p (org-at-table-p)) - (table.el-p (org-at-table.el-p))) + (table.el-p (org-at-table.el-p)) + (itemp (org-in-item-p))) (cond ((and (equal (char-after (point-at-bol)) ?*) (save-excursion (goto-char (point-at-bol)) (looking-at outline-regexp))) - t) ; skip headlines - (table.el-p t) ; skip table.el tables - (table-p (org-table-align) t) ; align org-mode tables - (t nil)))) ; call paragraph-fill + t) ; skip headlines + (table.el-p t) ; skip table.el tables + (table-p (org-table-align) t) ; align Org tables + (itemp ; align text in items + (let* ((struct (save-excursion (goto-char itemp) + (org-list-struct))) + (parents (org-list-parents-alist struct)) + (children (org-list-get-children itemp struct parents)) + beg end prev next prefix) + ;; Determine in which part of item point is: before + ;; first child, after last child, between two + ;; sub-lists, or simply in item if there's no child. + (cond + ((not children) + (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) + beg itemp + end (org-list-get-item-end itemp struct))) + ((< (point) (setq next (car children))) + (setq prefix (make-string (org-list-item-body-column itemp) ?\ ) + beg itemp + end next)) + ((> (point) (setq prev (car (last children)))) + (setq beg (org-list-get-item-end prev struct) + end (org-list-get-item-end itemp struct) + prefix (save-excursion + (goto-char beg) + (skip-chars-forward " \t") + (make-string (current-column) ?\ )))) + (t (catch 'exit + (while (setq next (pop children)) + (if (> (point) next) + (setq prev next) + (setq beg (org-list-get-item-end prev struct) + end next + prefix (save-excursion + (goto-char beg) + (skip-chars-forward " \t") + (make-string (current-column) ?\ ))) + (throw 'exit nil)))))) + ;; Use `fill-paragraph' with buffer narrowed to item + ;; without any child, and with our computed PREFIX. + (flet ((fill-context-prefix (from to &optional flr) prefix)) + (save-restriction + (narrow-to-region beg end) + (save-excursion (fill-paragraph justify)))) t)) + ;; Special case where point is not in a list but is on a + ;; paragraph adjacent to a list: make sure this paragraph + ;; doesn't get merged with the end of the list by narrowing + ;; buffer first. + ((save-excursion + (fill-forward-paragraph -1) + (setq itemp (org-in-item-p))) + (save-excursion + (goto-char itemp) + (setq struct (org-list-struct))) + (save-restriction + (narrow-to-region (org-list-get-bottom-point struct) + (save-excursion + (fill-forward-paragraph 1) + (point))) + (fill-paragraph justify) t)) + (t nil)))) ; call `fill-paragraph' ;; For reference, this is the default value of adaptive-fill-regexp ;; "[ \t]*\\([-|#;>*]+[ \t]*\\|(?[0-9]+[.)][ \t]*\\)*" (defun org-adaptive-fill-function () - "Return a fill prefix for org-mode files. -In particular, this makes sure hanging paragraphs for hand-formatted lists -work correctly." - (cond - ;; Comment line - ((looking-at "#[ \t]+") - (match-string-no-properties 0)) - ;; Description list - ((looking-at "[ \t]*\\([-*+] .*? :: \\)") - (save-excursion - (if (> (match-end 1) (+ (match-beginning 1) - org-description-max-indent)) - (goto-char (+ (match-beginning 1) 5)) - (goto-char (match-end 0))) - (make-string (current-column) ?\ ))) - ;; Ordered or unordered list - ((looking-at "[ \t]*\\([-*+] \\|[0-9]+[.)] ?\\)") - (save-excursion - (goto-char (match-end 0)) - (make-string (current-column) ?\ ))) - ;; Other text - ((looking-at org-adaptive-fill-regexp-backup) - (match-string-no-properties 0)))) + "Return a fill prefix for org-mode files." + (let (itemp) + (save-excursion + (cond + ;; Comment line + ((looking-at "#[ \t]+") + (match-string-no-properties 0)) + ;; Point is in a list after `backward-paragraph': original + ;; point wasn't in the list, or filling would have been taken + ;; care of by `org-auto-fill-function', but the list and the + ;; real paragraph are not separated by a blank line. Thus, move + ;; point after the list to go back to real paragraph and + ;; determine fill-prefix. If point is at an item, do not + ;; compute prefix and list structure, as first line of + ;; paragraph will be skipped anyway. + ((org-at-item-p) "") + ((setq itemp (org-in-item-p)) + (goto-char itemp) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (goto-char bottom) + (make-string (org-get-indentation) ?\ ))) + ;; Other text + ((looking-at org-adaptive-fill-regexp-backup) + (match-string-no-properties 0)))))) + +(defun org-auto-fill-function () + "Auto-fill function." + (let (itemp prefix) + ;; When in a list, compute an appropriate fill-prefix and make + ;; sure it will be used by `do-auto-fill'. + (if (setq itemp (org-in-item-p)) + (progn + (setq prefix (make-string (org-list-item-body-column itemp) ?\ )) + (flet ((fill-context-prefix (from to &optional flr) prefix)) + (do-auto-fill))) + ;; Else just use `do-auto-fill'. + (do-auto-fill)))) ;;; Other stuff. From 2de0a87f7d1005a68e7da7ea8f0b44e5cde9fa13 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 30 Jan 2011 23:09:56 +0100 Subject: [PATCH 094/107] org-list: apply removal of org-invisible-p --- 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 6a2da1790..a719640d2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -109,7 +109,6 @@ (declare-function org-inlinetask-goto-end "org-inlinetask" ()) (declare-function org-inlinetask-in-task-p "org-inlinetask" ()) (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) -(declare-function org-invisible-p "org" ()) (declare-function org-level-increment "org" ()) (declare-function org-narrow-to-subtree "org" ()) (declare-function org-on-heading-p "org" (&optional invisible-ok)) @@ -121,6 +120,7 @@ (declare-function org-timer-item "org-timer" (&optional arg)) (declare-function org-trim "org" (s)) (declare-function org-uniquify "org" (list)) +(declare-function outline-invisible-p "outline" (&optional pos)) (declare-function outline-next-heading "outline" ()) (declare-function outline-previous-heading "outline" ()) @@ -1960,7 +1960,7 @@ item is invisible." (unless (or (not itemp) (save-excursion (goto-char itemp) - (org-invisible-p))) + (outline-invisible-p))) (if (save-excursion (goto-char itemp) (org-at-item-timer-p)) From b43ad47ad1fa3ad39eea7acbf53d6e3f3dc2fdf2 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 2 Feb 2011 17:57:59 +0100 Subject: [PATCH 095/107] Insert a newline character before <\li> when exporting lists * lisp/org-html.el (org-html-export-list-line): insert a newline character before ending an item, as anchor could be on a line going to be deleted, like a drawer ending string. * lisp/org-list.el (org-list-to-html): same. --- lisp/org-html.el | 2 +- lisp/org-list.el | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 4a6bde98b..59bfdc350 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2427,7 +2427,7 @@ the alist of previous items." ;; Ending for every item (org-close-li type) ;; We're ending last item of the list: end list. - (when lastp (insert (format "\n" type))))) + (when lastp (insert (format "\n\n" type))))) (funcall get-closings pos)) (cond ;; At an item: insert appropriate tags in export buffer. diff --git a/lisp/org-list.el b/lisp/org-list.el index a719640d2..85f6afb14 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2942,7 +2942,7 @@ with overruling parameters for `org-list-to-generic'." :dstart "
        " :dend "
        " :dtstart "
        " :dtend "
        \n" :ddstart "
        " :ddend "
        " - :istart "
      3. " :iend "
        4. " + :istart "
      4. " :iend "\n
        5. " :icount (format "
      5. " counter) :isep "\n" :lsep "\n" :csep "\n" :cbon "[X]" :cboff "[ ]") From f6bbdaf7cc1571680954b481cdbd046f39d29f91 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 2 Feb 2011 22:00:53 +0100 Subject: [PATCH 096/107] org-list: minor fix in regexp --- 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 85f6afb14..37efb3b84 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -364,7 +364,7 @@ specifically, type `block' is determined by the variable It depends on `org-empty-line-terminates-plain-lists'.") (defconst org-list-full-item-re - (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\)" + (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]*\\)" "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]\\)?" "\\(?:\\(\\[[ X-]\\]\\)[ \t]+\\)?" "\\(?:\\(.*\\)[ \t]+::[ \t]+\\)?") From feb1a17083e40fcf624a5da9ea9da7e921ca7c29 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 6 Feb 2011 17:17:11 +0100 Subject: [PATCH 097/107] org-exp: set correct text properties when replacing special blocks * lisp/org-exp.el (org-export-select-backend-specific-text): add `original-indentation' property when replacing #+begin_backend and #+backend blocks with their content. This is needed for lists, as they must know if the block belonged to them. --- lisp/org-exp.el | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/lisp/org-exp.el b/lisp/org-exp.el index ce7ac4ae1..15fb2029e 100644 --- a/lisp/org-exp.el +++ b/lisp/org-exp.el @@ -1609,7 +1609,7 @@ from the buffer." (ascii "ASCII" "BEGIN_ASCII" "END_ASCII") (latex "LaTeX" "BEGIN_LaTeX" "END_LaTeX"))) (case-fold-search t) - fmt beg beg-content end end-content) + fmt beg beg-content end end-content ind) (while formatters (setq fmt (pop formatters)) @@ -1622,13 +1622,14 @@ from the buffer." (replace-match "\\1\\2" t) (add-text-properties (point-at-bol) (min (1+ (point-at-eol)) (point-max)) - '(org-protected t)))) - ;; Delete #+attr_backend: stuff of another backend. Those + `(org-protected t original-indentation ,ind)))) + ;; Delete #+attr_Backend: stuff of another backend. Those ;; matching the current backend will be taken care of by ;; `org-export-attach-captions-and-attributes' (goto-char (point-min)) (while (re-search-forward (concat "^\\([ \t]*\\)#\\+attr_" (cadr fmt) ":[ \t]*\\(.*\\)") nil t) + (setq ind (org-get-indentation)) (when (not (eq (car fmt) backend)) (delete-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))))) ;; Handle #+begin_backend and #+end_backend stuff @@ -1636,13 +1637,16 @@ from the buffer." (while (re-search-forward (concat "^[ \t]*#\\+" (caddr fmt) "\\>.*\n?") nil t) (setq beg (match-beginning 0) beg-content (match-end 0)) + (setq ind (save-excursion (goto-char beg) (org-get-indentation))) (when (re-search-forward (concat "^[ \t]*#\\+" (cadddr fmt) "\\>.*\n?") nil t) (setq end (match-end 0) end-content (match-beginning 0)) (if (eq (car fmt) backend) ;; yes, keep this (progn - (add-text-properties beg-content end-content '(org-protected t)) + (add-text-properties + beg-content end-content + `(org-protected t original-indentation ,ind)) (delete-region (match-beginning 0) (match-end 0)) (save-excursion (goto-char beg) From 4fd61d8021b36f0316eca0693101bdadcfc4b94c Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 6 Feb 2011 17:33:49 +0100 Subject: [PATCH 098/107] org-html: unchecked boxes should not appear checked without CSS --- lisp/org-html.el | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 59bfdc350..9e43a8f31 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2467,10 +2467,9 @@ the alist of previous items." (setq body (concat (cond - ((string-match "X" checkbox) "[X] ") - ((string-match " " checkbox) - "[X] ") - (t "[-] ")) + ((string-match "X" checkbox) "[X] ") + ((string-match " " checkbox) "[ ] ") + (t "[-] ")) body))) ;; Return modified line body)) From 3d34dd47dd5364a7c614f4301f4b086c719a9eb0 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 8 Feb 2011 20:54:58 +0100 Subject: [PATCH 099/107] org-html: remove unneeded newline characters in list export --- lisp/org-html.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 9e43a8f31..50fb33ed8 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2427,7 +2427,7 @@ the alist of previous items." ;; Ending for every item (org-close-li type) ;; We're ending last item of the list: end list. - (when lastp (insert (format "\n\n" type))))) + (when lastp (insert (format "\n" type))))) (funcall get-closings pos)) (cond ;; At an item: insert appropriate tags in export buffer. @@ -2458,10 +2458,10 @@ the alist of previous items." (insert (format "<%sl>\n" type))) (insert (cond ((equal type "d") - (format "
        %s
        \n" desc-tag)) + (format "
        %s
        " desc-tag)) ((and (equal type "o") counter) - (format "
      6. \n" counter)) - (t "
      7. \n"))) + (format "
      8. " counter)) + (t "
      9. "))) ;; If line had a checkbox, some additional modification is required. (when checkbox (setq body From 1ac0ac16ac73a9852d8e4e0ee92daee5283db4f7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 9 Feb 2011 17:36:20 +0100 Subject: [PATCH 100/107] org-html: remove unused local variable --- lisp/org-html.el | 1 - 1 file changed, 1 deletion(-) diff --git a/lisp/org-html.el b/lisp/org-html.el index 50fb33ed8..5a76f2557 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -1116,7 +1116,6 @@ PUB-DIR is set, use this as the publishing directory." (inquote nil) (infixed nil) (inverse nil) - (llt org-plain-list-ordered-item-terminator) (email (plist-get opt-plist :email)) (language (plist-get opt-plist :language)) (keywords (plist-get opt-plist :keywords)) From de3d3652bb4ebea4d794db9ae9394af7c28fd9db Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Wed, 9 Feb 2011 22:58:07 +0100 Subject: [PATCH 101/107] org-html: use non breaking space for empty checkboxes --- 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 5a76f2557..ceba3bcbf 100644 --- a/lisp/org-html.el +++ b/lisp/org-html.el @@ -2467,7 +2467,7 @@ the alist of previous items." (concat (cond ((string-match "X" checkbox) "[X] ") - ((string-match " " checkbox) "[ ] ") + ((string-match " " checkbox) "[ ] ") (t "[-] ")) body))) ;; Return modified line From 713262edc1ba3703e60967873e202a1f09ba3789 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 12 Feb 2011 16:42:42 +0100 Subject: [PATCH 102/107] Preserve hierarchy when converting items to headlines and the other way * lisp/org.el (org-toggle-item, org-toggle-heading): make sure every sub-item in a list is changed into a sub-heading and sub-headings are translated into sub-items. Also ignore inline tasks in the process. org-toggle-item on headlines preserves hierarchy --- lisp/org.el | 221 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 129 insertions(+), 92 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 41019c7d3..b92186a60 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -17571,80 +17571,93 @@ Calls `org-table-insert-hline', `org-toggle-item', or "Convert headings or normal lines to items, items to normal lines. If there is no active region, only the current line is considered. -If the first line in the region is a headline, convert all -headlines to items. +If the first non blank line in the region is an headline, convert +all headlines to items. -If the first line in the region is an item, convert all items to -normal lines. +If it is an item, convert all items to normal lines. -If the first line is normal text, change region into an -item. With a prefix argument ARG, change each line in region into -an item." +If it is normal text, change region into an item. With a prefix +argument ARG, change each line in region into an item." (interactive "P") (let (l2 l beg end) (if (org-region-active-p) (setq beg (region-beginning) end (region-end)) (setq beg (point-at-bol) end (min (1+ (point-at-eol)) (point-max)))) - (save-excursion - (goto-char end) - (setq l2 (org-current-line)) - (goto-char beg) - (beginning-of-line 1) - ;; Ignore blank lines at beginning of region - (skip-chars-forward " \t\r\n") - (beginning-of-line 1) - (setq l (1- (org-current-line))) - (if (org-at-item-p) - ;; We already have items, de-itemize - (while (< (setq l (1+ l)) l2) - (when (org-at-item-p) - (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 (org-list-bullet-string "-") t t)) - (beginning-of-line 2)) - ;; normal lines, with ARG, turn all of them into items - ;; unless they are already one. - (if arg - (while (< (setq l (1+ l)) l2) - (unless (org-at-item-p) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (beginning-of-line 2)) - ;; Without ARG, make the first line of region an item, and - ;; shift indentation of others lines to set them as item's - ;; body. - (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - (ref-ind (org-get-indentation))) - (skip-chars-forward " \t") - (insert bul) - (beginning-of-line 2) - (while (and (< (setq l (1+ l)) l2) (< (point) end)) - ;; Ensure that lines less indented than first one - ;; still get included in item body. - (org-indent-line-to (+ (max ref-ind (org-get-indentation)) - bul-len)) - (beginning-of-line 2))))))))) + (org-with-limited-levels + (save-excursion + (goto-char end) + (setq l2 (org-current-line)) + (goto-char beg) + (beginning-of-line 1) + ;; Ignore blank lines at beginning of region + (skip-chars-forward " \t\r\n") + (beginning-of-line 1) + (setq l (1- (org-current-line))) + (cond + ;; Case 1. Start at an item: de-itemize. + ((org-at-item-p) + (while (< (setq l (1+ l)) l2) + (when (org-at-item-p) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) + (beginning-of-line 2))) + ;; Case 2. Start an an heading: convert to items. + ((org-on-heading-p) + (let* ((bul (org-list-bullet-string "-")) + (len (length bul)) + (ind 0) (level 0)) + (while (< (setq l (1+ l)) l2) + (cond + ((looking-at outline-regexp) + (let* ((lvl (org-reduced-level + (- (length (match-string 0)) 2))) + (s (concat (make-string (* len lvl) ? ) bul))) + (replace-match s t t) + (setq ind (length s) level lvl))) + ;; Ignore blank lines and inline tasks. + ((looking-at "^[ \t]*$")) + ((looking-at "^\\*+ ")) + ;; Ensure normal text belongs to the new item. + (t (org-indent-line-to (+ (max (- (org-get-indentation) level 2) 0) + ind)))) + (beginning-of-line 2)))) + ;; Case 3. Normal line with ARG: turn each of them into items + ;; unless they are already one. + (arg + (while (< (setq l (1+ l)) l2) + (unless (or (org-on-heading-p) (org-at-item-p)) + (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (beginning-of-line 2))) + ;; Case 4. Normal line without ARG: make the first line of + ;; region an item, and shift indentation of others + ;; lines to set them as item's body. + (t (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + (ref-ind (org-get-indentation))) + (skip-chars-forward " \t") + (insert bul) + (beginning-of-line 2) + (while (and (< (setq l (1+ l)) l2) (< (point) end)) + ;; Ensure that lines less indented than first one + ;; still get included in item body. + (org-indent-line-to (+ (max ref-ind (org-get-indentation)) + bul-len)) + (beginning-of-line 2))))))))) (defun org-toggle-heading (&optional nstars) "Convert headings to normal text, or items or text to headings. If there is no active region, only the current line is considered. -If the first line is a heading, remove the stars from all headlines -in the region. +If the first non blank line is an headline, remove the stars from +all headlines in the region. -If the first line is a plain list item, turn all plain list items -into headings. +If it is a plain list item, turn all plain list items into headings. -If the first line is a normal line, turn each and every line in the -region into a heading. +If it is a normal line, turn each and every normal line (i.e. not +an heading or an item) in the region into a heading. When converting a line into a heading, the number of stars is chosen such that the lines become children of the current entry. However, @@ -17653,41 +17666,65 @@ stars to add." (interactive "P") (let (l2 l itemp beg end) (if (org-region-active-p) - (setq beg (region-beginning) end (region-end)) + (setq beg (region-beginning) end (copy-marker (region-end))) (setq beg (point-at-bol) end (min (1+ (point-at-eol)) (point-max)))) - (save-excursion - (goto-char end) - (setq l2 (org-current-line)) - (goto-char beg) - (beginning-of-line 1) - (setq l (1- (org-current-line))) - (if (org-on-heading-p) - ;; We already have headlines, de-star them - (while (< (setq l (1+ l)) l2) - (when (org-on-heading-p t) - (and (looking-at outline-regexp) (replace-match ""))) - (beginning-of-line 2)) - (setq itemp (org-at-item-p)) - (let* ((stars - (if nstars - (make-string (prefix-numeric-value current-prefix-arg) - ?*) - (save-excursion - (if (re-search-backward org-complex-heading-regexp nil t) - (match-string 1) "")))) - (add-stars (cond (nstars "") - ((equal stars "") "*") - (org-odd-levels-only "**") - (t "*"))) - (rpl (concat stars add-stars " "))) - (while (< (setq l (1+ l)) l2) - (if itemp - (and (org-at-item-p) (replace-match rpl t t)) - (unless (org-on-heading-p) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match (concat rpl (match-string 2)))))) - (beginning-of-line 2))))))) + ;; Ensure inline tasks don't count as headings. + (org-with-limited-levels + (save-excursion + (goto-char end) + (setq l2 (org-current-line)) + (goto-char beg) + (beginning-of-line 1) + ;; Ignore blank lines at beginning of region + (skip-chars-forward " \t\r\n") + (beginning-of-line 1) + (setq l (1- (org-current-line))) + (cond + ;; Case 1. Started at an heading: de-star headings. + ((org-on-heading-p) + (while (< (setq l (1+ l)) l2) + (when (org-on-heading-p t) + (looking-at outline-regexp) (replace-match "")) + (beginning-of-line 2))) + ;; Case 2. Started at an item: change items into headlines. + ((org-at-item-p) + (let ((stars (make-string + (if nstars + (prefix-numeric-value current-prefix-arg) + (or (org-current-level) 0)) + ?*))) + (while (< (point) end) + (when (org-at-item-p) + ;; Pay attention to cases when region ends before list. + (let* ((struct (org-list-struct)) + (list-end (min (org-list-get-bottom-point struct) end))) + (save-restriction + (narrow-to-region (point) list-end) + (insert + (org-list-to-subtree + (org-list-parse-list t) + '(:istart (concat stars (funcall get-stars depth)) + :icount (concat stars + (funcall get-stars depth)))))))) + (beginning-of-line 2)))) + ;; Case 3. Started at normal text: make every line an heading, + ;; skipping headlines and items. + (t (let* ((stars (make-string + (if nstars + (prefix-numeric-value current-prefix-arg) + (or (org-current-level) 0)) + ?*)) + (add-stars (cond (nstars "") + ((equal stars "") "*") + (org-odd-levels-only "**") + (t "*"))) + (rpl (concat stars add-stars " "))) + (while (< (setq l (1+ l)) l2) + (unless (or (org-on-heading-p) (org-at-item-p)) + (when (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match (concat rpl (match-string 2))))) + (beginning-of-line 2))))))))) (defun org-meta-return (&optional arg) "Insert a new heading or wrap a region in a table. From 19ea827cd75bfefb6269297a72afeefa28c8c2e7 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 12 Feb 2011 23:52:40 +0100 Subject: [PATCH 103/107] org-list: unwrap org-entry-get from ignore-errors * lisp/org-list.el (org-toggle-checkbox, org-update-checkbox-count): no need to wrap org-entry-get in ignore-errors since commit 7dd425cc5d42fb297f547f713edfdc936f9271f0 --- lisp/org-list.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 37efb3b84..16a42eaa2 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -2079,7 +2079,7 @@ in subtree, ignoring drawers." block-item lim-up lim-down - (orderedp (ignore-errors (org-entry-get nil "ORDERED"))) + (orderedp (org-entry-get nil "ORDERED")) (bounds ;; In a region, start at first item in region (cond @@ -2189,9 +2189,7 @@ With optional prefix argument ALL, do this for the whole buffer." (recursivep (or (not org-hierarchical-checkbox-statistics) (string-match "\\" - (or (ignore-errors - (org-entry-get nil "COOKIE_DATA")) - "")))) + (or (org-entry-get nil "COOKIE_DATA") "")))) (bounds (if all (cons (point-min) (point-max)) (cons (or (ignore-errors (org-back-to-heading) (point)) From fde7e150bba642b89b62b9c9bbfcfb61bc082853 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 18 Feb 2011 13:41:49 +0100 Subject: [PATCH 104/107] org-list: docstrings changes --- lisp/org-list.el | 198 ++++++++++++++++++++++++----------------------- 1 file changed, 100 insertions(+), 98 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index 16a42eaa2..b28623511 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -927,14 +927,17 @@ Point returned is at end of line." (point-at-eol))) (defun org-list-get-parent (item struct parents) - "Return parent of ITEM in STRUCT, or nil. -PARENTS is the alist of items' parent. See -`org-list-parents-alist'." + "Return parent of ITEM or nil. +STRUCT is the list structure. PARENTS is the alist of parents, as +returned by `org-list-parents-alist'." (let ((parents (or parents (org-list-parents-alist struct)))) (cdr (assq item parents)))) (defun org-list-has-child-p (item struct) - "Return a non-nil value if ITEM in STRUCT has a child. + "Non-nil if ITEM has a child. + +STRUCT is the list structure. + Value returned is the position of the first child of ITEM." (let ((ind (org-list-get-ind item struct)) (child-maybe (car (nth 1 (member (assq item struct) struct))))) @@ -943,20 +946,20 @@ Value returned is the position of the first child of ITEM." child-maybe))) (defun org-list-get-next-item (item struct prevs) - "Return next item in same sub-list as ITEM in STRUCT, or nil. -PREVS is the alist of previous items. See -`org-list-prevs-alist'." + "Return next item in same sub-list as ITEM, or nil. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." (car (rassq item prevs))) (defun org-list-get-prev-item (item struct prevs) - "Return previous item in same sub-list as ITEM in STRUCT, or nil. -PREVS is the alist of previous items. See -`org-list-prevs-alist'." + "Return previous item in same sub-list as ITEM, or nil. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." (cdr (assq item prevs))) (defun org-list-get-subtree (item struct) - "Return all items with ITEM as a common ancestor or nil. -STRUCT is the list structure considered." + "List all items having ITEM as a common ancestor, or nil. +STRUCT is the list structure." (let* ((item-end (org-list-get-item-end item struct)) (sub-struct (cdr (member (assq item struct) struct))) subtree) @@ -968,9 +971,9 @@ STRUCT is the list structure considered." (nreverse subtree))) (defun org-list-get-all-items (item struct prevs) - "List of items in the same sub-list as ITEM in STRUCT. -PREVS is the alist of previous items. See -`org-list-prevs-alist'." + "List all items in the same sub-list as ITEM. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." (let ((prev-item item) (next-item item) before-item after-item) @@ -981,9 +984,9 @@ PREVS is the alist of previous items. See (append before-item (list item) (nreverse after-item)))) (defun org-list-get-children (item struct parents) - "List all children of ITEM in STRUCT, or nil. -PARENTS is the alist of items' parent. See -`org-list-parents-alist'." + "List all children of ITEM, or nil. +STRUCT is the list structure. PARENTS is the alist of parents, as +returned by `org-list-parents-alist'." (let (all child) (while (setq child (car (rassq item parents))) (setq parents (cdr (member (assq child parents) parents))) @@ -992,19 +995,19 @@ PARENTS is the alist of items' parent. See (defun org-list-get-top-point (struct) "Return point at beginning of list. -STRUCT is the structure of the list." +STRUCT is the list structure." (caar struct)) (defun org-list-get-bottom-point (struct) "Return point at bottom of list. -STRUCT is the structure of the list." +STRUCT is the list structure." (apply 'max (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) (defun org-list-get-list-begin (item struct prevs) "Return point at beginning of sub-list ITEM belongs. -STRUCT is the structure of the list. PREVS is the alist of -previous items. See `org-list-prevs-alist'." +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." (let ((first-item item) prev-item) (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) (setq first-item prev-item)) @@ -1014,8 +1017,8 @@ previous items. See `org-list-prevs-alist'." (defun org-list-get-last-item (item struct prevs) "Return point at last item of sub-list ITEM belongs. -STRUCT is the structure of the list. PREVS is the alist of -previous items. See `org-list-prevs-alist'." +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." (let ((last-item item) next-item) (while (setq next-item (org-list-get-next-item last-item struct prevs)) (setq last-item next-item)) @@ -1023,16 +1026,15 @@ previous items. See `org-list-prevs-alist'." (defun org-list-get-list-end (item struct prevs) "Return point at end of sub-list ITEM belongs. -STRUCT is the structure of the list. PREVS is the alist of -previous items. See `org-list-prevs-alist'." +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) (defun org-list-get-list-type (item struct prevs) - "Return the type of the list containing ITEM as a symbol. + "Return the type of the list containing ITEM, as a symbol. -STRUCT is the structure of the list, as returned by -`org-list-struct'. PREVS is the alist of previous items. See -`org-list-prevs-alist'. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. Possible types are `descriptive', `ordered' and `unordered'. The type is determined by the first item of the list." @@ -1047,8 +1049,8 @@ type is determined by the first item of the list." (defun org-list-search-generic (search re bound noerr) "Search a string in valid contexts for lists. -Arguments SEARCH, RE, BOUND and NOERR are similar to those in -`re-search-forward'." +Arguments SEARCH, RE, BOUND and NOERR are similar to those used +in `re-search-forward'." (catch 'exit (let ((origin (point))) (while t @@ -1075,7 +1077,6 @@ Arguments REGEXP, BOUND and NOERROR are similar to those used in regexp (or bound (point-max)) noerror)) - ;;; Methods on structures (defsubst org-list-bullet-string (bullet) @@ -1093,9 +1094,11 @@ It determines the number of whitespaces to append by looking at (defun org-list-separating-blank-lines-number (pos struct prevs) "Return number of blank lines that should separate items in list. -POS is the position at item beginning to be considered. STRUCT is -the list structure. PREVS is the alist of previous items. See -`org-list-prevs-alist'. + +POS is the position at item beginning to be considered. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. Assume point is at item's beginning. If the item is alone, apply some heuristics to guess the result." @@ -1136,19 +1139,18 @@ some heuristics to guess the result." (t 0)))))))) (defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet) - "Insert a new list item at POS. + "Insert a new list item at POS and return the new structure. If POS is before first character after bullet of the item, the new item will be created before the current one. -STRUCT is the list structure, as returned by `org-list-struct'. -PREVS is the the alist of previous items. See -`org-list-prevs-alist'. +STRUCT is the list structure. PREVS is the the alist of previous +items, as returned by `org-list-prevs-alist'. 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. -Return the new structure of the list." +This function modifies STRUCT." (let ((case-fold-search t)) ;; 1. Get information about list: structure, usual helper ;; functions, position of point with regards to item start @@ -1301,10 +1303,10 @@ This function modifies STRUCT." (sort struct (lambda (e1 e2) (< (car e1) (car e2))))))) (defun org-list-struct-outdent (start end struct parents) - "Outdent items between START and END in structure STRUCT. + "Outdent items between positions START and END. -PARENTS is the alist of items' parents. See -`org-list-parents-alist'. +STRUCT is the list structure. PARENTS is the alist of items' +parents, as returned by `org-list-parents-alist'. START is included, END excluded." (let* (acc @@ -1333,10 +1335,11 @@ START is included, END excluded." (mapcar out parents))) (defun org-list-struct-indent (start end struct parents prevs) - "Indent items between START and END in structure STRUCT. + "Indent items between positions START and END. -PARENTS is the alist of parents. See `org-list-parents-alist'. -PREVS is the alist of previous items. See `org-list-prevs-alist'. +STRUCT is the list structure. PARENTS is the alist of parents and +PREVS is the alist of previous items, returned by, respectively, +`org-list-parents-alist' and `org-list-prevs-alist'. START is included and END excluded. @@ -1384,10 +1387,10 @@ bullets between START and END." ;;; Repairing structures (defun org-list-use-alpha-bul-p (first struct prevs) - "Can list starting at FIRST use alphabetical bullets? + "Non-nil if list starting at FIRST can have alphabetical bullets. -STRUCT is list structure. See `org-list-struct'. PREVS is the -alist of previous items. See `org-list-prevs-alist'." +STRUCT is list structure. PREVS is the alist of previous items, +as returned by `org-list-prevs-alist'." (and org-alphabetical-lists (catch 'exit (let ((item first) (ascii 64) (case-fold-search nil)) @@ -1426,8 +1429,8 @@ alist of previous items. See `org-list-prevs-alist'." (t bullet)))) (defun org-list-struct-fix-bul (struct prevs) - "Verify and correct bullets for every association in STRUCT. -PREVS is the alist of previous items. See + "Verify and correct bullets in STRUCT. +PREVS is the alist of previous items, as returned by `org-list-prevs-alist'. This function modifies STRUCT." @@ -1495,9 +1498,9 @@ This function modifies STRUCT." (mapc fix-bul (mapcar 'car struct)))) (defun org-list-struct-fix-ind (struct parents &optional bullet-size) - "Verify and correct indentation for every association in STRUCT. + "Verify and correct indentation in STRUCT. -PARENTS is the alist of items' parents. See +PARENTS is the alist of parents, as returned by `org-list-parents-alist'. If numeric optional argument BULLET-SIZE is set, assume all @@ -1521,15 +1524,15 @@ This function modifies STRUCT." (mapc new-ind (mapcar 'car (cdr struct))))) (defun org-list-struct-fix-box (struct parents prevs &optional ordered) - "Verify and correct checkboxes for every association in STRUCT. + "Verify and correct checkboxes in STRUCT. -PARENTS is the alist of items' parents. See -`org-list-parents-alist'. PREVS is the alist of previous items. -See `org-list-prevs-alist'. +PARENTS is the alist of parents and PREVS is the alist of +previous items, as returned by, respectively, +`org-list-parents-alist' and `org-list-prevs-alist'. If ORDERED is non-nil, a checkbox can only be checked when every -checkbox before it is checked too. If there was an attempt to -break this rule, the function will return the blocking item. In +checkbox before it is checked too. If there was an attempt to +break this rule, the function will return the blocking item. In all others cases, the return value will be nil. This function modifies STRUCT." @@ -1583,11 +1586,11 @@ This function modifies STRUCT." (nth index all-items))))))) (defun org-list-struct-apply-struct (struct old-struct) - "Apply modifications to list so it mirrors STRUCT. + "Apply set-difference between STRUCT and OLD-STRUCT to the buffer. -OLD-STRUCT is the structure before any modifications. Thus, the -function is smart enough to modify only parts of buffer which -have changed. +OLD-STRUCT is the structure before any modifications, and STRUCT +the structure to be applied. The function will only modify parts +of the list which have changed. Initial position of cursor is restored after the changes." (let* ((pos (copy-marker (point))) @@ -1702,9 +1705,9 @@ Initial position of cursor is restored after the changes." (goto-char pos))) (defun org-list-write-struct (struct parents) - "Verify bullets, checkboxes, indentation in STRUCT and apply it to buffer. -PARENTS is the alist of items' parents. See -`org-list-parents-alist'." + "Correct bullets, checkboxes and indentation in list at point. +STRUCT is the list structure. PARENTS is the alist of parents, as +returned by `org-list-parents-alist'." ;; Order of functions matters here: checkboxes and endings need ;; correct indentation to be set, and indentation needs correct ;; bullets. @@ -1758,10 +1761,10 @@ previous item, plus ARGS extra arguments. FUNCTION is applied on items in reverse order. -As an example, (org-apply-on-list (lambda (result) (1+ result)) 0) +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* ((struct (org-list-struct)) (prevs (org-list-prevs-alist struct)) @@ -1776,10 +1779,10 @@ beginning of the item." value)) (defun org-list-set-item-visibility (item struct view) - "Set visibility of ITEM in STRUCT. + "Set visibility of ITEM in STRUCT to VIEW. -Symbol VIEW determines visibility. Possible values are: `folded', -`children' or `subtree'. See `org-cycle' for more information." +Possible values are: `folded', `children' or `subtree'. See +`org-cycle' for more information." (cond ((eq view 'folded) (let ((item-end (org-list-get-item-end-before-blank item struct))) @@ -1801,7 +1804,7 @@ Symbol VIEW determines visibility. Possible values are: `folded', (outline-flag-region item item-end nil))))) (defun org-list-item-body-column (item) - "Return column where body of ITEM should start." + "Return column at which body of ITEM should start." (let (bpos bcol tpos tcol) (save-excursion (goto-char item) @@ -1819,15 +1822,15 @@ Symbol VIEW determines visibility. Possible values are: `folded', (defalias 'org-list-get-item-begin 'org-in-item-p) (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." + "Go to the beginning of the current item. +Throw an error when not in a list." (interactive) (let ((begin (org-in-item-p))) (if begin (goto-char begin) (error "Not in an item")))) (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." +Throw an error when not in a list." (interactive) (let ((begin (org-in-item-p))) (if (not begin) @@ -1839,7 +1842,7 @@ Return an error if not in a list." (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." +Throw an error when not in a list." (interactive) (let ((begin (org-in-item-p))) (if (not begin) @@ -1850,8 +1853,8 @@ If the cursor in not in an item, throw an error." (goto-char (org-list-get-list-end begin struct prevs)))))) (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." + "Go to the end of the current item. +Throw an error when not in a list." (interactive) (let ((begin (org-in-item-p))) (if (not begin) @@ -1862,8 +1865,7 @@ If the cursor is not in an item, throw an error." (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." +Throw an error when not in a list, or at first item." (interactive) (let ((begin (org-in-item-p))) (if (not begin) @@ -1876,8 +1878,7 @@ in a plain list, or if this is the first item in the list." (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." +Throw an error when not in a plain list, or at last item." (interactive) (let ((begin (org-in-item-p))) (if (not begin) @@ -1889,9 +1890,9 @@ in a plain list, or if this is the last item in the list." (if prevp (goto-char prevp) (error "On last item")))))) (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." + "Move the 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) (unless (org-at-item-p) (error "Not at an item")) (let* ((pos (point)) @@ -1918,9 +1919,9 @@ so this really moves item trees." (org-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." + "Move the 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) (unless (org-at-item-p) (error "Not at an item")) (let* ((pos (point)) @@ -1987,8 +1988,7 @@ item is invisible." t))))) (defun org-list-repair () - "Make sure all items are correctly indented, with the right bullet. -This function scans the list at point, along with any sublist." + "Fix indentation, bullets and checkboxes is the list at point." (interactive) (unless (org-at-item-p) (error "This is not a list")) (let* ((struct (org-list-struct)) @@ -2067,8 +2067,8 @@ 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 -first checkbox there, and make every item inside 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 @@ -2332,7 +2332,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. -STRUCT is the list structure. Return t if successful." +STRUCT is the list structure. + +Return t if successful." (save-excursion (beginning-of-line) (let* ((regionp (org-region-active-p)) @@ -2464,8 +2466,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 indents the item, if applicable. Subsequents runs -outdent it at meaningful levels in the list. When done, item is +The first run indents 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." @@ -2509,9 +2511,9 @@ Return t at each successful move." t)))) (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) - "Sort plain list items. + "Sort list items. The cursor may be at any item of the list that should be sorted. -Sublists are not sorted. Checkboxes, if any, are ignored. +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 10d76f720a1f32e7fa73cb3359c1beae2b72da84 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Fri, 18 Feb 2011 06:13:29 -0700 Subject: [PATCH 105/107] ob: adjust to changes in list format * lisp/ob.el (org-babel-result-end): Adjust marker of list end to changes in the list format. --- lisp/ob.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 88226e873..36e843ff3 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -1585,8 +1585,8 @@ code ---- the results are extracted in the syntax of the source (cond ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) ((org-at-item-p) (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct))) - (org-list-get-list-end (point-at-bol) struct prevs))) + (prvs (org-list-prevs-alist struct))) + (1- (org-list-get-list-end (point-at-bol) struct prvs)))) (t (let ((case-fold-search t) (blocks-re (regexp-opt From c6dbde1babaa0b2efa278d75a6ec82f91ef59d5e Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Fri, 18 Feb 2011 15:15:54 +0100 Subject: [PATCH 106/107] Fix bug when redoing a block agenda command. * org-agenda.el (org-agenda): Set the 'last-args property to nil when calling `org-agenda'. Don't kill the local variable `org-agenda-current-span'. (org-run-agenda-series): Use the new property 'last-args. (org-agenda-change-time-span): Use the dynamically set `org-agenda-overriding-arguments' variable when non-nil. Thanks to Matt Lundin and Michael Brand for reporting this. --- lisp/org-agenda.el | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 54de77505..67b53f139 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -2159,9 +2159,10 @@ Pressing `<' twice means to restrict to the current subtree or region (move-marker org-agenda-restrict-end nil)) ;; Delete old local properties (put 'org-agenda-redo-command 'org-lprops nil) + ;; Delete previously set last-arguments + (put 'org-agenda-redo-command 'last-args nil) ;; Remember where this call originated (setq org-agenda-last-dispatch-buffer (current-buffer)) - (kill-local-variable 'org-agenda-current-span) (unless keys (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) keys (car ans) @@ -2462,6 +2463,10 @@ s Search for keywords C Configure custom agenda commands (org-let (nth 1 series) '(org-prepare-agenda name)) (let* ((org-agenda-multi t) (redo (list 'org-run-agenda-series name (list 'quote series))) + (org-agenda-overriding-arguments + (or org-agenda-overriding-arguments + (unless (null (delq nil (get 'org-agenda-redo-command 'last-args))) + (get 'org-agenda-redo-command 'last-args)))) (cmds (car series)) (gprops (nth 1 series)) match ;; The byte compiler incorrectly complains about this. Keep it! @@ -2496,6 +2501,7 @@ s Search for keywords C Configure custom agenda commands (t (error "Invalid type in command series")))) (widen) (setq org-agenda-redo-command redo) + (put 'org-agenda-redo-command 'last-args org-agenda-last-arguments) (goto-char (point-min))) (org-fit-agenda-window) (org-let (nth 1 series) '(org-finalize-agenda))) @@ -6292,7 +6298,8 @@ SPAN may be `day', `week', `month', `year'." org-starting-day)) (sd (org-agenda-compute-starting-span sd span n)) (org-agenda-overriding-arguments - (list (car org-agenda-last-arguments) sd span t))) + (or org-agenda-overriding-arguments + (list (car org-agenda-last-arguments) sd span t)))) (org-agenda-redo) (org-agenda-find-same-or-today-or-agenda)) (org-agenda-set-mode-name) From 9ec8510687bdf1c0fba598810ec86bcfc3a91840 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 19 Feb 2011 01:16:59 +0100 Subject: [PATCH 107/107] org.texi: minor corrections --- doc/org.texi | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/doc/org.texi b/doc/org.texi index c8a0c8884..4d442a574 100644 --- a/doc/org.texi +++ b/doc/org.texi @@ -1500,12 +1500,12 @@ a right parenthesis@footnote{You can filter out any of them by configuring @samp{1)}@footnote{You can also get @samp{a.}, @samp{A.}, @samp{a)} and @samp{A)} by configuring @code{org-alphabetical-lists}. To minimize confusion with normal text, those are limited to one character only. Beyond -that limit, items will automatically fallback to numbers.}. If you want a +that limit, bullets will automatically fallback to numbers.}. If you want a list to start with a different value (e.g.@: 20), start the text of the item with @code{[@@20]}@footnote{If there's a checkbox in the item, the cookie must be put @emph{before} the checkbox. If you have activated alphabetical -lists, you can also use counters like @code{[@@b}.}. Those constructs can be -used in any item of the list in order to enforce a particular numbering. +lists, you can also use counters like @code{[@@b]}.}. Those constructs can +be used in any item of the list in order to enforce a particular numbering. @item @emph{Description} list items are unordered list items, and contain the separator @samp{ :: } to distinguish the description @emph{term} from the