lisp/org-list.el

   1 ;;; org-list.el --- Plain lists for Org-mode
   2 ;;
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
   4 ;;   Free Software Foundation, Inc.
   5 ;;
   6 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   7 ;;         Bastien Guerry <bzg AT altern DOT org>
   8 ;; Keywords: outlines, hypermedia, calendar, wp
   9 ;; Homepage: http://orgmode.org
  10 ;; Version: 6.33trans
  11 ;;
  12 ;; This file is part of GNU Emacs.
  13 ;;
  14 ;; GNU Emacs is free software: you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation, either version 3 of the License, or
  17 ;; (at your option) any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27 ;;
  28 ;;; Commentary:
  29
  30 ;; This file contains the code dealing with plain lists in Org-mode.
  31
  32 ;;; Code:
  33
  34 (require 'org-macs)
  35 (require 'org-compat)
  36
  37 (defvar org-blank-before-new-entry)
  38 (defvar org-M-RET-may-split-line)
  39 (defvar org-complex-heading-regexp)
  40 (defvar org-odd-levels-only)
  41
  42 (declare-function org-invisible-p "org" ())
  43 (declare-function org-on-heading-p "org" (&optional invisible-ok))
  44 (declare-function outline-next-heading "outline" ())
  45 (declare-function org-back-to-heading "org" (&optional invisible-ok))
  46 (declare-function org-back-over-empty-lines "org" ())
  47 (declare-function org-skip-whitespace "org" ())
  48 (declare-function org-trim "org" (s))
  49 (declare-function org-get-indentation "org" (&optional line))
  50 (declare-function org-timer-item "org-timer" (&optional arg))
  51 (declare-function org-combine-plists "org" (&rest plists))
  52 (declare-function org-entry-get "org" (pom property &optional inherit))
  53 (declare-function org-narrow-to-subtree "org" ())
  54 (declare-function org-show-subtree "org" ())
  55
  56 (defgroup org-plain-lists nil
  57   "Options concerning plain lists in Org-mode."
  58   :tag "Org Plain lists"
  59   :group 'org-structure)
  60
  61 (defcustom org-cycle-include-plain-lists t
  62   "When t, make TAB cycle visibility on plain list items.
  63
  64 Cycling plain lists works only when the cursor is on a plain list
  65 item.  When the cursor is on an outline heading, plain lists are
  66 treated as text.  This is the most stable way of handling this,
  67 which is why it is the default.
  68
  69 When this is the symbol `integrate', then during cycling, plain
  70 list items will *temporarily* be interpreted as outline headlines
  71 with a level given by 1000+i where i is the indentation of the
  72 bullet.  This setting can lead to strange effects when switching
  73 visibility to `children', because the first \"child\" in a
  74 subtree decides what children should be listed.  If that first
  75 \"child\" is a plain list item with an implied large level
  76 number, all true children and grand children of the outline
  77 heading will be exposed in a children' view."
  78   :group 'org-plain-lists
  79   :type '(choice
  80           (const :tag "Never" nil)
  81           (const :tag "With cursor in plain list (recommended)" t)
  82           (const :tag "As children of outline headings" integrate)))
  83
  84 (defcustom org-list-demote-modify-bullet nil
  85   "Default bullet type installed when demoting an item.
  86 This is an association list, for each bullet type, this alist will point
  87 to the bulled that should be used when this item is demoted."
  88   :group 'org-plain-lists
  89   :type '(repeat
  90           (cons
  91            (choice :tag "If the current bullet is  "
  92                    (const "-")
  93                    (const "+")
  94                    (const "*")
  95                    (const "1.")
  96                    (const "1)"))
  97            (choice :tag "demotion will change it to"
  98                    (const "-")
  99                    (const "+")
 100                    (const "*")
 101                    (const "1.")
 102                    (const "1)")))))
 103
 104 (defcustom org-plain-list-ordered-item-terminator t
 105   "The character that makes a line with leading number an ordered list item.
 106 Valid values are ?. and ?\).  To get both terminators, use t.  While
 107 ?. may look nicer, it creates the danger that a line with leading
 108 number may be incorrectly interpreted as an item.  ?\) therefore is
 109 the safe choice."
 110   :group 'org-plain-lists
 111   :type '(choice (const :tag "dot like in \"2.\"" ?.)
 112                  (const :tag "paren like in \"2)\"" ?\))
 113                  (const :tab "both" t)))
 114
 115 (defcustom org-list-two-spaces-after-bullet-regexp nil
 116   "A regular expression matching bullets that should have 2 spaces after them.
 117 When nil, no bullet will have two spaces after them.
 118 When a string, it will be used as a regular expression.  When the bullet
 119 type of a list is changed, the new bullet type will be matched against this
 120 regexp.  If it matches, there will be two spaces instead of one after
 121 the bullet in each item of he list."
 122   :group 'org-plain-list
 123   :type '(choice
 124           (const :tag "never" nil)
 125           (regexp)))
 126
 127 (defcustom org-empty-line-terminates-plain-lists nil
 128   "Non-nil means, an empty line ends all plain list levels.
 129 This is currently effective only during export.  It should also have
 130 an effect for indentation and plain list folding, but it does not.
 131 When nil, empty lines are part of the preceding item."
 132   :group 'org-plain-lists
 133   :type 'boolean)
 134
 135 (defcustom org-auto-renumber-ordered-lists t
 136   "Non-nil means, automatically renumber ordered plain lists.
 137 Renumbering happens when the sequence have been changed with
 138 \\[org-shiftmetaup] or \\[org-shiftmetadown].  After other editing commands,
 139 use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
 140   :group 'org-plain-lists
 141   :type 'boolean)
 142
 143 (defcustom org-provide-checkbox-statistics t
 144   "Non-nil means, update checkbox statistics after insert and toggle.
 145 When this is set, checkbox statistics is updated each time you
 146 either insert a new checkbox with \\[org-insert-todo-heading] or
 147 toggle a checkbox with \\[org-ctrl-c-ctrl-c]."
 148   :group 'org-plain-lists
 149   :type 'boolean)
 150
 151 (defcustom org-hierarchical-checkbox-statistics t
 152   "Non-nil means, checkbox statistics counts only the state of direct children.
 153 When nil, all boxes below the cookie are counted.
 154 This can be set to nil on a per-node basis using a COOKIE_DATA property
 155 with the word \"recursive\" in the value."
 156   :group 'org-plain-lists
 157   :type 'boolean)
 158
 159 (defcustom org-description-max-indent 20
 160   "Maximum indentation for the second line of a description list.
 161 When the indentation would be larger than this, it will become
 162 5 characters instead."
 163   :group 'org-plain-lists
 164   :type 'integer)
 165
 166 (defvar org-list-beginning-re
 167   "^\\([ \t]*\\)\\([-+]\\|[0-9]+[.)]\\) +\\(.*\\)$")
 168
 169 (defcustom org-list-radio-list-templates
 170   '((latex-mode "% BEGIN RECEIVE ORGLST %n
 171 % END RECEIVE ORGLST %n
 172 \\begin{comment}
 173 #+ORGLST: SEND %n org-list-to-latex
 174 | | |
 175 \\end{comment}\n")
 176     (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
 177 @c END RECEIVE ORGLST %n
 178 @ignore
 179 #+ORGLST: SEND %n org-list-to-texinfo
 180 | | |
 181 @end ignore\n")
 182     (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
 183 <!-- END RECEIVE ORGLST %n -->
 184 <!--
 185 #+ORGLST: SEND %n org-list-to-html
 186 | | |
 187 -->\n"))
 188   "Templates for radio lists in different major modes.
 189 All occurrences of %n in a template will be replaced with the name of the
 190 list, obtained by prompting the user."
 191   :group 'org-plain-lists
 192   :type '(repeat
 193           (list (symbol :tag "Major mode")
 194                 (string :tag "Format"))))
 195
 196 ;;;; Plain list items, including checkboxes
 197
 198 ;;; Plain list items
 199
 200 (defun org-at-item-p ()
 201   "Is point in a line starting a hand-formatted item?"
 202   (let ((llt org-plain-list-ordered-item-terminator))
 203     (save-excursion
 204       (goto-char (point-at-bol))
 205       (looking-at
 206        (cond
 207         ((eq llt t)  "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
 208         ((= llt ?.)  "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
 209         ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
 210         (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
 211
 212 (defun org-at-item-bullet-p ()
 213   "Is point at the bullet of a plain list item?"
 214   (and (org-at-item-p)
 215        (not (member (char-after) '(?\  ?\t)))
 216        (< (point) (match-end 0))))
 217
 218 (defun org-in-item-p ()
 219   "It the cursor inside a plain list item.
 220 Does not have to be the first line."
 221   (save-excursion
 222     (condition-case nil
 223         (progn
 224           (org-beginning-of-item)
 225           (org-at-item-p)
 226           t)
 227       (error nil))))
 228
 229 (defun org-insert-item (&optional checkbox)
 230   "Insert a new item at the current level.
 231 Return t when things worked, nil when we are not in an item."
 232   (when (save-excursion
 233           (condition-case nil
 234               (progn
 235                 (org-beginning-of-item)
 236                 (org-at-item-p)
 237                 (if (org-invisible-p) (error "Invisible item"))
 238                 t)
 239             (error nil)))
 240     (let* ((bul (match-string 0))
 241            (descp (save-excursion (goto-char (match-beginning 0))
 242                                   (beginning-of-line 1)
 243                                   (save-match-data
 244                                     (and (looking-at "[ \t]*\\(.*?\\) ::")
 245                                          (match-string 1)))))
 246            (empty-line-p (save-excursion
 247                            (goto-char (match-beginning 0))
 248                            (and (not (bobp))
 249                                 (or (beginning-of-line 0) t)
 250                                 (save-match-data
 251                                   (looking-at "[ \t]*$")))))
 252            (timerp (and descp
 253                         (save-match-data
 254                           (string-match "^[-+*][ \t]+[0-9]+:[0-9]+:[0-9]+$"
 255                                         descp))))
 256            (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
 257                                 (match-end 0)))
 258            (blank-a (if org-empty-line-terminates-plain-lists
 259                         nil
 260                       (cdr (assq 'plain-list-item org-blank-before-new-entry))))
 261            (blank (if (eq blank-a 'auto) empty-line-p blank-a))
 262            pos)
 263       (if descp (setq checkbox nil))
 264       (if timerp
 265           (progn (org-timer-item) t)
 266         (cond
 267          ((and (org-at-item-p) (<= (point) eow))
 268           ;; before the bullet
 269           (beginning-of-line 1)
 270           (open-line (if blank 2 1)))
 271          ((<= (point) eow)
 272           (beginning-of-line 1))
 273          (t
 274           (unless (org-get-alist-option org-M-RET-may-split-line 'item)
 275             (end-of-line 1)
 276             (delete-horizontal-space))
 277           (newline (if blank 2 1))))
 278         (insert bul
 279                 (if checkbox "[ ]" "")
 280                 (if descp (concat (if checkbox " " "")
 281                                   (read-string "Term: ") " :: ") ""))
 282         (just-one-space)
 283         (setq pos (point))
 284         (end-of-line 1)
 285         (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
 286       (org-maybe-renumber-ordered-list)
 287       (and checkbox (org-update-checkbox-count-maybe))
 288       t)))
 289
 290 ;;; Checkboxes
 291
 292 (defun org-at-item-checkbox-p ()
 293   "Is point at a line starting a plain-list item with a checklet?"
 294   (and (org-at-item-p)
 295        (save-excursion
 296          (goto-char (match-end 0))
 297          (skip-chars-forward " \t")
 298          (looking-at "\\[[- X]\\]"))))
 299
 300 (defun org-toggle-checkbox (&optional toggle-presence)
 301   "Toggle the checkbox in the current line.
 302 With prefix arg TOGGLE-PRESENCE, add or remove checkboxes.
 303 With double prefix, set checkbox to [-].
 304 When there is an active region, toggle status or presence of the checkbox
 305 in the first line, and make every item in the region have the same
 306 status or presence, respectively.
 307 If the cursor is in a headline, apply this to all checkbox items in the
 308 text below the heading."
 309   (interactive "P")
 310   (catch 'exit
 311     (let (beg end status first-present first-status blocked)
 312       (cond
 313        ((org-region-active-p)
 314         (setq beg (region-beginning) end (region-end)))
 315        ((org-on-heading-p)
 316         (setq beg (point) end (save-excursion (outline-next-heading) (point))))
 317        ((org-at-item-checkbox-p)
 318         (save-excursion
 319           (if (equal toggle-presence '(4))
 320               (progn
 321                 (replace-match "")
 322                 (goto-char (match-beginning 0))
 323                 (just-one-space))
 324             (when (setq blocked (org-checkbox-blocked-p))
 325               (error "Checkbox blocked because of unchecked box in line %d"
 326                      blocked))
 327             (replace-match
 328              (cond ((equal toggle-presence '(16)) "[-]")
 329                    ((member (match-string 0) '("[ ]" "[-]")) "[X]")
 330                    (t "[ ]"))
 331              t t)))
 332         (throw 'exit t))
 333        ((org-at-item-p)
 334         ;; add a checkbox
 335         (save-excursion
 336           (goto-char (match-end 0))
 337           (insert "[ ] "))
 338         (throw 'exit t))
 339        (t (error "Not at a checkbox or heading, and no active region")))
 340       (setq end (move-marker (make-marker) end))
 341       (save-excursion
 342         (goto-char beg)
 343         (setq first-present (org-at-item-checkbox-p)
 344               first-status
 345               (save-excursion
 346                 (and (re-search-forward "[ \t]\\(\\[[ X]\\]\\)" end t)
 347                      (equal (match-string 1) "[X]"))))
 348         (while (< (point) end)
 349           (if toggle-presence
 350               (cond
 351                ((and first-present (org-at-item-checkbox-p))
 352                 (save-excursion
 353                   (replace-match "")
 354                   (goto-char (match-beginning 0))
 355                   (just-one-space)))
 356                ((and (not first-present) (not (org-at-item-checkbox-p))
 357                      (org-at-item-p))
 358                 (save-excursion
 359                   (goto-char (match-end 0))
 360                   (insert "[ ] "))))
 361             (when (org-at-item-checkbox-p)
 362               (setq status (equal (match-string 0) "[X]"))
 363               (replace-match
 364                (if first-status "[ ]" "[X]") t t)))
 365           (beginning-of-line 2)))))
 366   (org-update-checkbox-count-maybe))
 367
 368 (defun org-reset-checkbox-state-subtree ()
 369   "Reset all checkboxes in an entry subtree."
 370   (interactive "*")
 371   (save-restriction
 372     (save-excursion
 373       (org-narrow-to-subtree)
 374       (org-show-subtree)
 375       (goto-char (point-min))
 376       (let ((end (point-max)))
 377         (while (< (point) end)
 378           (when (org-at-item-checkbox-p)
 379             (replace-match "[ ]" t t))
 380           (beginning-of-line 2))))
 381     (org-update-checkbox-count-maybe)))
 382
 383 (defun org-checkbox-blocked-p ()
 384   "Is the current checkbox blocked from for being checked now?
 385 A checkbox is blocked if all of the following conditions are fulfilled:
 386
 387 1. The checkbox is not checked already.
 388 2. The current entry has the ORDERED property set.
 389 3. There is an unchecked checkbox in this entry before the current line."
 390   (catch 'exit
 391     (save-match-data
 392       (save-excursion
 393         (unless (org-at-item-checkbox-p) (throw 'exit nil))
 394         (when (equal (match-string 0) "[X]")
 395           ;; the box is already checked!
 396           (throw 'exit nil))
 397         (let ((end (point-at-bol)))
 398           (condition-case nil (org-back-to-heading t)
 399             (error (throw 'exit nil)))
 400           (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
 401           (if (re-search-forward "^[ \t]*[-+*0-9.)] \\[[- ]\\]" end t)
 402               (org-current-line)
 403             nil))))))
 404
 405 (defvar org-checkbox-statistics-hook nil
 406   "Hook that is run whenever Org thinks checkbox statistics should be updated.
 407 This hook runs even if `org-provide-checkbox-statistics' is nil, to it can
 408 be used to implement alternative ways of collecting statistics information.")
 409
 410 (defun org-update-checkbox-count-maybe ()
 411   "Update checkbox statistics unless turned off by user."
 412   (when org-provide-checkbox-statistics
 413     (org-update-checkbox-count))
 414   (run-hooks 'org-checkbox-statistics-hook))
 415
 416 (defun org-update-checkbox-count (&optional all)
 417  "Update the checkbox statistics in the current section.
 418 This will find all statistic cookies like [57%] and [6/12] and update them
 419 with the current numbers.  With optional prefix argument ALL, do this for
 420 the whole buffer."
 421  (interactive "P")
 422  (save-excursion
 423    (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
 424           (beg (condition-case nil
 425                    (progn (org-back-to-heading) (point))
 426                  (error (point-min))))
 427           (end (move-marker (make-marker)
 428                             (progn (outline-next-heading) (point))))
 429           (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
 430           (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
 431           (re-find (concat re "\\|" re-box))
 432           beg-cookie end-cookie is-percent c-on c-off lim new
 433           eline curr-ind next-ind continue-from startsearch
 434           (recursive
 435            (or (not org-hierarchical-checkbox-statistics)
 436                (string-match "\\<recursive\\>"
 437                              (or (org-entry-get nil "COOKIE_DATA") ""))))
 438           (cstat 0)
 439           )
 440      (when all
 441        (goto-char (point-min))
 442        (outline-next-heading)
 443        (setq beg (point) end (point-max)))
 444      (goto-char end)
 445      ;; find each statistics cookie
 446      (while (and (re-search-backward re-find beg t)
 447                  (not (save-match-data
 448                         (and (org-on-heading-p)
 449                              (string-match "\\<todo\\>"
 450                                            (downcase
 451                                             (or (org-entry-get
 452                                                  nil "COOKIE_DATA")
 453                                                 "")))))))
 454        (setq beg-cookie (match-beginning 1)
 455              end-cookie (match-end 1)
 456              cstat (+ cstat (if end-cookie 1 0))
 457              startsearch (point-at-eol)
 458              continue-from (match-beginning 0)
 459              is-percent (match-beginning 2)
 460              lim (cond
 461                   ((org-on-heading-p) (outline-next-heading) (point))
 462                   ((org-at-item-p) (org-end-of-item) (point))
 463                   (t nil))
 464              c-on 0
 465              c-off 0)
 466        (when lim
 467          ;; find first checkbox for this cookie and gather
 468          ;; statistics from all that are at this indentation level
 469          (goto-char startsearch)
 470          (if (re-search-forward re-box lim t)
 471              (progn
 472                (org-beginning-of-item)
 473                (setq curr-ind (org-get-indentation))
 474                (setq next-ind curr-ind)
 475                (while (and (bolp) (org-at-item-p)
 476                            (if recursive
 477                                (<= curr-ind next-ind)
 478                              (= curr-ind next-ind)))
 479                  (save-excursion (end-of-line) (setq eline (point)))
 480                  (if (re-search-forward re-box eline t)
 481                      (if (member (match-string 2) '("[ ]" "[-]"))
 482                          (setq c-off (1+ c-off))
 483                        (setq c-on (1+ c-on))))
 484                  (if (not recursive)
 485                      (org-end-of-item)
 486                    (end-of-line)
 487                    (when (re-search-forward org-list-beginning-re lim t)
 488                      (beginning-of-line)))
 489                  (setq next-ind (org-get-indentation)))))
 490          (goto-char continue-from)
 491          ;; update cookie
 492          (when end-cookie
 493            (setq new (if is-percent
 494                          (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
 495                        (format "[%d/%d]" c-on (+ c-on c-off))))
 496            (goto-char beg-cookie)
 497            (insert new)
 498            (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
 499          ;; update items checkbox if it has one
 500          (when (org-at-item-p)
 501            (org-beginning-of-item)
 502            (when (and (> (+ c-on c-off) 0)
 503                       (re-search-forward re-box (point-at-eol) t))
 504              (setq beg-cookie (match-beginning 2)
 505                    end-cookie (match-end       2))
 506              (delete-region beg-cookie end-cookie)
 507              (goto-char beg-cookie)
 508              (cond ((= c-off 0) (insert "[X]"))
 509                    ((= c-on  0) (insert "[ ]"))
 510                    (t           (insert "[-]")))
 511              )))
 512        (goto-char continue-from))
 513      (when (interactive-p)
 514        (message "Checkbox statistics updated %s (%d places)"
 515                 (if all "in entire file" "in current outline entry") cstat)))))
 516
 517 (defun org-get-checkbox-statistics-face ()
 518   "Select the face for checkbox statistics.
 519 The face will be `org-done' when all relevant boxes are checked.  Otherwise
 520 it will be `org-todo'."
 521   (if (match-end 1)
 522       (if (equal (match-string 1) "100%")
 523           'org-checkbox-statistics-done
 524         'org-checkbox-statistics-todo)
 525     (if (and (> (match-end 2) (match-beginning 2))
 526              (equal (match-string 2) (match-string 3)))
 527         'org-checkbox-statistics-done
 528       'org-checkbox-statistics-todo)))
 529
 530 (defun org-beginning-of-item ()
 531   "Go to the beginning of the current hand-formatted item.
 532 If the cursor is not in an item, throw an error."
 533   (interactive)
 534   (let ((pos (point))
 535         (limit (save-excursion
 536                  (condition-case nil
 537                      (progn
 538                        (org-back-to-heading)
 539                        (beginning-of-line 2) (point))
 540                    (error (point-min)))))
 541         (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
 542         ind ind1)
 543     (if (org-at-item-p)
 544         (beginning-of-line 1)
 545       (beginning-of-line 1)
 546       (skip-chars-forward " \t")
 547       (setq ind (current-column))
 548       (if (catch 'exit
 549             (while t
 550               (beginning-of-line 0)
 551               (if (or (bobp) (< (point) limit)) (throw 'exit nil))
 552
 553               (if (looking-at "[ \t]*$")
 554                   (setq ind1 ind-empty)
 555                 (skip-chars-forward " \t")
 556                 (setq ind1 (current-column)))
 557               (if (< ind1 ind)
 558                   (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
 559           nil
 560         (goto-char pos)
 561         (error "Not in an item")))))
 562
 563 (defun org-end-of-item ()
 564   "Go to the end of the current hand-formatted item.
 565 If the cursor is not in an item, throw an error."
 566   (interactive)
 567   (let* ((pos (point))
 568          ind1
 569          (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
 570          (limit (save-excursion (outline-next-heading) (point)))
 571          (ind (save-excursion
 572                 (org-beginning-of-item)
 573                 (skip-chars-forward " \t")
 574                 (current-column)))
 575          (end (catch 'exit
 576                 (while t
 577                   (beginning-of-line 2)
 578                   (if (eobp) (throw 'exit (point)))
 579                   (if (>= (point) limit) (throw 'exit (point-at-bol)))
 580                   (if (looking-at "[ \t]*$")
 581                       (setq ind1 ind-empty)
 582                     (skip-chars-forward " \t")
 583                     (setq ind1 (current-column)))
 584                   (if (<= ind1 ind)
 585                       (throw 'exit (point-at-bol)))))))
 586     (if end
 587         (goto-char end)
 588       (goto-char pos)
 589       (error "Not in an item"))))
 590
 591 (defun org-next-item ()
 592   "Move to the beginning of the next item in the current plain list.
 593 Error if not at a plain list, or if this is the last item in the list."
 594   (interactive)
 595   (let (ind ind1 (pos (point)))
 596     (org-beginning-of-item)
 597     (setq ind (org-get-indentation))
 598     (org-end-of-item)
 599     (setq ind1 (org-get-indentation))
 600     (unless (and (org-at-item-p) (= ind ind1))
 601       (goto-char pos)
 602       (error "On last item"))))
 603
 604 (defun org-previous-item ()
 605   "Move to the beginning of the previous item in the current plain list.
 606 Error if not at a plain list, or if this is the first item in the list."
 607   (interactive)
 608   (let (beg ind ind1 (pos (point)))
 609     (org-beginning-of-item)
 610     (setq beg (point))
 611     (setq ind (org-get-indentation))
 612     (goto-char beg)
 613     (catch 'exit
 614       (while t
 615         (beginning-of-line 0)
 616         (if (looking-at "[ \t]*$")
 617             nil
 618           (if (<= (setq ind1 (org-get-indentation)) ind)
 619               (throw 'exit t)))
 620         (if (bobp) (throw 'exit t))))
 621     (condition-case nil
 622         (if (or (not (org-at-item-p))
 623                 (< ind1 (1- ind)))
 624             (error "")
 625           (org-beginning-of-item))
 626       (error (goto-char pos)
 627              (error "On first item")))))
 628
 629 (defun org-first-list-item-p ()
 630   "Is this heading the first item in a plain list?"
 631   (unless (org-at-item-p)
 632     (error "Not at a plain list item"))
 633   (save-excursion
 634     (org-beginning-of-item)
 635     (= (point) (save-excursion (org-beginning-of-item-list)))))
 636
 637 (defun org-move-item-down ()
 638   "Move the plain list item at point down, i.e. swap with following item.
 639 Subitems (items with larger indentation) are considered part of the item,
 640 so this really moves item trees."
 641   (interactive)
 642   (let ((col (current-column))
 643         (pos (point))
 644         beg beg0 end end0 ind ind1  txt ne-end ne-beg)
 645     (org-beginning-of-item)
 646     (setq beg0 (point))
 647     (save-excursion
 648       (setq ne-beg (org-back-over-empty-lines))
 649       (setq beg (point)))
 650     (goto-char beg0)
 651     (setq ind (org-get-indentation))
 652     (org-end-of-item)
 653     (setq end0 (point))
 654     (setq ind1 (org-get-indentation))
 655     (setq ne-end (org-back-over-empty-lines))
 656     (setq end (point))
 657     (goto-char beg0)
 658     (when (and (org-first-list-item-p) (< ne-end ne-beg))
 659       ;; include less whitespace
 660       (save-excursion
 661         (goto-char beg)
 662         (forward-line (- ne-beg ne-end))
 663         (setq beg (point))))
 664     (goto-char end0)
 665     (if (and (org-at-item-p) (= ind ind1))
 666         (progn
 667           (org-end-of-item)
 668           (org-back-over-empty-lines)
 669           (setq txt (buffer-substring beg end))
 670           (save-excursion
 671             (delete-region beg end))
 672           (setq pos (point))
 673           (insert txt)
 674           (goto-char pos) (org-skip-whitespace)
 675           (org-maybe-renumber-ordered-list)
 676           (move-to-column col))
 677       (goto-char pos)
 678       (move-to-column col)
 679       (error "Cannot move this item further down"))))
 680
 681 (defun org-move-item-up (arg)
 682   "Move the plain list item at point up, i.e. swap with previous item.
 683 Subitems (items with larger indentation) are considered part of the item,
 684 so this really moves item trees."
 685   (interactive "p")
 686   (let ((col (current-column)) (pos (point))
 687         beg beg0 end ind ind1  txt
 688         ne-beg ne-ins ins-end)
 689     (org-beginning-of-item)
 690     (setq beg0 (point))
 691     (setq ind (org-get-indentation))
 692     (save-excursion
 693       (setq ne-beg (org-back-over-empty-lines))
 694       (setq beg (point)))
 695     (goto-char beg0)
 696     (org-end-of-item)
 697     (org-back-over-empty-lines)
 698     (setq end (point))
 699     (goto-char beg0)
 700     (catch 'exit
 701       (while t
 702         (beginning-of-line 0)
 703         (if (looking-at "[ \t]*$")
 704             (if org-empty-line-terminates-plain-lists
 705                 (progn
 706                   (goto-char pos)
 707                   (error "Cannot move this item further up"))
 708               nil)
 709           (if (<= (setq ind1 (org-get-indentation)) ind)
 710               (throw 'exit t)))))
 711     (condition-case nil
 712         (org-beginning-of-item)
 713       (error (goto-char beg0)
 714              (move-to-column col)
 715              (error "Cannot move this item further up")))
 716     (setq ind1 (org-get-indentation))
 717     (if (and (org-at-item-p) (= ind ind1))
 718         (progn
 719           (setq ne-ins (org-back-over-empty-lines))
 720           (setq txt (buffer-substring beg end))
 721           (save-excursion
 722             (delete-region beg end))
 723           (setq pos (point))
 724           (insert txt)
 725           (setq ins-end (point))
 726           (goto-char pos) (org-skip-whitespace)
 727
 728           (when (and (org-first-list-item-p) (> ne-ins ne-beg))
 729             ;; Move whitespace back to beginning
 730             (save-excursion
 731               (goto-char ins-end)
 732               (let ((kill-whole-line t))
 733                 (kill-line (- ne-ins ne-beg)) (point)))
 734             (insert (make-string (- ne-ins ne-beg) ?\n)))
 735
 736           (org-maybe-renumber-ordered-list)
 737           (move-to-column col))
 738       (goto-char pos)
 739       (move-to-column col)
 740       (error "Cannot move this item further up"))))
 741
 742 (defun org-maybe-renumber-ordered-list ()
 743   "Renumber the ordered list at point if setup allows it.
 744 This tests the user option `org-auto-renumber-ordered-lists' before
 745 doing the renumbering."
 746   (interactive)
 747   (when (and org-auto-renumber-ordered-lists
 748              (org-at-item-p))
 749     (if (match-beginning 3)
 750         (org-renumber-ordered-list 1)
 751       (org-fix-bullet-type))))
 752
 753 (defun org-maybe-renumber-ordered-list-safe ()
 754   (condition-case nil
 755       (save-excursion
 756         (org-maybe-renumber-ordered-list))
 757     (error nil)))
 758
 759 (defun org-cycle-list-bullet (&optional which)
 760   "Cycle through the different itemize/enumerate bullets.
 761 This cycle the entire list level through the sequence:
 762
 763    `-'  ->  `+'  ->  `*'  ->  `1.'  ->  `1)'
 764
 765 If WHICH is a string, use that as the new bullet.  If WHICH is an integer,
 766 0 means `-', 1 means `+' etc."
 767   (interactive "P")
 768   (org-preserve-lc
 769    (org-beginning-of-item-list)
 770    (org-at-item-p)
 771    (beginning-of-line 1)
 772    (let ((current (match-string 0))
 773          (prevp (eq which 'previous))
 774          new old)
 775      (setq new (cond
 776                 ((and (numberp which)
 777                       (nth (1- which) '("-" "+" "*" "1." "1)"))))
 778                 ((string-match "-" current) (if prevp "1)" "+"))
 779                 ((string-match "\\+" current)
 780                  (if prevp "-" (if (looking-at "\\S-") "1." "*")))
 781                 ((string-match "\\*" current) (if prevp "+" "1."))
 782                 ((string-match "\\." current)
 783                  (if prevp (if (looking-at "\\S-") "+" "*") "1)"))
 784                 ((string-match ")" current) (if prevp "1." "-"))
 785                 (t (error "This should not happen"))))
 786      (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)")
 787           (setq old (match-string 2))
 788           (replace-match (concat "\\1" new)))
 789      (org-shift-item-indentation (- (length new) (length old)))
 790      (org-fix-bullet-type)
 791      (org-maybe-renumber-ordered-list))))
 792
 793 (defun org-get-string-indentation (s)
 794   "What indentation has S due to SPACE and TAB at the beginning of the string?"
 795   (let ((n -1) (i 0) (w tab-width) c)
 796     (catch 'exit
 797       (while (< (setq n (1+ n)) (length s))
 798         (setq c (aref s n))
 799         (cond ((= c ?\ ) (setq i (1+ i)))
 800               ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
 801               (t (throw 'exit t)))))
 802     i))
 803
 804 (defun org-renumber-ordered-list (arg)
 805   "Renumber an ordered plain list.
 806 Cursor needs to be in the first line of an item, the line that starts
 807 with something like \"1.\" or \"2)\"."
 808   (interactive "p")
 809   (unless (and (org-at-item-p)
 810                (match-beginning 3))
 811     (error "This is not an ordered list"))
 812   (let ((line (org-current-line))
 813         (col (current-column))
 814         (ind (org-get-string-indentation
 815               (buffer-substring (point-at-bol) (match-beginning 3))))
 816         ;; (term (substring (match-string 3) -1))
 817         ind1 (n (1- arg))
 818         fmt bobp old new delta)
 819     ;; find where this list begins
 820     (org-beginning-of-item-list)
 821     (setq bobp (bobp))
 822     (looking-at "[ \t]*[0-9]+\\([.)]\\)")
 823     (setq fmt (concat "%d" (or (match-string 1) ".")))
 824     (beginning-of-line 0)
 825     ;; walk forward and replace these numbers
 826     (catch 'exit
 827       (while t
 828         (catch 'next
 829           (if bobp (setq bobp nil) (beginning-of-line 2))
 830           (if (eobp) (throw 'exit nil))
 831           (if (looking-at "[ \t]*$") (throw 'next nil))
 832           (skip-chars-forward " \t") (setq ind1 (current-column))
 833           (if (> ind1 ind) (throw 'next t))
 834           (if (< ind1 ind) (throw 'exit t))
 835           (if (not (org-at-item-p)) (throw 'exit nil))
 836           (setq old (match-string 2))
 837           (delete-region (match-beginning 2) (match-end 2))
 838           (goto-char (match-beginning 2))
 839           (insert (setq new (format fmt (setq n (1+ n)))))
 840           (setq delta (- (length new) (length old)))
 841           (org-shift-item-indentation delta)
 842           (if (= (org-current-line) line) (setq col (+ col delta))))))
 843     (org-goto-line line)
 844     (org-move-to-column col)))
 845
 846 (defvar org-suppress-item-indentation) ; dynamically scoped parameter
 847 (defun org-fix-bullet-type (&optional force-bullet)
 848   "Make sure all items in this list have the same bullet as the first item.
 849 Also, fix the indentation."
 850   (interactive)
 851   (unless (org-at-item-p) (error "This is not a list"))
 852   (let ((line (org-current-line))
 853         (col (current-column))
 854         (ind (current-indentation))
 855         ind1 bullet oldbullet)
 856     ;; find where this list begins
 857     (org-beginning-of-item-list)
 858     (beginning-of-line 1)
 859     ;; find out what the bullet type is
 860     (looking-at "[ \t]*\\(\\S-+\\)")
 861     (setq bullet (concat (or force-bullet (match-string 1)) " "))
 862     (if (and org-list-two-spaces-after-bullet-regexp
 863              (string-match org-list-two-spaces-after-bullet-regexp bullet))
 864         (setq bullet (concat bullet " ")))
 865     ;; walk forward and replace these numbers
 866     (beginning-of-line 0)
 867     (catch 'exit
 868       (while t
 869         (catch 'next
 870           (beginning-of-line 2)
 871           (if (eobp) (throw 'exit nil))
 872           (if (looking-at "[ \t]*$") (throw 'next nil))
 873           (skip-chars-forward " \t") (setq ind1 (current-column))
 874           (if (> ind1 ind) (throw 'next t))
 875           (if (< ind1 ind) (throw 'exit t))
 876           (if (not (org-at-item-p)) (throw 'exit nil))
 877           (skip-chars-forward " \t")
 878           (looking-at "\\S-+ *")
 879           (setq oldbullet (match-string 0))
 880           (unless (equal bullet oldbullet) (replace-match bullet))
 881           (org-shift-item-indentation (- (length bullet)
 882                                          (length oldbullet))))))
 883     (org-goto-line line)
 884     (org-move-to-column col)
 885     (if (string-match "[0-9]" bullet)
 886         (org-renumber-ordered-list 1))))
 887
 888 (defun org-shift-item-indentation (delta)
 889   "Shift the indentation in current item by DELTA."
 890   (unless (org-bound-and-true-p org-suppress-item-indentation)
 891     (save-excursion
 892       (let ((beg (point-at-bol))
 893             (end (progn (org-end-of-item) (point)))
 894             i)
 895         (goto-char end)
 896         (beginning-of-line 0)
 897         (while (> (point) beg)
 898           (when (looking-at "[ \t]*\\S-")
 899             ;; this is not an empty line
 900             (setq i (org-get-indentation))
 901             (if (and (> i 0) (> (setq i (+ i delta)) 0))
 902                 (indent-line-to i)))
 903           (beginning-of-line 0))))))
 904
 905 (defun org-beginning-of-item-list ()
 906   "Go to the beginning of the current item list.
 907 I.e. to the first item in this list."
 908   (interactive)
 909   (org-beginning-of-item)
 910   (let ((pos (point-at-bol))
 911         (ind (org-get-indentation))
 912         ind1)
 913     ;; find where this list begins
 914     (catch 'exit
 915       (while t
 916         (catch 'next
 917           (beginning-of-line 0)
 918           (if (looking-at "[ \t]*$")
 919               (throw (if (bobp) 'exit 'next) t))
 920           (skip-chars-forward " \t") (setq ind1 (current-column))
 921           (if (or (< ind1 ind)
 922                   (and (= ind1 ind)
 923                        (not (org-at-item-p)))
 924                   (and (= (point-at-bol) (point-min))
 925                        (setq pos (point-min))))
 926               (throw 'exit t)
 927             (when (org-at-item-p) (setq pos (point-at-bol)))))))
 928     (goto-char pos)))
 929
 930 (defun org-end-of-item-list ()
 931   "Go to the end of the current item list.
 932 I.e. to the text after the last item."
 933   (interactive)
 934   (org-beginning-of-item)
 935   (let ((pos (point-at-bol))
 936         (ind (org-get-indentation))
 937         ind1)
 938     ;; find where this list begins
 939     (catch 'exit
 940       (while t
 941         (catch 'next
 942           (beginning-of-line 2)
 943           (if (looking-at "[ \t]*$")
 944               (if (eobp)
 945                   (progn (setq pos (point)) (throw 'exit t))
 946                 (throw 'next t)))
 947           (skip-chars-forward " \t") (setq ind1 (current-column))
 948           (if (or (< ind1 ind)
 949                   (and (= ind1 ind)
 950                        (not (org-at-item-p)))
 951                   (eobp))
 952               (progn
 953                 (setq pos (point-at-bol))
 954                 (throw 'exit t))))))
 955     (goto-char pos)))
 956
 957
 958 (defvar org-last-indent-begin-marker (make-marker))
 959 (defvar org-last-indent-end-marker (make-marker))
 960
 961 (defun org-outdent-item (arg)
 962   "Outdent a local list item."
 963   (interactive "p")
 964   (org-indent-item (- arg)))
 965
 966 (defun org-indent-item (arg)
 967   "Indent a local list item."
 968   (interactive "p")
 969   (and (org-region-active-p) (org-cursor-to-region-beginning))
 970   (unless (org-at-item-p)
 971     (error "Not on an item"))
 972   (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp)
 973     (setq firstp (org-first-list-item-p))
 974     (save-excursion
 975       (setq end (and (org-region-active-p) (region-end)))
 976       (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
 977           (setq beg org-last-indent-begin-marker
 978                 end org-last-indent-end-marker)
 979         (org-beginning-of-item)
 980         (setq beg (move-marker org-last-indent-begin-marker (point)))
 981         (org-end-of-item)
 982         (setq end (move-marker org-last-indent-end-marker (or end (point)))))
 983       (goto-char beg)
 984       (setq ind-bul (org-item-indent-positions)
 985             ind (caar ind-bul)
 986             ind-down (car (nth 2 ind-bul))
 987             ind-up (car (nth 1 ind-bul))
 988             delta (if (> arg 0)
 989                       (if ind-down (- ind-down ind) 2)
 990                     (if ind-up (- ind-up ind) -2)))
 991       (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
 992       (while (< (point) end)
 993         (beginning-of-line 1)
 994         (skip-chars-forward " \t") (setq ind1 (current-column))
 995         (delete-region (point-at-bol) (point))
 996         (or (eolp) (org-indent-to-column (+ ind1 delta)))
 997         (beginning-of-line 2)))
 998     (org-fix-bullet-type
 999      (and (> arg 0)
1000           (not firstp)
1001           (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet))))
1002     (org-maybe-renumber-ordered-list-safe)
1003     (save-excursion
1004       (beginning-of-line 0)
1005       (condition-case nil (org-beginning-of-item) (error nil))
1006       (org-maybe-renumber-ordered-list-safe))))
1007
1008 (defun org-item-indent-positions ()
1009   "Return indentation for plain list items.
1010 This returns a list with three values:  The current indentation, the
1011 parent indentation and the indentation a child should have.
1012 Assumes cursor in item line."
1013   (let* ((bolpos (point-at-bol))
1014          (ind (org-get-indentation))
1015          (bullet (org-get-bullet))
1016          ind-down ind-up bullet-up bullet-down pos)
1017     (save-excursion
1018       (org-beginning-of-item-list)
1019       (skip-chars-backward "\n\r \t")
1020       (when (org-in-item-p)
1021         (org-beginning-of-item)
1022         (setq ind-up (org-get-indentation))
1023         (setq bullet-up (org-get-bullet))))
1024     (setq pos (point))
1025     (save-excursion
1026       (cond
1027        ((and (condition-case nil (progn (org-previous-item) t)
1028                (error nil))
1029              (or (forward-char 1) t)
1030              (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
1031         (setq ind-down (org-get-indentation)
1032               bullet-down (org-get-bullet)))
1033        ((and (goto-char pos)
1034              (org-at-item-p))
1035         (goto-char (match-end 0))
1036         (skip-chars-forward " \t")
1037         (setq ind-down (current-column)
1038               bullet-down (org-get-bullet)))))
1039     (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down))
1040         (setq bullet-down (concat "1" (match-string 1 bullet-down))))
1041     (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up))
1042         (setq bullet-up (concat "1" (match-string 1 bullet-up))))
1043     (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet))
1044         (setq bullet (concat "1" (match-string 1 bullet))))
1045     (list (cons ind bullet)
1046           (cons ind-up bullet-up)
1047           (cons ind-down bullet-down))))
1048
1049 (defvar org-tab-ind-state) ; defined in org.el
1050 (defun org-cycle-item-indentation ()
1051   (let ((org-suppress-item-indentation t)
1052         (org-adapt-indentation nil))
1053     (cond
1054      ((and (looking-at "[ \t]*$")
1055            (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+"))
1056       (setq this-command 'org-cycle-item-indentation)
1057       (if (eq last-command 'org-cycle-item-indentation)
1058           (condition-case nil
1059               (progn (org-outdent-item 1)
1060                      (if (equal org-tab-ind-state (org-get-indentation))
1061                          (org-outdent-item 1))
1062                      (end-of-line 1))
1063             (error
1064              (progn
1065                (while (< (org-get-indentation) org-tab-ind-state)
1066                  (progn (org-indent-item 1) (end-of-line 1)))
1067                (setq this-command 'org-cycle))))
1068         (setq org-tab-ind-state (org-get-indentation))
1069         (org-indent-item 1))
1070       t))))
1071
1072 (defun org-get-bullet ()
1073   (save-excursion
1074     (goto-char (point-at-bol))
1075     (and (looking-at
1076           "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)")
1077          (or (match-string 2) (match-string 4)))))
1078
1079 ;;; Send and receive lists
1080
1081 (defun org-list-parse-list (&optional delete)
1082   "Parse the list at point and maybe DELETE it.
1083 Return a list containing first level items as strings and
1084 sublevels as a list of strings."
1085   (let* ((item-beginning (org-list-item-beginning))
1086          (start (car item-beginning))
1087          (end (save-excursion
1088                 (goto-char (org-list-end (cdr item-beginning)))
1089                 (org-back-over-empty-lines)
1090                 (point)))
1091          output itemsep ltype)
1092     (while (re-search-forward org-list-beginning-re end t)
1093       (goto-char (match-beginning 3))
1094       (save-match-data
1095         (cond ((string-match "[0-9]" (match-string 2))
1096                (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
1097                      ltype 'ordered))
1098               ((string-match "^.*::" (match-string 0))
1099                (setq itemsep "[-+]" ltype 'descriptive))
1100               (t (setq itemsep "[-+]" ltype 'unordered))))
1101       (let* ((indent1 (match-string 1))
1102              (nextitem (save-excursion
1103                          (save-match-data
1104                            (or (and (re-search-forward
1105                                      (concat "^" indent1 itemsep " *?") end t)
1106                                     (match-beginning 0)) end))))
1107              (item (buffer-substring
1108                     (point)
1109                     (or (and (re-search-forward
1110                               org-list-beginning-re end t)
1111                              (goto-char (match-beginning 0)))
1112                         (goto-char end))))
1113              (nextindent (match-string 1))
1114              (item (org-trim item))
1115              (item (if (string-match "^\\[\\([xX ]\\)\\]" item)
1116                        (replace-match (if (equal (match-string 1 item) " ")
1117                                           "[CBOFF]"
1118                                         "[CBON]")
1119                                       t nil item)
1120                      item)))
1121         (push item output)
1122         (when (> (length nextindent)
1123                  (length indent1))
1124           (narrow-to-region (point) nextitem)
1125           (push (org-list-parse-list) output)
1126           (widen))))
1127     (when delete (delete-region start end))
1128     (setq output (nreverse output))
1129     (push ltype output)))
1130
1131 (defun org-list-item-beginning ()
1132   "Find the beginning of the list item.
1133 Return a cons which car is the beginning position of the item and
1134 cdr is the indentation string."
1135   (save-excursion
1136     (if (not (or (looking-at org-list-beginning-re)
1137                  (re-search-backward
1138                   org-list-beginning-re nil t)))
1139         (progn (goto-char (point-min)) (point))
1140       (cons (match-beginning 0) (match-string 1)))))
1141
1142 (defun org-list-goto-true-beginning ()
1143   "Go to the beginning of the list at point."
1144   (beginning-of-line 1)
1145   (while (looking-at org-list-beginning-re)
1146     (beginning-of-line 0))
1147   (progn
1148     (re-search-forward org-list-beginning-re nil t)
1149     (goto-char (match-beginning 0))))
1150
1151 (defun org-list-make-subtree ()
1152   "Convert the plain list at point into a subtree."
1153   (interactive)
1154   (org-list-goto-true-beginning)
1155   (let ((list (org-list-parse-list t)) nstars)
1156     (save-excursion
1157       (if (condition-case nil
1158               (org-back-to-heading)
1159             (error nil))
1160           (progn (re-search-forward org-complex-heading-regexp nil t)
1161                  (setq nstars (length (match-string 1))))
1162         (setq nstars 0)))
1163     (org-list-make-subtrees list (1+ nstars))))
1164
1165 (defun org-list-make-subtrees (list level)
1166   "Convert LIST into subtrees starting at LEVEL."
1167   (if (symbolp (car list))
1168       (org-list-make-subtrees (cdr list) level)
1169     (mapcar (lambda (item)
1170               (if (stringp item)
1171                   (insert (make-string
1172                            (if org-odd-levels-only
1173                                (1- (* 2 level)) level) ?*) " " item "\n")
1174                 (org-list-make-subtrees item (1+ level))))
1175             list)))
1176
1177 (defun org-list-end (indent)
1178   "Return the position of the end of the list.
1179 INDENT is the indentation of the list, as a string."
1180   (save-excursion
1181     (catch 'exit
1182       (while (or (looking-at org-list-beginning-re)
1183                  (looking-at (concat "^" indent "[ \t]+\\|^$"))
1184                  (> (or (get-text-property (point) 'original-indentation) -1)
1185                      (length indent)))
1186         (if (eq (point) (point-max))
1187             (throw 'exit (point-max)))
1188         (forward-line 1)))
1189     (point)))
1190
1191 (defun org-list-insert-radio-list ()
1192   "Insert a radio list template appropriate for this major mode."
1193   (interactive)
1194   (let* ((e (assq major-mode org-list-radio-list-templates))
1195          (txt (nth 1 e))
1196          name pos)
1197     (unless e (error "No radio list setup defined for %s" major-mode))
1198     (setq name (read-string "List name: "))
1199     (while (string-match "%n" txt)
1200       (setq txt (replace-match name t t txt)))
1201     (or (bolp) (insert "\n"))
1202     (setq pos (point))
1203     (insert txt)
1204     (goto-char pos)))
1205
1206 (defun org-list-send-list (&optional maybe)
1207   "Send a transformed version of this list to the receiver position.
1208 With argument MAYBE, fail quietly if no transformation is defined for
1209 this list."
1210   (interactive)
1211   (catch 'exit
1212     (unless (org-at-item-p) (error "Not at a list"))
1213     (save-excursion
1214       (org-list-goto-true-beginning)
1215       (beginning-of-line 0)
1216       (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
1217         (if maybe
1218             (throw 'exit nil)
1219           (error "Don't know how to transform this list"))))
1220     (let* ((name (match-string 1))
1221            (transform (intern (match-string 2)))
1222            (item-beginning (org-list-item-beginning))
1223            (txt (buffer-substring-no-properties
1224                  (car item-beginning)
1225                  (org-list-end (cdr item-beginning))))
1226            (list (org-list-parse-list))
1227            beg)
1228       (unless (fboundp transform)
1229         (error "No such transformation function %s" transform))
1230       (setq txt (funcall transform list))
1231       ;; Find the insertion place
1232       (save-excursion
1233         (goto-char (point-min))
1234         (unless (re-search-forward
1235                  (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
1236           (error "Don't know where to insert translated list"))
1237         (goto-char (match-beginning 0))
1238         (beginning-of-line 2)
1239         (setq beg (point))
1240         (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
1241           (error "Cannot find end of insertion region"))
1242         (beginning-of-line 1)
1243         (delete-region beg (point))
1244         (goto-char beg)
1245         (insert txt "\n"))
1246       (message "List converted and installed at receiver location"))))
1247
1248 (defun org-list-to-generic (list params)
1249   "Convert a LIST parsed through `org-list-parse-list' to other formats.
1250
1251 Valid parameters PARAMS are
1252
1253 :ustart     String to start an unordered list
1254 :uend       String to end an unordered list
1255
1256 :ostart     String to start an ordered list
1257 :oend       String to end an ordered list
1258
1259 :dstart     String to start a descriptive list
1260 :dend       String to end a descriptive list
1261 :dtstart    String to start a descriptive term
1262 :dtend      String to end a descriptive term
1263 :ddstart    String to start a description
1264 :ddend      String to end a description
1265
1266 :splice     When set to t, return only list body lines, don't wrap
1267             them into :[u/o]start and :[u/o]end.  Default is nil.
1268
1269 :istart     String to start a list item
1270 :iend       String to end a list item
1271 :isep       String to separate items
1272 :lsep       String to separate sublists
1273
1274 :cboff      String to insert for an unchecked checkbox
1275 :cbon       String to insert for a checked checkbox"
1276   (interactive)
1277   (let* ((p params) sublist
1278          (splicep (plist-get p :splice))
1279          (ostart  (plist-get p :ostart))
1280          (oend  (plist-get p :oend))
1281          (ustart  (plist-get p :ustart))
1282          (uend  (plist-get p :uend))
1283          (dstart  (plist-get p :dstart))
1284          (dend  (plist-get p :dend))
1285          (dtstart  (plist-get p :dtstart))
1286          (dtend  (plist-get p :dtend))
1287          (ddstart  (plist-get p :ddstart))
1288          (ddend  (plist-get p :ddend))
1289          (istart  (plist-get p :istart))
1290          (iend  (plist-get p :iend))
1291          (isep  (plist-get p :isep))
1292          (lsep  (plist-get p :lsep))
1293          (cbon  (plist-get p :cbon))
1294          (cboff (plist-get p :cboff)))
1295     (let ((wrapper
1296            (cond ((eq (car list) 'ordered)
1297                   (concat ostart "\n%s" oend "\n"))
1298                  ((eq (car list) 'unordered)
1299                   (concat ustart "\n%s" uend "\n"))
1300                  ((eq (car list) 'descriptive)
1301                   (concat dstart "\n%s" dend "\n"))))
1302           rtn term defstart defend)
1303       (while (setq sublist (pop list))
1304         (cond ((symbolp sublist) nil)
1305               ((stringp sublist)
1306                (when (string-match "^\\(.*\\) ::" sublist)
1307                  (setq term (org-trim (format (concat dtstart "%s" dtend)
1308                                               (match-string 1 sublist))))
1309                  (setq sublist (substring sublist (1+ (length term)))))
1310                (if (string-match "\\[CBON\\]" sublist)
1311                    (setq sublist (replace-match cbon t t sublist)))
1312                (if (string-match "\\[CBOFF\\]" sublist)
1313                    (setq sublist (replace-match cboff t t sublist)))
1314                (if (string-match "\\[-\\]" sublist)
1315                    (setq sublist (replace-match "$\\boxminus$" t t sublist)))
1316                (setq rtn (concat rtn istart term ddstart
1317                                  sublist ddend iend isep)))
1318               (t (setq rtn (concat rtn   ;; previous list
1319                                    lsep  ;; list separator
1320                                    (org-list-to-generic sublist p)
1321                                    lsep  ;; list separator
1322                                    )))))
1323       (format wrapper rtn))))
1324
1325 (defun org-list-to-latex (list &optional params)
1326   "Convert LIST into a LaTeX list.
1327 LIST is as returnd by `org-list-parse-list'.  PARAMS is a property list
1328 with overruling parameters for `org-list-to-generic'."
1329   (org-list-to-generic
1330    list
1331    (org-combine-plists
1332     '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1333                :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1334                :dstart "\\begin{description}" :dend "\\end{description}"
1335                :dtstart "[" :dtend "]"
1336                :ddstart "" :ddend ""
1337                :istart "\\item " :iend ""
1338                :isep "\n" :lsep "\n"
1339                :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
1340     params)))
1341
1342 (defun org-list-to-html (list &optional params)
1343   "Convert LIST into a HTML list.
1344 LIST is as returnd by `org-list-parse-list'.  PARAMS is a property list
1345 with overruling parameters for `org-list-to-generic'."
1346   (org-list-to-generic
1347    list
1348    (org-combine-plists
1349     '(:splicep nil :ostart "<ol>" :oend "</ol>"
1350                :ustart "<ul>" :uend "</ul>"
1351                :dstart "<dl>" :dend "</dl>"
1352                :dtstart "<dt>" :dtend "</dt>"
1353                :ddstart "<dd>" :ddend "</dd>"
1354                :istart "<li>" :iend "</li>"
1355                :isep "\n" :lsep "\n"
1356                :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
1357     params)))
1358
1359 (defun org-list-to-texinfo (list &optional params)
1360   "Convert LIST into a Texinfo list.
1361 LIST is as returnd by `org-list-parse-list'.  PARAMS is a property list
1362 with overruling parameters for `org-list-to-generic'."
1363   (org-list-to-generic
1364    list
1365    (org-combine-plists
1366     '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1367                :ustart "@enumerate" :uend "@end enumerate"
1368                :dstart "@table" :dend "@end table"
1369                :dtstart "@item " :dtend "\n"
1370                :ddstart "" :ddend ""
1371                :istart "@item\n" :iend ""
1372                :isep "\n" :lsep "\n"
1373                :cbon "@code{[X]}" :cboff "@code{[ ]}")
1374     params)))
1375
1376 (provide 'org-list)
1377
1378 ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
1379 ;;; org-list.el ends here