-;;; org-list.el --- Plain lists for Org-mode
-;;
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
-;; Free Software Foundation, Inc.
-;;
-;; Author: Carsten Dominik <carsten at orgmode dot org>
-;; Bastien Guerry <bzg AT altern DOT org>
-;; Keywords: outlines, hypermedia, calendar, wp
-;; Homepage: http://orgmode.org
-;; Version: 6.33x
-;;
-;; This file is part of GNU Emacs.
-;;
-;; GNU Emacs is free software: you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation, either version 3 of the License, or
-;; (at your option) any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;;; Commentary:
-
-;; This file contains the code dealing with plain lists in Org-mode.
-
-;;; Code:
-
-(require 'org-macs)
-(require 'org-compat)
-
-(defvar org-blank-before-new-entry)
-(defvar org-M-RET-may-split-line)
-(defvar org-complex-heading-regexp)
-(defvar org-odd-levels-only)
-
-(declare-function org-invisible-p "org" ())
-(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-back-over-empty-lines "org" ())
-(declare-function org-skip-whitespace "org" ())
-(declare-function org-trim "org" (s))
-(declare-function org-get-indentation "org" (&optional line))
-(declare-function org-timer-item "org-timer" (&optional arg))
-(declare-function org-combine-plists "org" (&rest plists))
-(declare-function org-entry-get "org" (pom property &optional inherit))
-(declare-function org-narrow-to-subtree "org" ())
-(declare-function org-show-subtree "org" ())
-
-(defgroup org-plain-lists nil
- "Options concerning plain lists in Org-mode."
- :tag "Org Plain lists"
- :group 'org-structure)
-
-(defcustom org-cycle-include-plain-lists t
- "When t, make TAB cycle visibility on plain list items.
-
-Cycling plain lists works only when the cursor is on a plain list
-item. When the cursor is on an outline heading, plain lists are
-treated as text. This is the most stable way of handling this,
-which is why it is the default.
-
-When this is the symbol `integrate', then during cycling, plain
-list items will *temporarily* be interpreted as outline headlines
-with a level given by 1000+i where i is the indentation of the
-bullet. This setting can lead to strange effects when switching
-visibility to `children', because the first \"child\" in a
-subtree decides what children should be listed. If that first
-\"child\" is a plain list item with an implied large level
-number, all true children and grand children of the outline
-heading will be exposed in a children' view."
- :group 'org-plain-lists
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "With cursor in plain list (recommended)" t)
- (const :tag "As children of outline headings" integrate)))
-
-(defcustom org-list-demote-modify-bullet nil
- "Default bullet type installed when demoting an item.
-This is an association list, for each bullet type, this alist will point
-to the bulled that should be used when this item is demoted."
- :group 'org-plain-lists
- :type '(repeat
- (cons
- (choice :tag "If the current bullet is "
- (const "-")
- (const "+")
- (const "*")
- (const "1.")
- (const "1)"))
- (choice :tag "demotion will change it to"
- (const "-")
- (const "+")
- (const "*")
- (const "1.")
- (const "1)")))))
-
-(defcustom org-plain-list-ordered-item-terminator t
- "The character that makes a line with leading number an ordered list item.
-Valid values are ?. and ?\). To get both terminators, use t. While
-?. may look nicer, it creates the danger that a line with leading
-number may be incorrectly interpreted as an item. ?\) therefore is
-the safe choice."
- :group 'org-plain-lists
- :type '(choice (const :tag "dot like in \"2.\"" ?.)
- (const :tag "paren like in \"2)\"" ?\))
- (const :tab "both" t)))
-
-(defcustom org-list-two-spaces-after-bullet-regexp nil
- "A regular expression matching bullets that should have 2 spaces after them.
-When nil, no bullet will have two spaces after them.
-When a string, it will be used as a regular expression. When the bullet
-type of a list is changed, the new bullet type will be matched against this
-regexp. If it matches, there will be two spaces instead of one after
-the bullet in each item of he list."
- :group 'org-plain-list
- :type '(choice
- (const :tag "never" nil)
- (regexp)))
-
-(defcustom org-empty-line-terminates-plain-lists nil
- "Non-nil means, an empty line ends all plain list levels.
-When nil, empty lines are part of the preceding item."
- :group 'org-plain-lists
- :type 'boolean)
-
-(defcustom org-auto-renumber-ordered-lists t
- "Non-nil means, automatically renumber ordered plain lists.
-Renumbering happens when the sequence have been changed with
-\\[org-shiftmetaup] or \\[org-shiftmetadown]. After other editing commands,
-use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
- :group 'org-plain-lists
- :type 'boolean)
-
-(defcustom org-provide-checkbox-statistics t
- "Non-nil means, update checkbox statistics after insert and toggle.
-When this is set, checkbox statistics is updated each time you
-either insert a new checkbox with \\[org-insert-todo-heading] or
-toggle a checkbox with \\[org-ctrl-c-ctrl-c]."
- :group 'org-plain-lists
- :type 'boolean)
-
-(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.
-This can be set to nil on a per-node basis using a COOKIE_DATA property
-with the word \"recursive\" in the value."
- :group 'org-plain-lists
- :type 'boolean)
-
-(defcustom org-description-max-indent 20
- "Maximum indentation for the second line of a description list.
-When the indentation would be larger than this, it will become
-5 characters instead."
- :group 'org-plain-lists
- :type 'integer)
-
-(defvar org-list-beginning-re
- "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$")
-
-(defcustom org-list-radio-list-templates
- '((latex-mode "% BEGIN RECEIVE ORGLST %n
-% END RECEIVE ORGLST %n
-\\begin{comment}
-#+ORGLST: SEND %n org-list-to-latex
-| | |
-\\end{comment}\n")
- (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
-@c END RECEIVE ORGLST %n
-@ignore
-#+ORGLST: SEND %n org-list-to-texinfo
-| | |
-@end ignore\n")
- (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
-<!-- END RECEIVE ORGLST %n -->
-<!--
-#+ORGLST: SEND %n org-list-to-html
-| | |
--->\n"))
- "Templates for radio lists in different major modes.
-All occurrences of %n in a template will be replaced with the name of the
-list, obtained by prompting the user."
- :group 'org-plain-lists
- :type '(repeat
- (list (symbol :tag "Major mode")
- (string :tag "Format"))))
-
-;;;; Plain list items, including checkboxes
-
-;;; Plain list items
-
-(defun org-at-item-p ()
- "Is point in a line starting a hand-formatted item?"
- (let ((llt org-plain-list-ordered-item-terminator))
- (save-excursion
- (goto-char (point-at-bol))
- (looking-at
- (cond
- ((eq llt t) "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
- ((= llt ?.) "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
- ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
- (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
-
-(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-in-item-p ()
- "It the cursor inside a plain list item.
-Does not have to be the first line."
- (save-excursion
- (condition-case nil
- (progn
- (org-beginning-of-item)
- (org-at-item-p)
- t)
- (error nil))))
-
-(defun org-insert-item (&optional checkbox)
- "Insert a new item at the current level.
-Return t when things worked, nil when we are not in an item."
- (when (save-excursion
- (condition-case nil
- (progn
- (org-beginning-of-item)
- (org-at-item-p)
- (if (org-invisible-p) (error "Invisible item"))
- t)
- (error nil)))
- (let* ((bul (match-string 0))
- (descp (save-excursion (goto-char (match-beginning 0))
- (beginning-of-line 1)
- (save-match-data
- (and (looking-at "[ \t]*\\(.*?\\) ::")
- (match-string 1)))))
- (empty-line-p (save-excursion
- (goto-char (match-beginning 0))
- (and (not (bobp))
- (or (beginning-of-line 0) t)
- (save-match-data
- (looking-at "[ \t]*$")))))
- (timerp (and descp
- (save-match-data
- (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$"
- descp))))
- (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
- (match-end 0)))
- (blank-a (if org-empty-line-terminates-plain-lists
- nil
- (cdr (assq 'plain-list-item org-blank-before-new-entry))))
- (blank (if (eq blank-a 'auto) empty-line-p blank-a))
- pos)
- (if descp (setq checkbox nil))
- (if timerp
- (progn (org-timer-item) t)
- (cond
- ((and (org-at-item-p) (<= (point) eow))
- ;; before the bullet
- (beginning-of-line 1)
- (open-line (if blank 2 1)))
- ((<= (point) eow)
- (beginning-of-line 1))
- (t
- (unless (org-get-alist-option org-M-RET-may-split-line 'item)
- (end-of-line 1)
- (delete-horizontal-space))
- (newline (if blank 2 1))))
- (insert bul
- (if checkbox "[ ]" "")
- (if descp (concat (if checkbox " " "")
- (read-string "Term: ") " :: ") ""))
- (just-one-space)
- (setq pos (point))
- (end-of-line 1)
- (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
- (org-maybe-renumber-ordered-list)
- (and checkbox (org-update-checkbox-count-maybe))
- t)))
-
-;;; Checkboxes
-
-(defun org-at-item-checkbox-p ()
- "Is point at a line starting a plain-list item with a checklet?"
- (and (org-at-item-p)
- (save-excursion
- (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (looking-at "\\[[- X]\\]"))))
-
-(defun org-toggle-checkbox (&optional toggle-presence)
- "Toggle the checkbox in the current line.
-With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.
-With double prefix, set checkbox to [-].
-When there is an active region, toggle status or presence of the checkbox
-in the first line, and make every item in the region have the same
-status or presence, respectively.
-If the cursor is in a headline, apply this to all checkbox items in the
-text below the heading."
- (interactive "P")
- (catch 'exit
- (let (beg end status first-present first-status blocked)
- (cond
- ((org-region-active-p)
- (setq beg (region-beginning) end (region-end)))
- ((org-on-heading-p)
- (setq beg (point) end (save-excursion (outline-next-heading) (point))))
- ((org-at-item-checkbox-p)
- (save-excursion
- (if (equal toggle-presence '(4))
- (progn
- (replace-match "")
- (goto-char (match-beginning 0))
- (just-one-space))
- (when (setq blocked (org-checkbox-blocked-p))
- (error "Checkbox blocked because of unchecked box in line %d"
- blocked))
- (replace-match
- (cond ((equal toggle-presence '(16)) "[-]")
- ((member (match-string 0) '("[ ]" "[-]")) "[X]")
- (t "[ ]"))
- t t)))
- (throw 'exit t))
- ((org-at-item-p)
- ;; add a checkbox
- (save-excursion
- (goto-char (match-end 0))
- (insert "[ ] "))
- (throw 'exit t))
- (t (error "Not at a checkbox or heading, and no active region")))
- (setq end (move-marker (make-marker) end))
- (save-excursion
- (goto-char beg)
- (setq first-present (org-at-item-checkbox-p)
- first-status
- (save-excursion
- (and (re-search-forward "[ \t]\\(\\[[ X]\\]\\)" end t)
- (equal (match-string 1) "[X]"))))
- (while (< (point) end)
- (if toggle-presence
- (cond
- ((and first-present (org-at-item-checkbox-p))
- (save-excursion
- (replace-match "")
- (goto-char (match-beginning 0))
- (just-one-space)))
- ((and (not first-present) (not (org-at-item-checkbox-p))
- (org-at-item-p))
- (save-excursion
- (goto-char (match-end 0))
- (insert "[ ] "))))
- (when (org-at-item-checkbox-p)
- (setq status (equal (match-string 0) "[X]"))
- (replace-match
- (if first-status "[ ]" "[X]") t t)))
- (beginning-of-line 2)))))
- (org-update-checkbox-count-maybe))
-
-(defun org-reset-checkbox-state-subtree ()
- "Reset all checkboxes in an entry subtree."
- (interactive "*")
- (save-restriction
- (save-excursion
- (org-narrow-to-subtree)
- (org-show-subtree)
- (goto-char (point-min))
- (let ((end (point-max)))
- (while (< (point) end)
- (when (org-at-item-checkbox-p)
- (replace-match "[ ]" t t))
- (beginning-of-line 2))))
- (org-update-checkbox-count-maybe)))
-
-(defun org-checkbox-blocked-p ()
- "Is the current checkbox blocked from for being checked now?
-A checkbox is blocked if all of the following conditions are fulfilled:
-
-1. The checkbox is not checked already.
-2. The current entry has the ORDERED property set.
-3. There is an unchecked checkbox in this entry before the current line."
- (catch 'exit
- (save-match-data
- (save-excursion
- (unless (org-at-item-checkbox-p) (throw 'exit nil))
- (when (equal (match-string 0) "[X]")
- ;; the box is already checked!
- (throw 'exit nil))
- (let ((end (point-at-bol)))
- (condition-case nil (org-back-to-heading t)
- (error (throw 'exit nil)))
- (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
- (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t)
- (org-current-line)
- nil))))))
-
-(defvar org-checkbox-statistics-hook nil
- "Hook that is run whenever Org thinks checkbox statistics should be updated.
-This hook runs even if `org-provide-checkbox-statistics' is nil, to it can
-be used to implement alternative ways of collecting statistics information.")
-
-(defun org-update-checkbox-count-maybe ()
- "Update checkbox statistics unless turned off by user."
- (when org-provide-checkbox-statistics
- (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 update them
-with the current numbers. With optional prefix argument ALL, do this for
-the whole buffer."
- (interactive "P")
- (save-excursion
- (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
- (beg (condition-case nil
- (progn (org-back-to-heading) (point))
- (error (point-min))))
- (end (move-marker (make-marker)
- (progn (outline-next-heading) (point))))
- (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
- (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
- (re-find (concat re "\\|" re-box))
- beg-cookie end-cookie is-percent c-on c-off lim new
- eline curr-ind next-ind continue-from startsearch
- (recursive
- (or (not org-hierarchical-checkbox-statistics)
- (string-match "\\<recursive\\>"
- (or (org-entry-get nil "COOKIE_DATA") ""))))
- (cstat 0)
- )
- (when all
- (goto-char (point-min))
- (outline-next-heading)
- (setq beg (point) end (point-max)))
- (goto-char end)
- ;; find each statistics cookie
- (while (and (re-search-backward re-find beg t)
- (not (save-match-data
- (and (org-on-heading-p)
- (string-match "\\<todo\\>"
- (downcase
- (or (org-entry-get
- nil "COOKIE_DATA")
- "")))))))
- (setq beg-cookie (match-beginning 1)
- end-cookie (match-end 1)
- cstat (+ cstat (if end-cookie 1 0))
- startsearch (point-at-eol)
- continue-from (match-beginning 0)
- is-percent (match-beginning 2)
- lim (cond
- ((org-on-heading-p) (outline-next-heading) (point))
- ((org-at-item-p) (org-end-of-item) (point))
- (t nil))
- c-on 0
- c-off 0)
- (when lim
- ;; find first checkbox for this cookie and gather
- ;; statistics from all that are at this indentation level
- (goto-char startsearch)
- (if (re-search-forward re-box lim t)
- (progn
- (org-beginning-of-item)
- (setq curr-ind (org-get-indentation))
- (setq next-ind curr-ind)
- (while (and (bolp) (org-at-item-p)
- (if recursive
- (<= curr-ind next-ind)
- (= curr-ind next-ind)))
- (save-excursion (end-of-line) (setq eline (point)))
- (if (re-search-forward re-box eline t)
- (if (member (match-string 2) '("[ ]" "[-]"))
- (setq c-off (1+ c-off))
- (setq c-on (1+ c-on))))
- (if (not recursive)
- (org-end-of-item)
- (end-of-line)
- (when (re-search-forward org-list-beginning-re lim t)
- (beginning-of-line)))
- (setq next-ind (org-get-indentation)))))
- (goto-char continue-from)
- ;; update cookie
- (when end-cookie
- (setq new (if is-percent
- (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
- (format "[%d/%d]" c-on (+ c-on c-off))))
- (goto-char beg-cookie)
- (insert new)
- (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
- ;; update items checkbox if it has one
- (when (org-at-item-p)
- (org-beginning-of-item)
- (when (and (> (+ c-on c-off) 0)
- (re-search-forward re-box (point-at-eol) t))
- (setq beg-cookie (match-beginning 2)
- end-cookie (match-end 2))
- (delete-region beg-cookie end-cookie)
- (goto-char beg-cookie)
- (cond ((= c-off 0) (insert "[X]"))
- ((= c-on 0) (insert "[ ]"))
- (t (insert "[-]")))
- )))
- (goto-char continue-from))
- (when (interactive-p)
- (message "Checkbox statistics updated %s (%d places)"
- (if all "in entire file" "in current outline entry") cstat)))))
-
-(defun org-get-checkbox-statistics-face ()
- "Select the face for checkbox statistics.
-The face will be `org-done' when all relevant boxes are checked. Otherwise
-it will be `org-todo'."
- (if (match-end 1)
- (if (equal (match-string 1) "100%")
- 'org-checkbox-statistics-done
- 'org-checkbox-statistics-todo)
- (if (and (> (match-end 2) (match-beginning 2))
- (equal (match-string 2) (match-string 3)))
- 'org-checkbox-statistics-done
- 'org-checkbox-statistics-todo)))
-
-(defun org-beginning-of-item ()
- "Go to the beginning of the current hand-formatted item.
-If the cursor is not in an item, throw an error."
- (interactive)
- (let ((pos (point))
- (limit (save-excursion
- (condition-case nil
- (progn
- (org-back-to-heading)
- (beginning-of-line 2) (point))
- (error (point-min)))))
- (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
- ind ind1)
- (if (org-at-item-p)
- (beginning-of-line 1)
- (beginning-of-line 1)
- (skip-chars-forward " \t")
- (setq ind (current-column))
- (if (catch 'exit
- (while t
- (beginning-of-line 0)
- (if (or (bobp) (< (point) limit)) (throw 'exit nil))
-
- (if (looking-at "[ \t]*$")
- (setq ind1 ind-empty)
- (skip-chars-forward " \t")
- (setq ind1 (current-column)))
- (if (< ind1 ind)
- (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
- nil
- (goto-char pos)
- (error "Not in an item")))))
-
-(defun org-end-of-item ()
- "Go to the end of the current hand-formatted item.
-If the cursor is not in an item, throw an error."
- (interactive)
- (let* ((pos (point))
- ind1
- (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
- (limit (save-excursion (outline-next-heading) (point)))
- (ind (save-excursion
- (org-beginning-of-item)
- (skip-chars-forward " \t")
- (current-column)))
- (end (catch 'exit
- (while t
- (beginning-of-line 2)
- (if (eobp) (throw 'exit (point)))
- (if (>= (point) limit) (throw 'exit (point-at-bol)))
- (if (looking-at "[ \t]*$")
- (setq ind1 ind-empty)
- (skip-chars-forward " \t")
- (setq ind1 (current-column)))
- (if (<= ind1 ind)
- (throw 'exit (point-at-bol)))))))
- (if end
- (goto-char end)
- (goto-char pos)
- (error "Not in an item"))))
-
-(defun org-next-item ()
- "Move to the beginning of the next item in the current plain list.
-Error if not at a plain list, or if this is the last item in the list."
- (interactive)
- (let (ind ind1 (pos (point)))
- (org-beginning-of-item)
- (setq ind (org-get-indentation))
- (org-end-of-item)
- (setq ind1 (org-get-indentation))
- (unless (and (org-at-item-p) (= ind ind1))
- (goto-char pos)
- (error "On last item"))))
-
-(defun org-previous-item ()
- "Move to the beginning of the previous item in the current plain list.
-Error if not at a plain list, or if this is the first item in the list."
- (interactive)
- (let (beg ind ind1 (pos (point)))
- (org-beginning-of-item)
- (setq beg (point))
- (setq ind (org-get-indentation))
- (goto-char beg)
- (catch 'exit
- (while t
- (beginning-of-line 0)
- (if (looking-at "[ \t]*$")
- nil
- (if (<= (setq ind1 (org-get-indentation)) ind)
- (throw 'exit t)))))
- (condition-case nil
- (if (or (not (org-at-item-p))
- (< ind1 (1- ind)))
- (error "")
- (org-beginning-of-item))
- (error (goto-char pos)
- (error "On first item")))))
-
-(defun org-first-list-item-p ()
- "Is this heading the first item in a plain list?"
- (unless (org-at-item-p)
- (error "Not at a plain list item"))
- (save-excursion
- (org-beginning-of-item)
- (= (point) (save-excursion (org-beginning-of-item-list)))))
-
-(defun org-move-item-down ()
- "Move the plain list item at point down, i.e. swap with following item.
-Subitems (items with larger indentation) are considered part of the item,
-so this really moves item trees."
- (interactive)
- (let ((col (current-column))
- (pos (point))
- beg beg0 end end0 ind ind1 txt ne-end ne-beg)
- (org-beginning-of-item)
- (setq beg0 (point))
- (save-excursion
- (setq ne-beg (org-back-over-empty-lines))
- (setq beg (point)))
- (goto-char beg0)
- (setq ind (org-get-indentation))
- (org-end-of-item)
- (setq end0 (point))
- (setq ind1 (org-get-indentation))
- (setq ne-end (org-back-over-empty-lines))
- (setq end (point))
- (goto-char beg0)
- (when (and (org-first-list-item-p) (< ne-end ne-beg))
- ;; include less whitespace
- (save-excursion
- (goto-char beg)
- (forward-line (- ne-beg ne-end))
- (setq beg (point))))
- (goto-char end0)
- (if (and (org-at-item-p) (= ind ind1))
- (progn
- (org-end-of-item)
- (org-back-over-empty-lines)
- (setq txt (buffer-substring beg end))
- (save-excursion
- (delete-region beg end))
- (setq pos (point))
- (insert txt)
- (goto-char pos) (org-skip-whitespace)
- (org-maybe-renumber-ordered-list)
- (move-to-column col))
- (goto-char pos)
- (move-to-column col)
- (error "Cannot move this item further down"))))
-
-(defun org-move-item-up (arg)
- "Move the plain list item at point up, i.e. swap with previous item.
-Subitems (items with larger indentation) are considered part of the item,
-so this really moves item trees."
- (interactive "p")
- (let ((col (current-column)) (pos (point))
- beg beg0 end ind ind1 txt
- ne-beg ne-ins ins-end)
- (org-beginning-of-item)
- (setq beg0 (point))
- (setq ind (org-get-indentation))
- (save-excursion
- (setq ne-beg (org-back-over-empty-lines))
- (setq beg (point)))
- (goto-char beg0)
- (org-end-of-item)
- (org-back-over-empty-lines)
- (setq end (point))
- (goto-char beg0)
- (catch 'exit
- (while t
- (beginning-of-line 0)
- (if (looking-at "[ \t]*$")
- (if org-empty-line-terminates-plain-lists
- (progn
- (goto-char pos)
- (error "Cannot move this item further up"))
- nil)
- (if (<= (setq ind1 (org-get-indentation)) ind)
- (throw 'exit t)))))
- (condition-case nil
- (org-beginning-of-item)
- (error (goto-char beg0)
- (move-to-column col)
- (error "Cannot move this item further up")))
- (setq ind1 (org-get-indentation))
- (if (and (org-at-item-p) (= ind ind1))
- (progn
- (setq ne-ins (org-back-over-empty-lines))
- (setq txt (buffer-substring beg end))
- (save-excursion
- (delete-region beg end))
- (setq pos (point))
- (insert txt)
- (setq ins-end (point))
- (goto-char pos) (org-skip-whitespace)
-
- (when (and (org-first-list-item-p) (> ne-ins ne-beg))
- ;; Move whitespace back to beginning
- (save-excursion
- (goto-char ins-end)
- (let ((kill-whole-line t))
- (kill-line (- ne-ins ne-beg)) (point)))
- (insert (make-string (- ne-ins ne-beg) ?\n)))
-
- (org-maybe-renumber-ordered-list)
- (move-to-column col))
- (goto-char pos)
- (move-to-column col)
- (error "Cannot move this item further up"))))
-
-(defun org-maybe-renumber-ordered-list ()
- "Renumber the ordered list at point if setup allows it.
-This tests the user option `org-auto-renumber-ordered-lists' before
-doing the renumbering."
- (interactive)
- (when (and org-auto-renumber-ordered-lists
- (org-at-item-p))
- (if (match-beginning 3)
- (org-renumber-ordered-list 1)
- (org-fix-bullet-type))))
-
-(defun org-maybe-renumber-ordered-list-safe ()
- (condition-case nil
- (save-excursion
- (org-maybe-renumber-ordered-list))
- (error nil)))
-
-(defun org-cycle-list-bullet (&optional which)
- "Cycle through the different itemize/enumerate bullets.
-This cycle the entire list level through the sequence:
-
- `-' -> `+' -> `*' -> `1.' -> `1)'
-
-If WHICH is a string, use that as the new bullet. If WHICH is an integer,
-0 means `-', 1 means `+' etc."
- (interactive "P")
- (org-preserve-lc
- (org-beginning-of-item-list)
- (org-at-item-p)
- (beginning-of-line 1)
- (let ((current (match-string 0))
- (prevp (eq which 'previous))
- new old)
- (setq new (cond
- ((and (numberp which)
- (nth (1- which) '("-" "+" "*" "1." "1)"))))
- ((string-match "-" current) (if prevp "1)" "+"))
- ((string-match "\\+" current)
- (if prevp "-" (if (looking-at "\\S-") "1." "*")))
- ((string-match "\\*" current) (if prevp "+" "1."))
- ((string-match "\\." current)
- (if prevp (if (looking-at "\\S-") "+" "*") "1)"))
- ((string-match ")" current) (if prevp "1." "-"))
- (t (error "This should not happen"))))
- (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)")
- (setq old (match-string 2))
- (replace-match (concat "\\1" new)))
- (org-shift-item-indentation (- (length new) (length old)))
- (org-fix-bullet-type)
- (org-maybe-renumber-ordered-list))))
-
-(defun org-get-string-indentation (s)
- "What indentation has S due to SPACE and TAB at the beginning of the string?"
- (let ((n -1) (i 0) (w tab-width) c)
- (catch 'exit
- (while (< (setq n (1+ n)) (length s))
- (setq c (aref s n))
- (cond ((= c ?\ ) (setq i (1+ i)))
- ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
- (t (throw 'exit t)))))
- i))
-
-(defun org-renumber-ordered-list (arg)
- "Renumber an ordered plain list.
-Cursor needs to be in the first line of an item, the line that starts
-with something like \"1.\" or \"2)\"."
- (interactive "p")
- (unless (and (org-at-item-p)
- (match-beginning 3))
- (error "This is not an ordered list"))
- (let ((line (org-current-line))
- (col (current-column))
- (ind (org-get-string-indentation
- (buffer-substring (point-at-bol) (match-beginning 3))))
- ;; (term (substring (match-string 3) -1))
- ind1 (n (1- arg))
- fmt bobp old new delta)
- ;; find where this list begins
- (org-beginning-of-item-list)
- (setq bobp (bobp))
- (looking-at "[ \t]*[0-9]+\\([.)]\\)")
- (setq fmt (concat "%d" (or (match-string 1) ".")))
- (beginning-of-line 0)
- ;; walk forward and replace these numbers
- (catch 'exit
- (while t
- (catch 'next
- (if bobp (setq bobp nil) (beginning-of-line 2))
- (if (eobp) (throw 'exit nil))
- (if (looking-at "[ \t]*$") (throw 'next nil))
- (skip-chars-forward " \t") (setq ind1 (current-column))
- (if (> ind1 ind) (throw 'next t))
- (if (< ind1 ind) (throw 'exit t))
- (if (not (org-at-item-p)) (throw 'exit nil))
- (setq old (match-string 2))
- (delete-region (match-beginning 2) (match-end 2))
- (goto-char (match-beginning 2))
- (insert (setq new (format fmt (setq n (1+ n)))))
- (setq delta (- (length new) (length old)))
- (org-shift-item-indentation delta)
- (if (= (org-current-line) line) (setq col (+ col delta))))))
- (org-goto-line line)
- (org-move-to-column col)))
-
-(defvar org-suppress-item-indentation) ; dynamically scoped parameter
-(defun org-fix-bullet-type (&optional force-bullet)
- "Make sure all items in this list have the same bullet as the first item.
-Also, fix the indentation."
- (interactive)
- (unless (org-at-item-p) (error "This is not a list"))
- (let ((line (org-current-line))
- (col (current-column))
- (ind (current-indentation))
- ind1 bullet oldbullet)
- ;; find where this list begins
- (org-beginning-of-item-list)
- (beginning-of-line 1)
- ;; find out what the bullet type is
- (looking-at "[ \t]*\\(\\S-+\\)")
- (setq bullet (concat (or force-bullet (match-string 1)) " "))
- (if (and org-list-two-spaces-after-bullet-regexp
- (string-match org-list-two-spaces-after-bullet-regexp bullet))
- (setq bullet (concat bullet " ")))
- ;; walk forward and replace these numbers
- (beginning-of-line 0)
- (catch 'exit
- (while t
- (catch 'next
- (beginning-of-line 2)
- (if (eobp) (throw 'exit nil))
- (if (looking-at "[ \t]*$") (throw 'next nil))
- (skip-chars-forward " \t") (setq ind1 (current-column))
- (if (> ind1 ind) (throw 'next t))
- (if (< ind1 ind) (throw 'exit t))
- (if (not (org-at-item-p)) (throw 'exit nil))
- (skip-chars-forward " \t")
- (looking-at "\\S-+ *")
- (setq oldbullet (match-string 0))
- (unless (equal bullet oldbullet) (replace-match bullet))
- (org-shift-item-indentation (- (length bullet)
- (length oldbullet))))))
- (org-goto-line line)
- (org-move-to-column col)
- (if (string-match "[0-9]" bullet)
- (org-renumber-ordered-list 1))))
-
-(defun org-shift-item-indentation (delta)
- "Shift the indentation in current item by DELTA."
- (unless (org-bound-and-true-p org-suppress-item-indentation)
- (save-excursion
- (let ((beg (point-at-bol))
- (end (progn (org-end-of-item) (point)))
- i)
- (goto-char end)
- (beginning-of-line 0)
- (while (> (point) beg)
- (when (looking-at "[ \t]*\\S-")
- ;; this is not an empty line
- (setq i (org-get-indentation))
- (if (and (> i 0) (> (setq i (+ i delta)) 0))
- (indent-line-to i)))
- (beginning-of-line 0))))))
-
-(defun org-beginning-of-item-list ()
- "Go to the beginning of the current item list.
-I.e. to the first item in this list."
- (interactive)
- (org-beginning-of-item)
- (let ((pos (point-at-bol))
- (ind (org-get-indentation))
- ind1)
- ;; find where this list begins
- (catch 'exit
- (while t
- (catch 'next
- (beginning-of-line 0)
- (if (looking-at "[ \t]*$")
- (throw (if (bobp) 'exit 'next) t))
- (skip-chars-forward " \t") (setq ind1 (current-column))
- (if (or (< ind1 ind)
- (and (= ind1 ind)
- (not (org-at-item-p)))
- (and (= (point-at-bol) (point-min))
- (setq pos (point-min))))
- (throw 'exit t)
- (when (org-at-item-p) (setq pos (point-at-bol)))))))
- (goto-char pos)))
-
-(defun org-end-of-item-list ()
- "Go to the end of the current item list.
-I.e. to the text after the last item."
- (interactive)
- (org-beginning-of-item)
- (let ((pos (point-at-bol))
- (ind (org-get-indentation))
- ind1)
- ;; find where this list begins
- (catch 'exit
- (while t
- (catch 'next
- (beginning-of-line 2)
- (if (looking-at "[ \t]*$")
- (if (eobp)
- (progn (setq pos (point)) (throw 'exit t))
- (throw 'next t)))
- (skip-chars-forward " \t") (setq ind1 (current-column))
- (if (or (< ind1 ind)
- (and (= ind1 ind)
- (not (org-at-item-p)))
- (eobp))
- (progn
- (setq pos (point-at-bol))
- (throw 'exit t))))))
- (goto-char pos)))
-
-
-(defvar org-last-indent-begin-marker (make-marker))
-(defvar org-last-indent-end-marker (make-marker))
-
-(defun org-outdent-item (arg)
- "Outdent a local list item."
- (interactive "p")
- (org-indent-item (- arg)))
-
-(defun org-indent-item (arg)
- "Indent a local list item."
- (interactive "p")
- (and (org-region-active-p) (org-cursor-to-region-beginning))
- (unless (org-at-item-p)
- (error "Not on an item"))
- (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp)
- (setq firstp (org-first-list-item-p))
- (save-excursion
- (setq end (and (org-region-active-p) (region-end)))
- (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
- (setq beg org-last-indent-begin-marker
- end org-last-indent-end-marker)
- (org-beginning-of-item)
- (setq beg (move-marker org-last-indent-begin-marker (point)))
- (org-end-of-item)
- (setq end (move-marker org-last-indent-end-marker (or end (point)))))
- (goto-char beg)
- (setq ind-bul (org-item-indent-positions)
- ind (caar ind-bul)
- ind-down (car (nth 2 ind-bul))
- ind-up (car (nth 1 ind-bul))
- delta (if (> arg 0)
- (if ind-down (- ind-down ind) 2)
- (if ind-up (- ind-up ind) -2)))
- (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
- (while (< (point) end)
- (beginning-of-line 1)
- (skip-chars-forward " \t") (setq ind1 (current-column))
- (delete-region (point-at-bol) (point))
- (or (eolp) (org-indent-to-column (+ ind1 delta)))
- (beginning-of-line 2)))
- (org-fix-bullet-type
- (and (> arg 0)
- (not firstp)
- (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet))))
- (org-maybe-renumber-ordered-list-safe)
- (save-excursion
- (beginning-of-line 0)
- (condition-case nil (org-beginning-of-item) (error nil))
- (org-maybe-renumber-ordered-list-safe))))
-
-(defun org-item-indent-positions ()
- "Return indentation for plain list items.
-This returns a list with three values: The current indentation, the
-parent indentation and the indentation a child should have.
-Assumes cursor in item line."
- (let* ((bolpos (point-at-bol))
- (ind (org-get-indentation))
- (bullet (org-get-bullet))
- ind-down ind-up bullet-up bullet-down pos)
- (save-excursion
- (org-beginning-of-item-list)
- (skip-chars-backward "\n\r \t")
- (when (org-in-item-p)
- (org-beginning-of-item)
- (setq ind-up (org-get-indentation))
- (setq bullet-up (org-get-bullet))))
- (setq pos (point))
- (save-excursion
- (cond
- ((and (condition-case nil (progn (org-previous-item) t)
- (error nil))
- (or (forward-char 1) t)
- (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
- (setq ind-down (org-get-indentation)
- bullet-down (org-get-bullet)))
- ((and (goto-char pos)
- (org-at-item-p))
- (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (setq ind-down (current-column)
- bullet-down (org-get-bullet)))))
- (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down))
- (setq bullet-down (concat "1" (match-string 1 bullet-down))))
- (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up))
- (setq bullet-up (concat "1" (match-string 1 bullet-up))))
- (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet))
- (setq bullet (concat "1" (match-string 1 bullet))))
- (list (cons ind bullet)
- (cons ind-up bullet-up)
- (cons ind-down bullet-down))))
-
-(defvar org-tab-ind-state) ; defined in org.el
-(defun org-cycle-item-indentation ()
- (let ((org-suppress-item-indentation t)
- (org-adapt-indentation nil))
- (cond
- ((and (looking-at "[ \t]*$")
- (looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+"))
- (setq this-command 'org-cycle-item-indentation)
- (if (eq last-command 'org-cycle-item-indentation)
- (condition-case nil
- (progn (org-outdent-item 1)
- (if (equal org-tab-ind-state (org-get-indentation))
- (org-outdent-item 1))
- (end-of-line 1))
- (error
- (progn
- (while (< (org-get-indentation) org-tab-ind-state)
- (progn (org-indent-item 1) (end-of-line 1)))
- (setq this-command 'org-cycle))))
- (setq org-tab-ind-state (org-get-indentation))
- (org-indent-item 1))
- t))))
-
-(defun org-get-bullet ()
- (save-excursion
- (goto-char (point-at-bol))
- (and (looking-at
- "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)")
- (or (match-string 2) (match-string 4)))))
-
-;;; 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* ((item-beginning (org-list-item-beginning))
- (start (car item-beginning))
- (end (org-list-end (cdr item-beginning)))
- output itemsep ltype)
- (while (re-search-forward org-list-beginning-re end t)
- (goto-char (match-beginning 3))
- (save-match-data
- (cond ((string-match "[0-9]" (match-string 2))
- (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
- ltype 'ordered))
- ((string-match "^.*::" (match-string 0))
- (setq itemsep "[-+]" ltype 'descriptive))
- (t (setq itemsep "[-+]" ltype 'unordered))))
- (let* ((indent1 (match-string 1))
- (nextitem (save-excursion
- (save-match-data
- (or (and (re-search-forward
- (concat "^" indent1 itemsep " *?") end t)
- (match-beginning 0)) end))))
- (item (buffer-substring
- (point)
- (or (and (re-search-forward
- org-list-beginning-re end t)
- (goto-char (match-beginning 0)))
- (goto-char end))))
- (nextindent (match-string 1))
- (item (org-trim item))
- (item (if (string-match "^\\[\\([xX ]\\)\\]" item)
- (replace-match (if (equal (match-string 1 item) " ")
- "[CBOFF]"
- "[CBON]")
- t nil item)
- item)))
- (push item output)
- (when (> (length nextindent)
- (length indent1))
- (narrow-to-region (point) nextitem)
- (push (org-list-parse-list) output)
- (widen))))
- (when delete (delete-region start end))
- (setq output (nreverse output))
- (push ltype output)))
-
-(defun org-list-item-beginning ()
- "Find the beginning of the list item.
-Return a cons which car is the beginning position of the item and
-cdr is the indentation string."
- (save-excursion
- (if (not (or (looking-at org-list-beginning-re)
- (re-search-backward
- org-list-beginning-re nil t)))
- (progn (goto-char (point-min)) (point))
- (cons (match-beginning 0) (match-string 1)))))
-
-(defun org-list-goto-true-beginning ()
- "Go to the beginning of the list at point."
- (beginning-of-line 1)
- (while (looking-at org-list-beginning-re)
- (beginning-of-line 0))
- (progn
- (re-search-forward org-list-beginning-re nil t)
- (goto-char (match-beginning 0))))
-
-(defun org-list-make-subtree ()
- "Convert the plain list at point into a subtree."
- (interactive)
- (org-list-goto-true-beginning)
- (let ((list (org-list-parse-list t)) nstars)
- (save-excursion
- (if (condition-case nil
- (org-back-to-heading)
- (error nil))
- (progn (re-search-forward org-complex-heading-regexp nil t)
- (setq nstars (length (match-string 1))))
- (setq nstars 0)))
- (org-list-make-subtrees list (1+ nstars))))
-
-(defun org-list-make-subtrees (list level)
- "Convert LIST into subtrees starting at LEVEL."
- (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)))
-
-(defun org-list-end (indent)
- "Return the position of the end of the list.
-INDENT is the indentation of the list, as a string."
- (save-excursion
- (catch 'exit
- (while (or (looking-at org-list-beginning-re)
- (looking-at (concat "^" indent "[ \t]+\\|^$"))
- (> (or (get-text-property (point) 'original-indentation) -1)
- (length indent)))
- (if (eq (point) (point-max))
- (throw 'exit (point-max)))
- (forward-line 1)))
- (point)))
-
-(defun org-list-insert-radio-list ()
- "Insert a radio list template appropriate for this major mode."
- (interactive)
- (let* ((e (assq major-mode org-list-radio-list-templates))
- (txt (nth 1 e))
- name pos)
- (unless e (error "No radio list setup defined for %s" major-mode))
- (setq name (read-string "List name: "))
- (while (string-match "%n" txt)
- (setq txt (replace-match name t t txt)))
- (or (bolp) (insert "\n"))
- (setq pos (point))
- (insert txt)
- (goto-char pos)))
-
-(defun org-list-send-list (&optional maybe)
- "Send a transformed version of this list to the receiver position.
-With argument MAYBE, fail quietly if no transformation is defined for
-this list."
- (interactive)
- (catch 'exit
- (unless (org-at-item-p) (error "Not at a list"))
- (save-excursion
- (org-list-goto-true-beginning)
- (beginning-of-line 0)
- (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
- (if maybe
- (throw 'exit nil)
- (error "Don't know how to transform this list"))))
- (let* ((name (match-string 1))
- (transform (intern (match-string 2)))
- (item-beginning (org-list-item-beginning))
- (txt (buffer-substring-no-properties
- (car item-beginning)
- (org-list-end (cdr item-beginning))))
- (list (org-list-parse-list))
- beg)
- (unless (fboundp transform)
- (error "No such transformation function %s" transform))
- (setq txt (funcall transform list))
- ;; Find the insertion place
- (save-excursion
- (goto-char (point-min))
- (unless (re-search-forward
- (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
- (error "Don't know where to insert translated list"))
- (goto-char (match-beginning 0))
- (beginning-of-line 2)
- (setq beg (point))
- (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
- (error "Cannot find end of insertion region"))
- (beginning-of-line 1)
- (delete-region beg (point))
- (goto-char beg)
- (insert txt "\n"))
- (message "List converted and installed at receiver location"))))
-
-(defun org-list-to-generic (list params)
- "Convert a LIST parsed through `org-list-parse-list' to other formats.
-
-Valid parameters PARAMS are
-
-:ustart String to start an unordered list
-:uend String to end an unordered list
-
-:ostart String to start an ordered list
-:oend String to end an ordered list
-
-:dstart String to start a descriptive list
-:dend String to end a descriptive list
-:dtstart String to start a descriptive term
-:dtend String to end a descriptive term
-:ddstart String to start a description
-:ddend String to end a description
-
-: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
-: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"
- (interactive)
- (let* ((p params) sublist
- (splicep (plist-get p :splice))
- (ostart (plist-get p :ostart))
- (oend (plist-get p :oend))
- (ustart (plist-get p :ustart))
- (uend (plist-get p :uend))
- (dstart (plist-get p :dstart))
- (dend (plist-get p :dend))
- (dtstart (plist-get p :dtstart))
- (dtend (plist-get p :dtend))
- (ddstart (plist-get p :ddstart))
- (ddend (plist-get p :ddend))
- (istart (plist-get p :istart))
- (iend (plist-get p :iend))
- (isep (plist-get p :isep))
- (lsep (plist-get p :lsep))
- (cbon (plist-get p :cbon))
- (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 "^\\(.*\\) ::" sublist)
- (setq term (org-trim (format (concat dtstart "%s" dtend)
- (match-string 1 sublist))))
- (setq sublist (substring sublist (1+ (length term)))))
- (if (string-match "\\[CBON\\]" sublist)
- (setq sublist (replace-match cbon t t sublist)))
- (if (string-match "\\[CBOFF\\]" sublist)
- (setq sublist (replace-match cboff t t sublist)))
- (if (string-match "\\[-\\]" sublist)
- (setq sublist (replace-match "$\\boxminus$" t t sublist)))
- (setq rtn (concat rtn istart term ddstart
- sublist ddend iend isep)))
- (t (setq rtn (concat rtn ;; previous list
- lsep ;; list separator
- (org-list-to-generic sublist p)
- lsep ;; list separator
- )))))
- (format wrapper rtn))))
-
-(defun org-list-to-latex (list &optional params)
- "Convert LIST into a LaTeX list.
-LIST is as returnd by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splicep 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 ""
- :isep "\n" :lsep "\n"
- :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
- params)))
-
-(defun org-list-to-html (list &optional params)
- "Convert LIST into a HTML list.
-LIST is as returnd by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (org-combine-plists
- '(:splicep nil :ostart "<ol>" :oend "</ol>"
- :ustart "<ul>" :uend "</ul>"
- :dstart "<dl>" :dend "</dl>"
- :dtstart "<dt>" :dtend "</dt>"
- :ddstart "<dd>" :ddend "</dd>"
- :istart "<li>" :iend "</li>"
- :isep "\n" :lsep "\n"
- :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
- params)))
-
-(defun org-list-to-texinfo (list &optional params)
- "Convert LIST into a Texinfo list.
-LIST is as returnd by `org-list-parse-list'. PARAMS is a property list
-with overruling parameters for `org-list-to-generic'."
- (org-list-to-generic
- list
- (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"
- :ddstart "" :ddend ""
- :istart "@item\n" :iend ""
- :isep "\n" :lsep "\n"
- :cbon "@code{[X]}" :cboff "@code{[ ]}")
- params)))
-
-(provide 'org-list)
-
-;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
-;;; org-list.el ends here
+;;; org-list.el --- Plain lists for Org-mode
+;;
+;; Copyright (C) 2004-2011 Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Bastien Guerry <bzg AT altern DOT org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 7.4
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains the code dealing with plain lists in Org-mode.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl))
+(require 'org-macs)
+(require 'org-compat)
+
+(defvar org-blank-before-new-entry)
+(defvar org-M-RET-may-split-line)
+(defvar org-complex-heading-regexp)
+(defvar org-odd-levels-only)
+(defvar org-outline-regexp)
+(defvar org-ts-regexp)
+(defvar org-ts-regexp-both)
+
+(declare-function org-invisible-p "org" ())
+(declare-function org-on-heading-p "org" (&optional invisible-ok))
+(declare-function outline-next-heading "outline" ())
+(declare-function org-back-to-heading "org" (&optional invisible-ok))
+(declare-function org-back-over-empty-lines "org" ())
+(declare-function org-trim "org" (s))
+(declare-function org-get-indentation "org" (&optional line))
+(declare-function org-timer-item "org-timer" (&optional arg))
+(declare-function org-timer-hms-to-secs "org-timer" (hms))
+(declare-function org-combine-plists "org" (&rest plists))
+(declare-function org-entry-get "org"
+ (pom property &optional inherit literal-nil))
+(declare-function org-narrow-to-subtree "org" ())
+(declare-function org-show-subtree "org" ())
+(declare-function org-in-regexps-block-p "org"
+ (start-re end-re &optional bound))
+(declare-function org-level-increment "org" ())
+(declare-function org-at-heading-p "org" (&optional ignored))
+(declare-function outline-previous-heading "outline" ())
+(declare-function org-icompleting-read "org" (&rest args))
+(declare-function org-time-string-to-seconds "org" (s))
+
+(defgroup org-plain-lists nil
+ "Options concerning plain lists in Org-mode."
+ :tag "Org Plain lists"
+ :group 'org-structure)
+
+(defcustom org-cycle-include-plain-lists t
+ "When t, make TAB cycle visibility on plain list items.
+Cycling plain lists works only when the cursor is on a plain list
+item. When the cursor is on an outline heading, plain lists are
+treated as text. This is the most stable way of handling this,
+which is why it is the default.
+
+When this is the symbol `integrate', then during cycling, plain
+list items will *temporarily* be interpreted as outline headlines
+with a level given by 1000+i where i is the indentation of the
+bullet. This setting can lead to strange effects when switching
+visibility to `children', because the first \"child\" in a
+subtree decides what children should be listed. If that first
+\"child\" is a plain list item with an implied large level
+number, all true children and grand children of the outline
+heading will be exposed in a children' view."
+ :group 'org-plain-lists
+ :type '(choice
+ (const :tag "Never" nil)
+ (const :tag "With cursor in plain list (recommended)" t)
+ (const :tag "As children of outline headings" integrate)))
+
+(defcustom org-list-demote-modify-bullet nil
+ "Default bullet type installed when demoting an item.
+This is an association list, for each bullet type, this alist will point
+to the bullet that should be used when this item is demoted.
+For example,
+
+ (setq org-list-demote-modify-bullet
+ '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
+
+will make
+
+ + Movies
+ + Silence of the Lambs
+ + My Cousin Vinny
+ + Books
+ + The Hunt for Red October
+ + The Road to Omaha
+
+into
+
+ + Movies
+ - Silence of the Lambs
+ - My Cousin Vinny
+ + Books
+ - The Hunt for Red October
+ - The Road to Omaha"
+ :group 'org-plain-lists
+ :type '(repeat
+ (cons
+ (choice :tag "If the current bullet is "
+ (const "-")
+ (const "+")
+ (const "*")
+ (const "1.")
+ (const "1)"))
+ (choice :tag "demotion will change it to"
+ (const "-")
+ (const "+")
+ (const "*")
+ (const "1.")
+ (const "1)")))))
+
+(defcustom org-plain-list-ordered-item-terminator t
+ "The character that makes a line with leading number an ordered list item.
+Valid values are ?. and ?\). To get both terminators, use t. While
+?. may look nicer, it creates the danger that a line with leading
+number may be incorrectly interpreted as an item. ?\) therefore is
+the safe choice."
+ :group 'org-plain-lists
+ :type '(choice (const :tag "dot like in \"2.\"" ?.)
+ (const :tag "paren like in \"2)\"" ?\))
+ (const :tab "both" t)))
+
+(defcustom org-list-two-spaces-after-bullet-regexp nil
+ "A regular expression matching bullets that should have 2 spaces after them.
+When nil, no bullet will have two spaces after them.
+When a string, it will be used as a regular expression. When the
+bullet type of a list is changed, the new bullet type will be
+matched against this regexp. If it matches, there will be two
+spaces instead of one after the bullet in each item of the list."
+ :group 'org-plain-lists
+ :type '(choice
+ (const :tag "never" nil)
+ (regexp)))
+
+(defcustom org-list-ending-method 'both
+ "Determine where plain lists should end.
+Valid values are: `regexp', `indent' or `both'.
+
+When set to `regexp', Org will look into two variables,
+`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.
+
+When set to `indent', a list will end whenever a line following
+an item, but not starting one, is less or equally indented than
+it.
+
+When set to `both', each of the preceding methods is applied to
+determine lists endings. This is the default method."
+ :group 'org-plain-lists
+ :type '(choice
+ (const :tag "With a regexp defining ending" regexp)
+ (const :tag "With indentation of regular (no bullet) text" indent)
+ (const :tag "With both methods" both)))
+
+(defcustom org-empty-line-terminates-plain-lists nil
+ "Non-nil means an empty line ends all plain list levels.
+This variable only makes sense if `org-list-ending-method' is set
+to `regexp' or `both'. This is then equivalent to set
+`org-list-end-regexp' to \"^[ \\t]*$\"."
+ :group 'org-plain-lists
+ :type 'boolean)
+
+(defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
+ "Regexp matching the end of all plain list levels.
+It must start with \"^\" and end with \"\\n\". It defaults to 2
+blank lines. `org-empty-line-terminates-plain-lists' has
+precedence over it."
+ :group 'org-plain-lists
+ :type 'string)
+
+(defcustom org-list-automatic-rules '((bullet . t)
+ (checkbox . t)
+ (indent . t)
+ (insert . 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],
+ \\[org-shiftmetaright], \\[org-shiftmetaleft],
+ \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or
+ \\[org-insert-todo-heading]. You can disable individually these
+ rules by setting them to nil. Valid rules are:
+
+bullet when non-nil, cycling bullet do not allow lists at
+ column 0 to have * as a bullet and descriptions lists
+ to be numbered.
+checkbox when non-nil, checkbox statistics is updated each time
+ you either insert a new checkbox or toggle a checkbox.
+ It also prevents from inserting a checkbox in a
+ description item.
+indent when non-nil, indenting or outdenting list top-item
+ 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."
+ :group 'org-plain-lists
+ :type '(alist :tag "Sets of rules"
+ :key-type
+ (choice
+ (const :tag "Bullet" bullet)
+ (const :tag "Checkbox" checkbox)
+ (const :tag "Indent" indent)
+ (const :tag "Insert" insert))
+ :value-type
+ (boolean :tag "Activate" :value t)))
+
+(defcustom org-hierarchical-checkbox-statistics t
+ "Non-nil means checkbox statistics counts only the state of direct children.
+When nil, all boxes below the cookie are counted.
+This can be set to nil on a per-node basis using a COOKIE_DATA property
+with the word \"recursive\" in the value."
+ :group 'org-plain-lists
+ :type 'boolean)
+
+(defcustom org-description-max-indent 20
+ "Maximum indentation for the second line of a description list.
+When the indentation would be larger than this, it will become
+5 characters instead."
+ :group 'org-plain-lists
+ :type 'integer)
+
+(defcustom org-list-radio-list-templates
+ '((latex-mode "% BEGIN RECEIVE ORGLST %n
+% END RECEIVE ORGLST %n
+\\begin{comment}
+#+ORGLST: SEND %n org-list-to-latex
+-
+\\end{comment}\n")
+ (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
+@c END RECEIVE ORGLST %n
+@ignore
+#+ORGLST: SEND %n org-list-to-texinfo
+-
+@end ignore\n")
+ (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
+<!-- END RECEIVE ORGLST %n -->
+<!--
+#+ORGLST: SEND %n org-list-to-html
+-
+-->\n"))
+ "Templates for radio lists in different major modes.
+All occurrences of %n in a template will be replaced with the name of the
+list, obtained by prompting the user."
+ :group 'org-plain-lists
+ :type '(repeat
+ (list (symbol :tag "Major mode")
+ (string :tag "Format"))))
+
+;;; 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))
+
+(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'"))))
+
+(defconst org-item-beginning-re (concat "^" (org-item-re))
+ "Regexp matching the beginning of a plain list item.")
+
+(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
+`search-forward', `search-backward', `re-search-forward' and
+`re-search-backward'."
+ (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 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)))))))
+
+(defun org-search-backward-unenclosed (regexp &optional bound noerror)
+ "Like `re-search-backward' but don't stop inside blocks or protected places.
+Arguments REGEXP, BOUND and NOERROR are similar to those used in
+`re-search-backward'."
+ (org-list-search-unenclosed-generic
+ #'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.
+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))
+
+(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)
+ (save-excursion
+ (goto-char (match-end 0))
+ ;; Ignore counter if any
+ (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
+ (goto-char (match-end 0)))
+ (looking-at regexp))))
+
+(defun org-list-get-item-same-level (search-fun pos limit pre-move)
+ "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.
+
+TOP and BOTTOM are respectively position of list beginning and
+list ending.
+
+Assume point is at item's beginning. If the item is alone, apply
+some heuristics to guess the result."
+ (save-excursion
+ (let ((insert-blank-p
+ (cdr (assq 'plain-list-item org-blank-before-new-entry)))
+ usr-blank)
+ (cond
+ ;; Trivial cases where there should be none.
+ ((or (and (not (eq org-list-ending-method 'indent))
+ org-empty-line-terminates-plain-lists)
+ (not insert-blank-p)) 0)
+ ;; When `org-blank-before-new-entry' says so, it is 1.
+ ((eq insert-blank-p t) 1)
+ ;; plain-list-item is 'auto. Count blank lines separating
+ ;; neighbours items in list.
+ (t (let ((next-p (org-get-next-item (point) bottom)))
+ (cond
+ ;; Is there a next item?
+ (next-p (goto-char next-p)
+ (org-back-over-empty-lines))
+ ;; Is there a previous item?
+ ((org-get-previous-item (point) top)
+ (org-back-over-empty-lines))
+ ;; User inserted blank lines, trust him
+ ((and (> pos (org-end-of-item-before-blank bottom))
+ (> (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-search-forward-unenclosed
+ "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1)
+ ;; No parent: no blank line.
+ (t 0))))))))
+
+(defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
+ "Insert a new list item at POS.
+If POS is before first character after bullet of the item, the
+new item will be created before the current one.
+
+Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
+after the bullet. Cursor will be after this text once the
+function 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-get-item-beginning))
+ (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-get-item-beginning))
+ (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-get-item-beginning) (org-get-next-item (point) bottom)
+ bottom)
+ ;; recompute next-item: last sexp modified list
+ (goto-char (org-get-next-item (point) bottom))
+ (org-move-to-column col)))
+ ;; checkbox update might modify bottom point, so use a
+ ;; marker here
+ (setq bottom (copy-marker bottom))
+ (when checkbox (org-update-checkbox-count-maybe))
+ (org-list-repair nil top bottom))))
+ (goto-char true-pos)
+ (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)))))
+
+(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)
+ "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.
+
+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
+ (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))
+ (beg-item (assq beg struct)))
+ (cond
+ ;; Special case: moving top-item with indent rule
+ (specialp
+ (let* ((level-skip (org-level-increment))
+ (offset (if (< arg 0) (- level-skip) level-skip))
+ (top-ind (nth 1 beg-item)))
+ (if (< (+ top-ind offset) 0)
+ (error "Cannot outdent beyond margin")
+ ;; Change bullet if necessary
+ (when (and (= (+ top-ind offset) 0)
+ (string-match "*" (nth 2 beg-item)))
+ (setcdr beg-item (list (nth 1 beg-item)
+ (org-list-bullet-string "-"))))
+ ;; Shift ancestor
+ (let ((anc (car struct)))
+ (setcdr anc (list (+ (nth 1 anc) offset) "" nil)))
+ (org-list-struct-fix-struct struct origins)
+ (org-list-struct-apply-struct struct end))))
+ ;; Forbidden move
+ ((and (< arg 0)
+ (or (and no-subtree
+ (not regionp)
+ (org-list-struct-get-child beg-item struct))
+ (let ((last-item (save-excursion
+ (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (goto-char (org-get-item-beginning))
+ (org-list-struct-assoc-at-point))))
+ (org-list-struct-get-child last-item struct))))
+ (error "Cannot outdent an item without its children"))
+ ;; 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))))))))))
+
+;;; Predicates
+
+(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)))))
+
+(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-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
+;; 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)))
+
+(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))))
+
+(defun org-beginning-of-item-list ()
+ "Go to the beginning item of the current list or sublist.
+Return an error if not in a list."
+ (interactive)
+ (if (org-in-item-p)
+ (goto-char (org-get-beginning-of-list (org-list-top-point)))
+ (error "Not in an item")))
+
+(defun org-get-end-of-list (bottom)
+ "Return position at the end of the current list or sublist.
+BOTTOM is the position at list ending."
+ (save-excursion
+ (goto-char (org-get-item-beginning))
+ (let ((ind (org-get-indentation)))
+ (while (and (/= (point) bottom)
+ (>= (org-get-indentation) ind))
+ (org-search-forward-unenclosed org-item-beginning-re bottom 'move))
+ (if (= (point) bottom) bottom (point-at-bol)))))
+
+(defun org-end-of-item-list ()
+ "Go to the end of the current list or sublist.
+If the cursor in not in an item, throw an error."
+ (interactive)
+ (if (org-in-item-p)
+ (goto-char (org-get-end-of-list (org-list-bottom-point)))
+ (error "Not in an item")))
+
+(defun org-get-end-of-item (bottom)
+ "Return position at the end of the current item.
+BOTTOM is the position at list ending."
+ (or (org-get-next-item (point) bottom)
+ (org-get-end-of-list bottom)))
+
+(defun org-end-of-item ()
+ "Go to the end of the current hand-formatted item.
+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))
+
+(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))
+
+(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")))))
+
+;;; Manipulate
+
+(defun org-list-exchange-items (beg-A beg-B bottom)
+ "Swap item starting at BEG-A with item starting at BEG-B.
+Blank lines at the end of items are left in place. Assume BEG-A
+is lesser than BEG-B.
+
+BOTTOM is the position at list ending."
+ (save-excursion
+ (let* ((end-of-item-no-blank
+ (lambda (pos)
+ (goto-char pos)
+ (goto-char (org-end-of-item-before-blank bottom))))
+ (end-A-no-blank (funcall end-of-item-no-blank beg-A))
+ (end-B-no-blank (funcall end-of-item-no-blank beg-B))
+ (body-A (buffer-substring beg-A end-A-no-blank))
+ (body-B (buffer-substring beg-B end-B-no-blank))
+ (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
+ (goto-char beg-A)
+ (delete-region beg-A end-B-no-blank)
+ (insert (concat body-B between-A-no-blank-and-B body-A)))))
+
+(defun org-move-item-down ()
+ "Move the plain list item at point down, i.e. swap with following item.
+Subitems (items with larger indentation) are considered part of the item,
+so this really moves item trees."
+ (interactive)
+ (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))
+ (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)
+ (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)))))
+
+(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."
+ (unless (or (not (org-in-item-p))
+ (save-excursion
+ (goto-char (org-get-item-beginning))
+ (org-invisible-p)))
+ (if (save-excursion
+ (goto-char (org-get-item-beginning))
+ (org-at-item-timer-p))
+ ;; 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))
+ (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
+
+;; 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-assoc-at-point ()
+ "Return the structure association at point.
+It is a cons-cell whose key is point and values are indentation,
+bullet string and bullet counter, if any."
+ (save-excursion
+ (beginning-of-line)
+ (list (point-at-bol)
+ (org-get-indentation)
+ (progn
+ (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
+ (match-string 1))
+ (progn
+ (goto-char (match-end 0))
+ (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]")
+ (match-string 1))))))
+
+(defun org-list-struct (begin end 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)))
+ (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)))))
+
+(defun org-list-struct-get-parent (item struct origins)
+ "Return parent association of ITEM in STRUCT or nil.
+ORIGINS is the alist of parents. See `org-list-struct-origins'."
+ (let* ((parent-pos (cdr (assq (car item) origins))))
+ (when (> parent-pos 0) (assq parent-pos struct))))
+
+(defun org-list-struct-get-child (item struct)
+ "Return child association of ITEM in STRUCT or nil."
+ (let ((ind (nth 1 item))
+ (next-item (cadr (member item struct))))
+ (when (and next-item (> (nth 1 next-item) ind)) next-item)))
+
+(defun org-list-struct-fix-bul (struct origins)
+ "Verify and correct bullets for every association in STRUCT.
+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)))))
+ (set-bul (lambda (item bullet)
+ (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
+ (get-bul (lambda (item bullet)
+ (let* ((counter (nth 3 item)))
+ (if (and counter (string-match "[0-9]+" bullet))
+ (replace-match counter nil nil bullet)
+ bullet))))
+ (fix-bul
+ (lambda (item) struct
+ (let* ((parent (cdr (assq (car item) origins)))
+ (orig-ref (assq parent acc)))
+ (if orig-ref
+ ;; Continuing previous list
+ (let* ((prev-bul (cdr orig-ref))
+ (new-bul (funcall get-bul item prev-bul)))
+ (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
+ (funcall set-bul item new-bul))
+ ;; A new list is starting
+ (let ((new-bul (funcall init-bul item)))
+ (funcall set-bul item new-bul)
+ (setq acc (cons (cons parent
+ (org-list-inc-bullet-maybe new-bul))
+ acc))))))))
+ (mapc fix-bul (cdr struct))))
+
+(defun org-list-struct-fix-ind (struct origins)
+ "Verify and correct indentation for every association in STRUCT.
+ORIGINS is the alist of parents. See `org-list-struct-origins'.
+
+This function modifies STRUCT."
+ (let* ((headless (cdr struct))
+ (ancestor (car struct))
+ (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
+ (new-ind
+ (lambda (item)
+ (let* ((parent (org-list-struct-get-parent item headless origins)))
+ (if parent
+ ;; Indent like parent + length of parent's bullet
+ (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent))
+ (cddr item)))
+ ;; If no parent, indent like top-point
+ (setcdr item (cons top-ind (cddr item))))))))
+ (mapc new-ind headless)))
+
+(defun org-list-struct-fix-struct (struct origins)
+ "Return STRUCT with correct bullets and indentation.
+ORIGINS is the alist of parents. See `org-list-struct-origins'.
+
+Only elements of STRUCT that have changed are returned."
+ (let ((old (copy-alist struct)))
+ (org-list-struct-fix-bul struct origins)
+ (org-list-struct-fix-ind struct origins)
+ (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct))))
+
+(defun org-list-struct-outdent (start end origins)
+ "Outdent items in a structure.
+Items are indented when their key is between START, included, and
+END, excluded.
+
+ORIGINS is the alist of parents. See `org-list-struct-origins'.
+
+STRUCT is the concerned structure."
+ (let* (acc
+ (out (lambda (cell)
+ (let* ((item (car cell))
+ (parent (cdr cell)))
+ (cond
+ ;; Item not yet in zone: keep association
+ ((< item start) cell)
+ ;; Item out of zone: follow associations in acc
+ ((>= item end)
+ (let ((convert (assq parent acc)))
+ (if convert (cons item (cdr convert)) cell)))
+ ;; Item has no parent: error
+ ((<= parent 0)
+ (error "Cannot outdent top-level items"))
+ ;; Parent is outdented: keep association
+ ((>= parent start)
+ (setq acc (cons (cons parent item) acc)) cell)
+ (t
+ ;; Parent isn't outdented: reparent to grand-parent
+ (let ((grand-parent (cdr (assq parent origins))))
+ (setq acc (cons (cons parent item) acc))
+ (cons item grand-parent))))))))
+ (mapcar out origins)))
+
+(defun org-list-struct-indent (start end origins struct)
+ "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'.
+
+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))
+ (change-bullet-maybe
+ (lambda (item)
+ (let* ((full-item (assq item struct))
+ (item-bul (org-trim (nth 2 full-item)))
+ (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet))))
+ (when new-bul-p
+ ;; new bullet is stored without space to ensure item
+ ;; will be modified
+ (setcdr full-item
+ (list (nth 1 full-item)
+ new-bul-p
+ (nth 3 full-item)))))))
+ (ind
+ (lambda (cell)
+ (let* ((item (car cell))
+ (parent (cdr cell)))
+ (cond
+ ;; Item not yet in zone: keep association
+ ((< item start) cell)
+ ((>= item end)
+ ;; Item out of zone: follow associations in acc
+ (let ((convert (assq parent acc)))
+ (if convert (cons item (cdr convert)) cell)))
+ (t
+ ;; Item is in zone...
+ (let ((prev (funcall get-prev-item cell parent)))
+ ;; 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))
+ (error "Cannot indent the first item of a list"))
+ ;; First item and parent indented: keep same parent
+ ((or (not prev) (= prev 0))
+ (funcall set-assoc cell))
+ ;; Previous item not indented: reparent to it
+ ((< prev start)
+ (funcall set-assoc (cons item prev)))
+ ;; Previous item indented: reparent like it
+ (t
+ (funcall set-assoc (cons item
+ (cdr (assq prev acc)))))))))))))
+ (mapcar ind origins)))
+
+(defun org-list-struct-apply-struct (struct bottom)
+ "Apply modifications to list so it mirrors STRUCT.
+BOTTOM is position at list ending.
+
+Initial position is restored after the changes."
+ (let* ((pos (copy-marker (point)))
+ (ancestor (caar struct))
+ (modify
+ (lambda (item)
+ (goto-char (car item))
+ (let* ((new-ind (nth 1 item))
+ (new-bul (org-list-bullet-string (nth 2 item)))
+ (old-ind (org-get-indentation))
+ (old-bul (progn
+ (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
+ (match-string 1)))
+ (old-body-ind (+ (length old-bul) old-ind))
+ (new-body-ind (+ (length new-bul) new-ind)))
+ ;; 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 new-bul old-bul)
+ (save-excursion
+ (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
+ (replace-match new-bul nil nil nil 1)))
+ ;; 3. Indent item to appropriate column
+ (unless (= new-ind old-ind)
+ (delete-region (point-at-bol)
+ (progn
+ (skip-chars-forward " \t")
+ (point)))
+ (indent-to new-ind)))))
+ ;; Remove ancestor if it is left.
+ (struct-to-apply (if (or (not ancestor) (= 0 ancestor))
+ (cdr struct)
+ struct)))
+ ;; Apply changes from bottom to top
+ (mapc modify (nreverse struct-to-apply))
+ (goto-char pos)))
+
+;;; 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-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
+ (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."
+ (interactive)
+ (org-list-indent-item-generic
+ -1 t (org-list-top-point) (org-list-bottom-point)))
+
+(defun org-indent-item ()
+ "Indent a local list item, but not its children.
+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)))
+
+(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)))
+
+(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)))
+
+(defvar org-tab-ind-state)
+(defun org-cycle-item-indentation ()
+ "Cycle levels of indentation of an empty item.
+The first run indent the item, if applicable. Subsequents runs
+outdent it at meaningful levels in the list. When done, item is
+put back at its original position with its original bullet.
+
+Return t at each successful move."
+ (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 in the middle of the cycle, try to outdent first. If it
+ ;; fails, and point is still at initial position, indent. Else,
+ ;; go back to original position.
+ (if (eq last-command 'org-cycle-item-indentation)
+ (cond
+ ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
+ ((and (= (org-get-indentation) (car org-tab-ind-state))
+ (ignore-errors
+ (org-list-indent-item-generic 1 t top bottom))))
+ (t (back-to-indentation)
+ (org-indent-to-column (car org-tab-ind-state))
+ (end-of-line)
+ (org-list-repair (cdr org-tab-ind-state))
+ ;; Break cycle
+ (setq this-command 'identity)))
+ ;; If a cycle is starting, remember indentation and bullet,
+ ;; then try to indent. If it fails, try to outdent.
+ (setq org-tab-ind-state (cons ind (org-get-bullet)))
+ (cond
+ ((ignore-errors (org-list-indent-item-generic 1 t top bottom)))
+ ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
+ (t (error "Cannot move item")))))
+ t)))
+
+;;; Bullets
+
+(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))))
+
+(defun 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)))
+
+(defun org-list-inc-bullet-maybe (bullet)
+ "Increment BULLET if applicable."
+ (if (string-match "[0-9]+" bullet)
+ (replace-match
+ (number-to-string (1+ (string-to-number (match-string 0 bullet))))
+ nil nil bullet)
+ bullet))
+
+(defun org-list-repair (&optional force-bullet top bottom)
+ "Make sure all items are correctly indented, with the right bullet.
+This function scans the list at point, along with any sublist.
+
+If FORCE-BULLET is a string, ensure all items in list share this
+bullet, or a logical successor in the case of an ordered list.
+
+When non-nil, TOP and BOTTOM specify respectively position of
+list beginning and list ending.
+
+Item's body is not indented, only shifted with the bullet."
+ (interactive)
+ (unless (org-at-item-p) (error "This is not a list"))
+ (let* ((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)))
+ (setcdr begin (list (nth 1 begin)
+ (org-list-bullet-string force-bullet)
+ (nth 3 begin)))
+ (setq fixed-struct
+ (cons begin (org-list-struct-fix-struct struct origins))))
+ (setq fixed-struct (org-list-struct-fix-struct struct origins)))
+ (org-list-struct-apply-struct fixed-struct bottom)))
+
+(defun org-cycle-list-bullet (&optional which)
+ "Cycle through the different itemize/enumerate bullets.
+This cycle the entire list level through the sequence:
+
+ `-' -> `+' -> `*' -> `1.' -> `1)'
+
+If WHICH is a 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")
+ (save-excursion
+ (let* ((top (org-list-top-point))
+ (bullet (progn
+ (goto-char (org-get-beginning-of-list top))
+ (org-get-bullet)))
+ (current (cond
+ ((string-match "\\." bullet) "1.")
+ ((string-match ")" bullet) "1)")
+ (t bullet)))
+ (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
+ (bullet-list (append '("-" "+" )
+ ;; *-bullets are not allowed at column 0
+ (unless (and bullet-rule-p
+ (looking-at "\\S-")) '("*"))
+ ;; Description items cannot be numbered
+ (unless (and bullet-rule-p
+ (or (eq org-plain-list-ordered-item-terminator ?\))
+ (org-at-item-description-p))) '("1."))
+ (unless (and bullet-rule-p
+ (or (eq org-plain-list-ordered-item-terminator ?.)
+ (org-at-item-description-p))) '("1)"))))
+ (len (length bullet-list))
+ (item-index (- len (length (member current bullet-list))))
+ (get-value (lambda (index) (nth (mod index len) bullet-list)))
+ (new (cond
+ ((member which bullet-list) which)
+ ((numberp which) (funcall get-value which))
+ ((eq 'previous which) (funcall get-value (1- item-index)))
+ (t (funcall get-value (1+ item-index))))))
+ (org-list-repair new top))))
+
+;;; Checkboxes
+
+(defun org-toggle-checkbox (&optional toggle-presence)
+ "Toggle the checkbox in the current line.
+With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
+double prefix, set checkbox to [-].
+
+When there is an active region, toggle status or presence of the
+first checkbox there, and make every item inside have the
+same status or presence, respectively.
+
+If the cursor is in a headline, apply this to all checkbox items
+in the text below the heading, taking as reference the first item
+in subtree, 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)))
+ (org-update-checkbox-count-maybe)))
+
+(defun org-reset-checkbox-state-subtree ()
+ "Reset all checkboxes in an entry subtree."
+ (interactive "*")
+ (save-restriction
+ (save-excursion
+ (org-narrow-to-subtree)
+ (org-show-subtree)
+ (goto-char (point-min))
+ (let ((end (point-max)))
+ (while (< (point) end)
+ (when (org-at-item-checkbox-p)
+ (replace-match "[ ]" t t nil 1))
+ (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 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 "\\<recursive\\>"
+ (or (ignore-errors
+ (org-entry-get nil "COOKIE_DATA"))
+ "")))))
+ (goto-char end)
+ ;; find each statistics cookie
+ (while (and (org-search-backward-unenclosed re-cookie beg 'move)
+ (not (save-match-data
+ (and (org-on-heading-p)
+ (string-match "\\<todo\\>"
+ (downcase
+ (or (org-entry-get
+ nil "COOKIE_DATA")
+ "")))))))
+ (setq beg-cookie (match-beginning 1)
+ end-cookie (match-end 1)
+ cstat (+ cstat (if end-cookie 1 0))
+ startsearch (point-at-eol)
+ continue-from (match-beginning 0)
+ is-percent (match-beginning 2)
+ lim (cond
+ ((org-on-heading-p) (outline-next-heading) (point))
+ ;; Ensure many cookies in the same list won't imply
+ ;; computing list boundaries as many times.
+ ((org-at-item-p)
+ (unless (and list-beg (>= (point) list-beg))
+ (setq list-beg (org-list-top-point)
+ list-end (copy-marker
+ (org-list-bottom-point))))
+ (org-get-end-of-item list-end))
+ (t nil))
+ c-on 0
+ c-off 0)
+ (when lim
+ ;; find first checkbox for this cookie and gather
+ ;; statistics from all that are at this indentation level
+ (goto-char startsearch)
+ (if (org-search-forward-unenclosed re-box lim t)
+ (progn
+ (beginning-of-line)
+ (setq curr-ind (org-get-indentation))
+ (setq next-ind curr-ind)
+ (while (and (bolp) (org-at-item-p)
+ (if recursive
+ (<= curr-ind next-ind)
+ (= curr-ind next-ind)))
+ (when (org-at-item-checkbox-p)
+ (if (member (match-string 1) '("[ ]" "[-]"))
+ (setq c-off (1+ c-off))
+ (setq c-on (1+ c-on))))
+ (if (not recursive)
+ ;; org-get-next-item goes through list-enders
+ ;; with proper limit.
+ (goto-char (or (org-get-next-item (point) lim) lim))
+ (end-of-line)
+ (when (org-search-forward-unenclosed
+ org-item-beginning-re lim t)
+ (beginning-of-line)))
+ (setq next-ind (org-get-indentation)))))
+ (goto-char continue-from)
+ ;; update cookie
+ (when end-cookie
+ (setq new (if is-percent
+ (format "[%d%%]" (/ (* 100 c-on)
+ (max 1 (+ c-on c-off))))
+ (format "[%d/%d]" c-on (+ c-on c-off))))
+ (goto-char beg-cookie)
+ (insert new)
+ (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
+ ;; update items checkbox if it has one
+ (when (and (org-at-item-checkbox-p)
+ (> (+ c-on c-off) 0))
+ (setq beg-cookie (match-beginning 1)
+ end-cookie (match-end 1))
+ (delete-region beg-cookie end-cookie)
+ (goto-char beg-cookie)
+ (cond ((= c-off 0) (insert "[X]"))
+ ((= c-on 0) (insert "[ ]"))
+ (t (insert "[-]")))))
+ (goto-char continue-from)))
+ (unless (and all (outline-next-heading)) (throw 'exit nil))))
+ (when (interactive-p)
+ (message "Checkbox statistics updated %s (%d places)"
+ (if all "in entire file" "in current outline entry") cstat)))))
+
+(defun org-get-checkbox-statistics-face ()
+ "Select the face for checkbox statistics.
+The face will be `org-done' when all relevant boxes are checked.
+Otherwise it will be `org-todo'."
+ (if (match-end 1)
+ (if (equal (match-string 1) "100%")
+ 'org-checkbox-statistics-done
+ 'org-checkbox-statistics-todo)
+ (if (and (> (match-end 2) (match-beginning 2))
+ (equal (match-string 2) (match-string 3)))
+ 'org-checkbox-statistics-done
+ 'org-checkbox-statistics-todo)))
+
+;;; Misc Tools
+
+(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.
+
+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))))
+ (value init-value))
+ (while (< next-p end)
+ (goto-char next-p)
+ (set-marker next-p (or (org-get-next-item (point) end) end))
+ (setq value (apply function value args)))
+ (goto-char pos)
+ value))
+
+(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
+ "Sort plain list items.
+The cursor may be at any item of the list that should be sorted.
+Sublists are not sorted. Checkboxes, if any, are ignored.
+
+Sorting can be alphabetically, numerically, by date/time as given by
+a time stamp, by a property or by priority.
+
+Comparing entries ignores case by default. However, with an
+optional argument WITH-CASE, the sorting considers case as well.
+
+The command prompts for the sorting type unless it has been given
+to the function through the SORTING-TYPE argument, which needs to
+be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
+meaning of each character:
+
+n Numerically, by converting the beginning of the item to a number.
+a Alphabetically. Only the first line of item is checked.
+t By date/time, either the first active time stamp in the entry, if
+ any, or by the first inactive one. In a timer list, sort the timers.
+
+Capital letters will reverse the sort order.
+
+If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
+function to be called with point at the beginning of the record.
+It must return either a string or a number that should serve as
+the sorting key for that record. 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))
+ (sorting-type
+ (progn
+ (message
+ "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
+ (read-char-exclusive)))
+ (getkey-func (and (= (downcase sorting-type) ?f)
+ (org-icompleting-read "Sort using function: "
+ obarray 'fboundp t nil nil)
+ (intern getkey-func))))
+ (message "Sorting items...")
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (let* ((dcst (downcase sorting-type))
+ (case-fold-search nil)
+ (now (current-time))
+ (sort-func (cond
+ ((= dcst ?a) 'string<)
+ ((= dcst ?f) compare-func)
+ ((= dcst ?t) '<)
+ (t nil)))
+ (begin-record (lambda ()
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)))
+ (end-record (lambda ()
+ (goto-char (org-end-of-item-before-blank end))))
+ (value-to-sort
+ (lambda ()
+ (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
+ (cond
+ ((= dcst ?n)
+ (string-to-number (buffer-substring (match-end 0)
+ (point-at-eol))))
+ ((= dcst ?a)
+ (buffer-substring (match-end 0) (point-at-eol)))
+ ((= dcst ?t)
+ (cond
+ ;; If it is a timer list, convert timer to seconds
+ ((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))
+ (org-time-string-to-seconds (match-string 0)))
+ (t (org-float-time now))))
+ ((= dcst ?f)
+ (if getkey-func
+ (let ((value (funcall getkey-func)))
+ (if (stringp value)
+ (funcall case-func value)
+ value))
+ (error "Invalid key function `%s'" getkey-func)))
+ (t (error "Invalid sorting type `%c'" sorting-type)))))))
+ (sort-subr (/= dcst sorting-type)
+ begin-record
+ end-record
+ value-to-sort
+ nil
+ sort-func)
+ (org-list-repair nil top bottom)
+ (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.
+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)))))
+ (when delete
+ (delete-region start end)
+ (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)))
+
+(defun org-list-make-subtree ()
+ "Convert the plain list at point into a subtree."
+ (interactive)
+ (if (not (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)))
+
+(defun org-list-insert-radio-list ()
+ "Insert a radio list template appropriate for this major mode."
+ (interactive)
+ (let* ((e (assq major-mode org-list-radio-list-templates))
+ (txt (nth 1 e))
+ name pos)
+ (unless e (error "No radio list setup defined for %s" major-mode))
+ (setq name (read-string "List name: "))
+ (while (string-match "%n" txt)
+ (setq txt (replace-match name t t txt)))
+ (or (bolp) (insert "\n"))
+ (setq pos (point))
+ (insert txt)
+ (goto-char pos)))
+
+(defun org-list-send-list (&optional maybe)
+ "Send a transformed version of this list to the receiver position.
+With argument MAYBE, fail quietly if no transformation is defined for
+this list."
+ (interactive)
+ (catch 'exit
+ (unless (org-at-item-p) (error "Not at a list item"))
+ (save-excursion
+ (re-search-backward "#\\+ORGLST" nil t)
+ (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
+ (if maybe
+ (throw 'exit nil)
+ (error "Don't know how to transform this list"))))
+ (let* ((name (match-string 1))
+ (transform (intern (match-string 2)))
+ (bottom-point
+ (save-excursion
+ (re-search-forward
+ "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
+ (match-beginning 0)))
+ (top-point
+ (progn
+ (re-search-backward "#\\+ORGLST" nil t)
+ (re-search-forward org-item-beginning-re bottom-point t)
+ (match-beginning 0)))
+ (list (save-restriction
+ (narrow-to-region top-point bottom-point)
+ (org-list-parse-list)))
+ beg txt)
+ (unless (fboundp transform)
+ (error "No such transformation function %s" transform))
+ (let ((txt (funcall transform list)))
+ ;; Find the insertion place
+ (save-excursion
+ (goto-char (point-min))
+ (unless (re-search-forward
+ (concat "BEGIN RECEIVE ORGLST +"
+ name
+ "\\([ \t]\\|$\\)") nil t)
+ (error "Don't know where to insert translated list"))
+ (goto-char (match-beginning 0))
+ (beginning-of-line 2)
+ (setq beg (point))
+ (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
+ (error "Cannot find end of insertion region"))
+ (delete-region beg (point-at-bol))
+ (goto-char beg)
+ (insert txt "\n")))
+ (message "List converted and installed at receiver location"))))
+
+(defun org-list-to-generic (list params)
+ "Convert a LIST parsed through `org-list-parse-list' to other formats.
+Valid parameters PARAMS are
+
+:ustart String to start an unordered list
+:uend String to end an unordered list
+
+:ostart String to start an ordered list
+:oend String to end an ordered list
+
+:dstart String to start a descriptive list
+:dend String to end a descriptive list
+:dtstart String to start a descriptive term
+:dtend String to end a descriptive term
+:ddstart String to start a description
+:ddend String to end a description
+
+: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
+: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"
+ (interactive)
+ (let* ((p params) sublist
+ (splicep (plist-get p :splice))
+ (ostart (plist-get p :ostart))
+ (oend (plist-get p :oend))
+ (ustart (plist-get p :ustart))
+ (uend (plist-get p :uend))
+ (dstart (plist-get p :dstart))
+ (dend (plist-get p :dend))
+ (dtstart (plist-get p :dtstart))
+ (dtend (plist-get p :dtend))
+ (ddstart (plist-get p :ddstart))
+ (ddend (plist-get p :ddend))
+ (istart (plist-get p :istart))
+ (iend (plist-get p :iend))
+ (isep (plist-get p :isep))
+ (lsep (plist-get p :lsep))
+ (cbon (plist-get p :cbon))
+ (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))))
+
+(defun org-list-to-latex (list &optional params)
+ "Convert LIST into a LaTeX list.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (org-list-to-generic
+ list
+ (org-combine-plists
+ '(:splicep 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 ""
+ :isep "\n" :lsep "\n"
+ :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
+ params)))
+
+(defun org-list-to-html (list &optional params)
+ "Convert LIST into a HTML list.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (org-list-to-generic
+ list
+ (org-combine-plists
+ '(:splicep nil :ostart "<ol>" :oend "</ol>"
+ :ustart "<ul>" :uend "</ul>"
+ :dstart "<dl>" :dend "</dl>"
+ :dtstart "<dt>" :dtend "</dt>"
+ :ddstart "<dd>" :ddend "</dd>"
+ :istart "<li>" :iend "</li>"
+ :isep "\n" :lsep "\n"
+ :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
+ params)))
+
+(defun org-list-to-texinfo (list &optional params)
+ "Convert LIST into a Texinfo list.
+LIST is as returned by `org-list-parse-list'. PARAMS is a property list
+with overruling parameters for `org-list-to-generic'."
+ (org-list-to-generic
+ list
+ (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"
+ :ddstart "" :ddend ""
+ :istart "@item\n" :iend ""
+ :isep "\n" :lsep "\n"
+ :cbon "@code{[X]}" :cboff "@code{[ ]}")
+ params)))
+
+(provide 'org-list)
+
+;;; org-list.el ends here
HCoop / bpt / emacs.git / blobdiff