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.35b
  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 (ignore-errors
 438                                    (org-entry-get nil "COOKIE_DATA"))
 439                                  ""))))
 440           (cstat 0)
 441           )
 442      (when all
 443        (goto-char (point-min))
 444        (outline-next-heading)
 445        (setq beg (point) end (point-max)))
 446      (goto-char end)
 447      ;; find each statistics cookie
 448      (while (and (re-search-backward re-find beg t)
 449                  (not (save-match-data
 450                         (and (org-on-heading-p)
 451                              (string-match "\\<todo\\>"
 452                                            (downcase
 453                                             (or (org-entry-get
 454                                                  nil "COOKIE_DATA")
 455                                                 "")))))))
 456        (setq beg-cookie (match-beginning 1)
 457              end-cookie (match-end 1)
 458              cstat (+ cstat (if end-cookie 1 0))
 459              startsearch (point-at-eol)
 460              continue-from (match-beginning 0)
 461              is-percent (match-beginning 2)
 462              lim (cond
 463                   ((org-on-heading-p) (outline-next-heading) (point))
 464                   ((org-at-item-p) (org-end-of-item) (point))
 465                   (t nil))
 466              c-on 0
 467              c-off 0)
 468        (when lim
 469          ;; find first checkbox for this cookie and gather
 470          ;; statistics from all that are at this indentation level
 471          (goto-char startsearch)
 472          (if (re-search-forward re-box lim t)
 473              (progn
 474                (org-beginning-of-item)
 475                (setq curr-ind (org-get-indentation))
 476                (setq next-ind curr-ind)
 477                (while (and (bolp) (org-at-item-p)
 478                            (if recursive
 479                                (<= curr-ind next-ind)
 480                              (= curr-ind next-ind)))
 481                  (save-excursion (end-of-line) (setq eline (point)))
 482                  (if (re-search-forward re-box eline t)
 483                      (if (member (match-string 2) '("[ ]" "[-]"))
 484                          (setq c-off (1+ c-off))
 485                        (setq c-on (1+ c-on))))
 486                  (if (not recursive)
 487                      (org-end-of-item)
 488                    (end-of-line)
 489                    (when (re-search-forward org-list-beginning-re lim t)
 490                      (beginning-of-line)))
 491                  (setq next-ind (org-get-indentation)))))
 492          (goto-char continue-from)
 493          ;; update cookie
 494          (when end-cookie
 495            (setq new (if is-percent
 496                          (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
 497                        (format "[%d/%d]" c-on (+ c-on c-off))))
 498            (goto-char beg-cookie)
 499            (insert new)
 500            (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
 501          ;; update items checkbox if it has one
 502          (when (org-at-item-p)
 503            (org-beginning-of-item)
 504            (when (and (> (+ c-on c-off) 0)
 505                       (re-search-forward re-box (point-at-eol) t))
 506              (setq beg-cookie (match-beginning 2)
 507                    end-cookie (match-end       2))
 508              (delete-region beg-cookie end-cookie)
 509              (goto-char beg-cookie)
 510              (cond ((= c-off 0) (insert "[X]"))
 511                    ((= c-on  0) (insert "[ ]"))
 512                    (t           (insert "[-]")))
 513              )))
 514        (goto-char continue-from))
 515      (when (interactive-p)
 516        (message "Checkbox statistics updated %s (%d places)"
 517                 (if all "in entire file" "in current outline entry") cstat)))))
 518
 519 (defun org-get-checkbox-statistics-face ()
 520   "Select the face for checkbox statistics.
 521 The face will be `org-done' when all relevant boxes are checked.  Otherwise
 522 it will be `org-todo'."
 523   (if (match-end 1)
 524       (if (equal (match-string 1) "100%")
 525           'org-checkbox-statistics-done
 526         'org-checkbox-statistics-todo)
 527     (if (and (> (match-end 2) (match-beginning 2))
 528              (equal (match-string 2) (match-string 3)))
 529         'org-checkbox-statistics-done
 530       'org-checkbox-statistics-todo)))
 531
 532 (defun org-beginning-of-item ()
 533   "Go to the beginning of the current hand-formatted item.
 534 If the cursor is not in an item, throw an error."
 535   (interactive)
 536   (let ((pos (point))
 537         (limit (save-excursion
 538                  (condition-case nil
 539                      (progn
 540                        (org-back-to-heading)
 541                        (beginning-of-line 2) (point))
 542                    (error (point-min)))))
 543         (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
 544         ind ind1)
 545     (if (org-at-item-p)
 546         (beginning-of-line 1)
 547       (beginning-of-line 1)
 548       (skip-chars-forward " \t")
 549       (setq ind (current-column))
 550       (if (catch 'exit
 551             (while t
 552               (beginning-of-line 0)
 553               (if (or (bobp) (< (point) limit)) (throw 'exit nil))
 554
 555               (if (looking-at "[ \t]*$")
 556                   (setq ind1 ind-empty)
 557                 (skip-chars-forward " \t")
 558                 (setq ind1 (current-column)))
 559               (if (< ind1 ind)
 560                   (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
 561           nil
 562         (goto-char pos)
 563         (error "Not in an item")))))
 564
 565 (defun org-end-of-item ()
 566   "Go to the end of the current hand-formatted item.
 567 If the cursor is not in an item, throw an error."
 568   (interactive)
 569   (let* ((pos (point))
 570          ind1
 571          (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
 572          (limit (save-excursion (outline-next-heading) (point)))
 573          (ind (save-excursion
 574                 (org-beginning-of-item)
 575                 (skip-chars-forward " \t")
 576                 (current-column)))
 577          (end (catch 'exit
 578                 (while t
 579                   (beginning-of-line 2)
 580                   (if (eobp) (throw 'exit (point)))
 581                   (if (>= (point) limit) (throw 'exit (point-at-bol)))
 582                   (if (looking-at "[ \t]*$")
 583                       (setq ind1 ind-empty)
 584                     (skip-chars-forward " \t")
 585                     (setq ind1 (current-column)))
 586                   (if (<= ind1 ind)
 587                       (throw 'exit (point-at-bol)))))))
 588     (if end
 589         (goto-char end)
 590       (goto-char pos)
 591       (error "Not in an item"))))
 592
 593 (defun org-next-item ()
 594   "Move to the beginning of the next item in the current plain list.
 595 Error if not at a plain list, or if this is the last item in the list."
 596   (interactive)
 597   (let (ind ind1 (pos (point)))
 598     (org-beginning-of-item)
 599     (setq ind (org-get-indentation))
 600     (org-end-of-item)
 601     (setq ind1 (org-get-indentation))
 602     (unless (and (org-at-item-p) (= ind ind1))
 603       (goto-char pos)
 604       (error "On last item"))))
 605
 606 (defun org-previous-item ()
 607   "Move to the beginning of the previous item in the current plain list.
 608 Error if not at a plain list, or if this is the first item in the list."
 609   (interactive)
 610   (let (beg ind ind1 (pos (point)))
 611     (org-beginning-of-item)
 612     (setq beg (point))
 613     (setq ind (org-get-indentation))
 614     (goto-char beg)
 615     (catch 'exit
 616       (while t
 617         (beginning-of-line 0)
 618         (if (looking-at "[ \t]*$")
 619             nil
 620           (if (<= (setq ind1 (org-get-indentation)) ind)
 621               (throw 'exit t)))
 622         (if (bobp) (throw 'exit t))))
 623     (condition-case nil
 624         (if (or (not (org-at-item-p))
 625                 (< ind1 (1- ind)))
 626             (error "")
 627           (org-beginning-of-item))
 628       (error (goto-char pos)
 629              (error "On first item")))))
 630
 631 (defun org-first-list-item-p ()
 632   "Is this heading the first item in a plain list?"
 633   (unless (org-at-item-p)
 634     (error "Not at a plain list item"))
 635   (save-excursion
 636     (org-beginning-of-item)
 637     (= (point) (save-excursion (org-beginning-of-item-list)))))
 638
 639 (defun org-move-item-down ()
 640   "Move the plain list item at point down, i.e. swap with following item.
 641 Subitems (items with larger indentation) are considered part of the item,
 642 so this really moves item trees."
 643   (interactive)
 644   (let ((col (current-column))
 645         (pos (point))
 646         beg beg0 end end0 ind ind1  txt ne-end ne-beg)
 647     (org-beginning-of-item)
 648     (setq beg0 (point))
 649     (save-excursion
 650       (setq ne-beg (org-back-over-empty-lines))
 651       (setq beg (point)))
 652     (goto-char beg0)
 653     (setq ind (org-get-indentation))
 654     (org-end-of-item)
 655     (setq end0 (point))
 656     (setq ind1 (org-get-indentation))
 657     (setq ne-end (org-back-over-empty-lines))
 658     (setq end (point))
 659     (goto-char beg0)
 660     (when (and (org-first-list-item-p) (< ne-end ne-beg))
 661       ;; include less whitespace
 662       (save-excursion
 663         (goto-char beg)
 664         (forward-line (- ne-beg ne-end))
 665         (setq beg (point))))
 666     (goto-char end0)
 667     (if (and (org-at-item-p) (= ind ind1))
 668         (progn
 669           (org-end-of-item)
 670           (org-back-over-empty-lines)
 671           (setq txt (buffer-substring beg end))
 672           (save-excursion
 673             (delete-region beg end))
 674           (setq pos (point))
 675           (insert txt)
 676           (goto-char pos) (org-skip-whitespace)
 677           (org-maybe-renumber-ordered-list)
 678           (move-to-column col))
 679       (goto-char pos)
 680       (move-to-column col)
 681       (error "Cannot move this item further down"))))
 682
 683 (defun org-move-item-up (arg)
 684   "Move the plain list item at point up, i.e. swap with previous item.
 685 Subitems (items with larger indentation) are considered part of the item,
 686 so this really moves item trees."
 687   (interactive "p")
 688   (let ((col (current-column)) (pos (point))
 689         beg beg0 end ind ind1  txt
 690         ne-beg ne-ins ins-end)
 691     (org-beginning-of-item)
 692     (setq beg0 (point))
 693     (setq ind (org-get-indentation))
 694     (save-excursion
 695       (setq ne-beg (org-back-over-empty-lines))
 696       (setq beg (point)))
 697     (goto-char beg0)
 698     (org-end-of-item)
 699     (org-back-over-empty-lines)
 700     (setq end (point))
 701     (goto-char beg0)
 702     (catch 'exit
 703       (while t
 704         (beginning-of-line 0)
 705         (if (looking-at "[ \t]*$")
 706             (if org-empty-line-terminates-plain-lists
 707                 (progn
 708                   (goto-char pos)
 709                   (error "Cannot move this item further up"))
 710               nil)
 711           (if (<= (setq ind1 (org-get-indentation)) ind)
 712               (throw 'exit t)))))
 713     (condition-case nil
 714         (org-beginning-of-item)
 715       (error (goto-char beg0)
 716              (move-to-column col)
 717              (error "Cannot move this item further up")))
 718     (setq ind1 (org-get-indentation))
 719     (if (and (org-at-item-p) (= ind ind1))
 720         (progn
 721           (setq ne-ins (org-back-over-empty-lines))
 722           (setq txt (buffer-substring beg end))
 723           (save-excursion
 724             (delete-region beg end))
 725           (setq pos (point))
 726           (insert txt)
 727           (setq ins-end (point))
 728           (goto-char pos) (org-skip-whitespace)
 729
 730           (when (and (org-first-list-item-p) (> ne-ins ne-beg))
 731             ;; Move whitespace back to beginning
 732             (save-excursion
 733               (goto-char ins-end)
 734               (let ((kill-whole-line t))
 735                 (kill-line (- ne-ins ne-beg)) (point)))
 736             (insert (make-string (- ne-ins ne-beg) ?\n)))
 737
 738           (org-maybe-renumber-ordered-list)
 739           (move-to-column col))
 740       (goto-char pos)
 741       (move-to-column col)
 742       (error "Cannot move this item further up"))))
 743
 744 (defun org-maybe-renumber-ordered-list ()
 745   "Renumber the ordered list at point if setup allows it.
 746 This tests the user option `org-auto-renumber-ordered-lists' before
 747 doing the renumbering."
 748   (interactive)
 749   (when (and org-auto-renumber-ordered-lists
 750              (org-at-item-p))
 751     (if (match-beginning 3)
 752         (org-renumber-ordered-list 1)
 753       (org-fix-bullet-type))))
 754
 755 (defun org-maybe-renumber-ordered-list-safe ()
 756   (condition-case nil
 757       (save-excursion
 758         (org-maybe-renumber-ordered-list))
 759     (error nil)))
 760
 761 (defun org-cycle-list-bullet (&optional which)
 762   "Cycle through the different itemize/enumerate bullets.
 763 This cycle the entire list level through the sequence:
 764
 765    `-'  ->  `+'  ->  `*'  ->  `1.'  ->  `1)'
 766
 767 If WHICH is a string, use that as the new bullet.  If WHICH is an integer,
 768 0 means `-', 1 means `+' etc."
 769   (interactive "P")
 770   (org-preserve-lc
 771    (org-beginning-of-item-list)
 772    (org-at-item-p)
 773    (beginning-of-line 1)
 774    (let ((current (match-string 0))
 775          (prevp (eq which 'previous))
 776          new old)
 777      (setq new (cond
 778                 ((and (numberp which)
 779                       (nth (1- which) '("-" "+" "*" "1." "1)"))))
 780                 ((string-match "-" current) (if prevp "1)" "+"))
 781                 ((string-match "\\+" current)
 782                  (if prevp "-" (if (looking-at "\\S-") "1." "*")))
 783                 ((string-match "\\*" current) (if prevp "+" "1."))
 784                 ((string-match "\\." current)
 785                  (if prevp (if (looking-at "\\S-") "+" "*") "1)"))
 786                 ((string-match ")" current) (if prevp "1." "-"))
 787                 (t (error "This should not happen"))))
 788      (and (looking-at "\\([ \t]*\\)\\(\\S-+\\)")
 789           (setq old (match-string 2))
 790           (replace-match (concat "\\1" new)))
 791      (org-shift-item-indentation (- (length new) (length old)))
 792      (org-fix-bullet-type)
 793      (org-maybe-renumber-ordered-list))))
 794
 795 (defun org-get-string-indentation (s)
 796   "What indentation has S due to SPACE and TAB at the beginning of the string?"
 797   (let ((n -1) (i 0) (w tab-width) c)
 798     (catch 'exit
 799       (while (< (setq n (1+ n)) (length s))
 800         (setq c (aref s n))
 801         (cond ((= c ?\ ) (setq i (1+ i)))
 802               ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
 803               (t (throw 'exit t)))))
 804     i))
 805
 806 (defun org-renumber-ordered-list (arg)
 807   "Renumber an ordered plain list.
 808 Cursor needs to be in the first line of an item, the line that starts
 809 with something like \"1.\" or \"2)\"."
 810   (interactive "p")
 811   (unless (and (org-at-item-p)
 812                (match-beginning 3))
 813     (error "This is not an ordered list"))
 814   (let ((line (org-current-line))
 815         (col (current-column))
 816         (ind (org-get-string-indentation
 817               (buffer-substring (point-at-bol) (match-beginning 3))))
 818         ;; (term (substring (match-string 3) -1))
 819         ind1 (n (1- arg))
 820         fmt bobp old new delta)
 821     ;; find where this list begins
 822     (org-beginning-of-item-list)
 823     (setq bobp (bobp))
 824     (looking-at "[ \t]*[0-9]+\\([.)]\\)")
 825     (setq fmt (concat "%d" (or (match-string 1) ".")))
 826     (beginning-of-line 0)
 827     ;; walk forward and replace these numbers
 828     (catch 'exit
 829       (while t
 830         (catch 'next
 831           (if bobp (setq bobp nil) (beginning-of-line 2))
 832           (if (eobp) (throw 'exit nil))
 833           (if (looking-at "[ \t]*$") (throw 'next nil))
 834           (skip-chars-forward " \t") (setq ind1 (current-column))
 835           (if (> ind1 ind) (throw 'next t))
 836           (if (< ind1 ind) (throw 'exit t))
 837           (if (not (org-at-item-p)) (throw 'exit nil))
 838           (setq old (match-string 2))
 839           (delete-region (match-beginning 2) (match-end 2))
 840           (goto-char (match-beginning 2))
 841           (insert (setq new (format fmt (setq n (1+ n)))))
 842           (setq delta (- (length new) (length old)))
 843           (org-shift-item-indentation delta)
 844           (if (= (org-current-line) line) (setq col (+ col delta))))))
 845     (org-goto-line line)
 846     (org-move-to-column col)))
 847
 848 (defvar org-suppress-item-indentation) ; dynamically scoped parameter
 849 (defun org-fix-bullet-type (&optional force-bullet)
 850   "Make sure all items in this list have the same bullet as the first item.
 851 Also, fix the indentation."
 852   (interactive)
 853   (unless (org-at-item-p) (error "This is not a list"))
 854   (let ((line (org-current-line))
 855         (chars-from-eol (- (point-at-eol) (point)))
 856         (ind (current-indentation))
 857         ind1 bullet oldbullet)
 858     ;; find where this list begins
 859     (org-beginning-of-item-list)
 860     (beginning-of-line 1)
 861     ;; find out what the bullet type is
 862     (looking-at "[ \t]*\\(\\S-+\\)")
 863     (setq bullet (concat (or force-bullet (match-string 1)) " "))
 864     (if (and org-list-two-spaces-after-bullet-regexp
 865              (string-match org-list-two-spaces-after-bullet-regexp bullet))
 866         (setq bullet (concat bullet " ")))
 867     ;; walk forward and replace these numbers
 868     (beginning-of-line 0)
 869     (catch 'exit
 870       (while t
 871         (catch 'next
 872           (beginning-of-line 2)
 873           (if (eobp) (throw 'exit nil))
 874           (if (looking-at "[ \t]*$") (throw 'next nil))
 875           (skip-chars-forward " \t") (setq ind1 (current-column))
 876           (if (> ind1 ind) (throw 'next t))
 877           (if (< ind1 ind) (throw 'exit t))
 878           (if (not (org-at-item-p)) (throw 'exit nil))
 879           (skip-chars-forward " \t")
 880           (looking-at "\\S-+ *")
 881           (setq oldbullet (match-string 0))
 882           (unless (equal bullet oldbullet) (replace-match bullet))
 883           (org-shift-item-indentation (- (length bullet)
 884                                          (length oldbullet))))))
 885     (org-goto-line line)
 886     (goto-char (max (point-at-bol) (- (point-at-eol) chars-from-eol)))
 887     (if (string-match "[0-9]" bullet)
 888         (org-renumber-ordered-list 1))))
 889
 890 (defun org-shift-item-indentation (delta)
 891   "Shift the indentation in current item by DELTA."
 892   (unless (org-bound-and-true-p org-suppress-item-indentation)
 893     (save-excursion
 894       (let ((beg (point-at-bol))
 895             (end (progn (org-end-of-item) (point)))
 896             i)
 897         (goto-char end)
 898         (beginning-of-line 0)
 899         (while (> (point) beg)
 900           (when (looking-at "[ \t]*\\S-")
 901             ;; this is not an empty line
 902             (setq i (org-get-indentation))
 903             (if (and (> i 0) (> (setq i (+ i delta)) 0))
 904                 (indent-line-to i)))
 905           (beginning-of-line 0))))))
 906
 907 (defun org-beginning-of-item-list ()
 908   "Go to the beginning of the current item list.
 909 I.e. to the first item in this list."
 910   (interactive)
 911   (org-beginning-of-item)
 912   (let ((pos (point-at-bol))
 913         (ind (org-get-indentation))
 914         ind1)
 915     ;; find where this list begins
 916     (catch 'exit
 917       (while t
 918         (catch 'next
 919           (beginning-of-line 0)
 920           (if (looking-at "[ \t]*$")
 921               (throw (if (bobp) 'exit 'next) t))
 922           (skip-chars-forward " \t") (setq ind1 (current-column))
 923           (if (or (< ind1 ind)
 924                   (and (= ind1 ind)
 925                        (not (org-at-item-p)))
 926                   (and (= (point-at-bol) (point-min))
 927                        (setq pos (point-min))))
 928               (throw 'exit t)
 929             (when (org-at-item-p) (setq pos (point-at-bol)))))))
 930     (goto-char pos)))
 931
 932 (defun org-end-of-item-list ()
 933   "Go to the end of the current item list.
 934 I.e. to the text after the last item."
 935   (interactive)
 936   (org-beginning-of-item)
 937   (let ((pos (point-at-bol))
 938         (ind (org-get-indentation))
 939         ind1)
 940     ;; find where this list begins
 941     (catch 'exit
 942       (while t
 943         (catch 'next
 944           (beginning-of-line 2)
 945           (if (looking-at "[ \t]*$")
 946               (if (eobp)
 947                   (progn (setq pos (point)) (throw 'exit t))
 948                 (throw 'next t)))
 949           (skip-chars-forward " \t") (setq ind1 (current-column))
 950           (if (or (< ind1 ind)
 951                   (and (= ind1 ind)
 952                        (not (org-at-item-p)))
 953                   (eobp))
 954               (progn
 955                 (setq pos (point-at-bol))
 956                 (throw 'exit t))))))
 957     (goto-char pos)))
 958
 959
 960 (defvar org-last-indent-begin-marker (make-marker))
 961 (defvar org-last-indent-end-marker (make-marker))
 962
 963 (defun org-outdent-item (arg)
 964   "Outdent a local list item."
 965   (interactive "p")
 966   (org-indent-item (- arg)))
 967
 968 (defun org-indent-item (arg)
 969   "Indent a local list item."
 970   (interactive "p")
 971   (and (org-region-active-p) (org-cursor-to-region-beginning))
 972   (unless (org-at-item-p)
 973     (error "Not on an item"))
 974   (let (beg end ind ind1 ind-bul delta ind-down ind-up firstp)
 975     (setq firstp (org-first-list-item-p))
 976     (save-excursion
 977       (setq end (and (org-region-active-p) (region-end)))
 978       (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
 979           (setq beg org-last-indent-begin-marker
 980                 end org-last-indent-end-marker)
 981         (org-beginning-of-item)
 982         (setq beg (move-marker org-last-indent-begin-marker (point)))
 983         (org-end-of-item)
 984         (setq end (move-marker org-last-indent-end-marker (or end (point)))))
 985       (goto-char beg)
 986       (setq ind-bul (org-item-indent-positions)
 987             ind (caar ind-bul)
 988             ind-down (car (nth 2 ind-bul))
 989             ind-up (car (nth 1 ind-bul))
 990             delta (if (> arg 0)
 991                       (if ind-down (- ind-down ind) 2)
 992                     (if ind-up (- ind-up ind) -2)))
 993       (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
 994       (while (< (point) end)
 995         (beginning-of-line 1)
 996         (skip-chars-forward " \t") (setq ind1 (current-column))
 997         (delete-region (point-at-bol) (point))
 998         (or (eolp) (org-indent-to-column (+ ind1 delta)))
 999         (beginning-of-line 2)))
1000     (org-fix-bullet-type
1001      (and (> arg 0)
1002           (not firstp)
1003           (cdr (assoc (cdr (nth 0 ind-bul)) org-list-demote-modify-bullet))))
1004     (org-maybe-renumber-ordered-list-safe)
1005     (save-excursion
1006       (beginning-of-line 0)
1007       (condition-case nil (org-beginning-of-item) (error nil))
1008       (org-maybe-renumber-ordered-list-safe))))
1009
1010 (defun org-item-indent-positions ()
1011   "Return indentation for plain list items.
1012 This returns a list with three values:  The current indentation, the
1013 parent indentation and the indentation a child should have.
1014 Assumes cursor in item line."
1015   (let* ((bolpos (point-at-bol))
1016          (ind (org-get-indentation))
1017          (bullet (org-get-bullet))
1018          ind-down ind-up bullet-up bullet-down pos)
1019     (save-excursion
1020       (org-beginning-of-item-list)
1021       (skip-chars-backward "\n\r \t")
1022       (when (org-in-item-p)
1023         (org-beginning-of-item)
1024         (setq ind-up (org-get-indentation))
1025         (setq bullet-up (org-get-bullet))))
1026     (setq pos (point))
1027     (save-excursion
1028       (cond
1029        ((and (condition-case nil (progn (org-previous-item) t)
1030                (error nil))
1031              (or (forward-char 1) t)
1032              (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
1033         (setq ind-down (org-get-indentation)
1034               bullet-down (org-get-bullet)))
1035        ((and (goto-char pos)
1036              (org-at-item-p))
1037         (goto-char (match-end 0))
1038         (skip-chars-forward " \t")
1039         (setq ind-down (current-column)
1040               bullet-down (org-get-bullet)))))
1041     (if (and bullet-down (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-down))
1042         (setq bullet-down (concat "1" (match-string 1 bullet-down))))
1043     (if (and bullet-up (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet-up))
1044         (setq bullet-up (concat "1" (match-string 1 bullet-up))))
1045     (if (and bullet (string-match "\\`[0-9]+\\(\\.\\|)\\)\\'" bullet))
1046         (setq bullet (concat "1" (match-string 1 bullet))))
1047     (list (cons ind bullet)
1048           (cons ind-up bullet-up)
1049           (cons ind-down bullet-down))))
1050
1051 (defvar org-tab-ind-state) ; defined in org.el
1052 (defun org-cycle-item-indentation ()
1053   (let ((org-suppress-item-indentation t)
1054         (org-adapt-indentation nil))
1055     (cond
1056      ((and (looking-at "[ \t]*$")
1057            (org-looking-back "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[).]\\)[ \t]+"))
1058       (setq this-command 'org-cycle-item-indentation)
1059       (if (eq last-command 'org-cycle-item-indentation)
1060           (condition-case nil
1061               (progn (org-outdent-item 1)
1062                      (if (equal org-tab-ind-state (org-get-indentation))
1063                          (org-outdent-item 1))
1064                      (end-of-line 1))
1065             (error
1066              (progn
1067                (while (< (org-get-indentation) org-tab-ind-state)
1068                  (progn (org-indent-item 1) (end-of-line 1)))
1069                (setq this-command 'org-cycle))))
1070         (setq org-tab-ind-state (org-get-indentation))
1071         (org-indent-item 1))
1072       t))))
1073
1074 (defun org-get-bullet ()
1075   (save-excursion
1076     (goto-char (point-at-bol))
1077     (and (looking-at
1078           "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\(\\*\\)\\)\\( \\|$\\)")
1079          (or (match-string 2) (match-string 4)))))
1080
1081 ;;; Send and receive lists
1082
1083 (defun org-list-parse-list (&optional delete)
1084   "Parse the list at point and maybe DELETE it.
1085 Return a list containing first level items as strings and
1086 sublevels as a list of strings."
1087   (let* ((item-beginning (org-list-item-beginning))
1088          (start (car item-beginning))
1089          (end (save-excursion
1090                 (goto-char (org-list-end (cdr item-beginning)))
1091                 (org-back-over-empty-lines)
1092                 (point)))
1093          output itemsep ltype)
1094     (while (re-search-forward org-list-beginning-re end t)
1095       (goto-char (match-beginning 3))
1096       (save-match-data
1097         (cond ((string-match "[0-9]" (match-string 2))
1098                (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
1099                      ltype 'ordered))
1100               ((string-match "^.*::" (match-string 0))
1101                (setq itemsep "[-+]" ltype 'descriptive))
1102               (t (setq itemsep "[-+]" ltype 'unordered))))
1103       (let* ((indent1 (match-string 1))
1104              (nextitem (save-excursion
1105                          (save-match-data
1106                            (or (and (re-search-forward
1107                                      (concat "^" indent1 itemsep " *?") end t)
1108                                     (match-beginning 0)) end))))
1109              (item (buffer-substring
1110                     (point)
1111                     (or (and (re-search-forward
1112                               org-list-beginning-re end t)
1113                              (goto-char (match-beginning 0)))
1114                         (goto-char end))))
1115              (nextindent (match-string 1))
1116              (item (org-trim item))
1117              (item (if (string-match "^\\[\\([xX ]\\)\\]" item)
1118                        (replace-match (if (equal (match-string 1 item) " ")
1119                                           "[CBOFF]"
1120                                         "[CBON]")
1121                                       t nil item)
1122                      item)))
1123         (push item output)
1124         (when (> (length nextindent)
1125                  (length indent1))
1126           (narrow-to-region (point) nextitem)
1127           (push (org-list-parse-list) output)
1128           (widen))))
1129     (when delete (delete-region start end))
1130     (setq output (nreverse output))
1131     (push ltype output)))
1132
1133 (defun org-list-item-beginning ()
1134   "Find the beginning of the list item.
1135 Return a cons which car is the beginning position of the item and
1136 cdr is the indentation string."
1137   (save-excursion
1138     (if (not (or (looking-at org-list-beginning-re)
1139                  (re-search-backward
1140                   org-list-beginning-re nil t)))
1141         (progn (goto-char (point-min)) (point))
1142       (cons (match-beginning 0) (match-string 1)))))
1143
1144 (defun org-list-goto-true-beginning ()
1145   "Go to the beginning of the list at point."
1146   (beginning-of-line 1)
1147   (while (looking-at org-list-beginning-re)
1148     (beginning-of-line 0))
1149   (progn
1150     (re-search-forward org-list-beginning-re nil t)
1151     (goto-char (match-beginning 0))))
1152
1153 (defun org-list-make-subtree ()
1154   "Convert the plain list at point into a subtree."
1155   (interactive)
1156   (org-list-goto-true-beginning)
1157   (let ((list (org-list-parse-list t)) nstars)
1158     (save-excursion
1159       (if (condition-case nil
1160               (org-back-to-heading)
1161             (error nil))
1162           (progn (re-search-forward org-complex-heading-regexp nil t)
1163                  (setq nstars (length (match-string 1))))
1164         (setq nstars 0)))
1165     (org-list-make-subtrees list (1+ nstars))))
1166
1167 (defun org-list-make-subtrees (list level)
1168   "Convert LIST into subtrees starting at LEVEL."
1169   (if (symbolp (car list))
1170       (org-list-make-subtrees (cdr list) level)
1171     (mapcar (lambda (item)
1172               (if (stringp item)
1173                   (insert (make-string
1174                            (if org-odd-levels-only
1175                                (1- (* 2 level)) level) ?*) " " item "\n")
1176                 (org-list-make-subtrees item (1+ level))))
1177             list)))
1178
1179 (defun org-list-end (indent)
1180   "Return the position of the end of the list.
1181 INDENT is the indentation of the list, as a string."
1182   (save-excursion
1183     (catch 'exit
1184       (while (or (looking-at org-list-beginning-re)
1185                  (looking-at (concat "^" indent "[ \t]+\\|^$"))
1186                  (> (or (get-text-property (point) 'original-indentation) -1)
1187                      (length indent)))
1188         (if (eq (point) (point-max))
1189             (throw 'exit (point-max)))
1190         (forward-line 1)))
1191     (point)))
1192
1193 (defun org-list-insert-radio-list ()
1194   "Insert a radio list template appropriate for this major mode."
1195   (interactive)
1196   (let* ((e (assq major-mode org-list-radio-list-templates))
1197          (txt (nth 1 e))
1198          name pos)
1199     (unless e (error "No radio list setup defined for %s" major-mode))
1200     (setq name (read-string "List name: "))
1201     (while (string-match "%n" txt)
1202       (setq txt (replace-match name t t txt)))
1203     (or (bolp) (insert "\n"))
1204     (setq pos (point))
1205     (insert txt)
1206     (goto-char pos)))
1207
1208 (defun org-list-send-list (&optional maybe)
1209   "Send a transformed version of this list to the receiver position.
1210 With argument MAYBE, fail quietly if no transformation is defined for
1211 this list."
1212   (interactive)
1213   (catch 'exit
1214     (unless (org-at-item-p) (error "Not at a list"))
1215     (save-excursion
1216       (org-list-goto-true-beginning)
1217       (beginning-of-line 0)
1218       (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
1219         (if maybe
1220             (throw 'exit nil)
1221           (error "Don't know how to transform this list"))))
1222     (let* ((name (match-string 1))
1223            (transform (intern (match-string 2)))
1224            (item-beginning (org-list-item-beginning))
1225            (txt (buffer-substring-no-properties
1226                  (car item-beginning)
1227                  (org-list-end (cdr item-beginning))))
1228            (list (org-list-parse-list))
1229            beg)
1230       (unless (fboundp transform)
1231         (error "No such transformation function %s" transform))
1232       (setq txt (funcall transform list))
1233       ;; Find the insertion place
1234       (save-excursion
1235         (goto-char (point-min))
1236         (unless (re-search-forward
1237                  (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
1238           (error "Don't know where to insert translated list"))
1239         (goto-char (match-beginning 0))
1240         (beginning-of-line 2)
1241         (setq beg (point))
1242         (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
1243           (error "Cannot find end of insertion region"))
1244         (beginning-of-line 1)
1245         (delete-region beg (point))
1246         (goto-char beg)
1247         (insert txt "\n"))
1248       (message "List converted and installed at receiver location"))))
1249
1250 (defun org-list-to-generic (list params)
1251   "Convert a LIST parsed through `org-list-parse-list' to other formats.
1252
1253 Valid parameters PARAMS are
1254
1255 :ustart     String to start an unordered list
1256 :uend       String to end an unordered list
1257
1258 :ostart     String to start an ordered list
1259 :oend       String to end an ordered list
1260
1261 :dstart     String to start a descriptive list
1262 :dend       String to end a descriptive list
1263 :dtstart    String to start a descriptive term
1264 :dtend      String to end a descriptive term
1265 :ddstart    String to start a description
1266 :ddend      String to end a description
1267
1268 :splice     When set to t, return only list body lines, don't wrap
1269             them into :[u/o]start and :[u/o]end.  Default is nil.
1270
1271 :istart     String to start a list item
1272 :iend       String to end a list item
1273 :isep       String to separate items
1274 :lsep       String to separate sublists
1275
1276 :cboff      String to insert for an unchecked checkbox
1277 :cbon       String to insert for a checked checkbox"
1278   (interactive)
1279   (let* ((p params) sublist
1280          (splicep (plist-get p :splice))
1281          (ostart  (plist-get p :ostart))
1282          (oend  (plist-get p :oend))
1283          (ustart  (plist-get p :ustart))
1284          (uend  (plist-get p :uend))
1285          (dstart  (plist-get p :dstart))
1286          (dend  (plist-get p :dend))
1287          (dtstart  (plist-get p :dtstart))
1288          (dtend  (plist-get p :dtend))
1289          (ddstart  (plist-get p :ddstart))
1290          (ddend  (plist-get p :ddend))
1291          (istart  (plist-get p :istart))
1292          (iend  (plist-get p :iend))
1293          (isep  (plist-get p :isep))
1294          (lsep  (plist-get p :lsep))
1295          (cbon  (plist-get p :cbon))
1296          (cboff (plist-get p :cboff)))
1297     (let ((wrapper
1298            (cond ((eq (car list) 'ordered)
1299                   (concat ostart "\n%s" oend "\n"))
1300                  ((eq (car list) 'unordered)
1301                   (concat ustart "\n%s" uend "\n"))
1302                  ((eq (car list) 'descriptive)
1303                   (concat dstart "\n%s" dend "\n"))))
1304           rtn term defstart defend)
1305       (while (setq sublist (pop list))
1306         (cond ((symbolp sublist) nil)
1307               ((stringp sublist)
1308                (when (string-match "^\\(.*\\) ::" sublist)
1309                  (setq term (org-trim (format (concat dtstart "%s" dtend)
1310                                               (match-string 1 sublist))))
1311                  (setq sublist (substring sublist (1+ (length term)))))
1312                (if (string-match "\\[CBON\\]" sublist)
1313                    (setq sublist (replace-match cbon t t sublist)))
1314                (if (string-match "\\[CBOFF\\]" sublist)
1315                    (setq sublist (replace-match cboff t t sublist)))
1316                (if (string-match "\\[-\\]" sublist)
1317                    (setq sublist (replace-match "$\\boxminus$" t t sublist)))
1318                (setq rtn (concat rtn istart term ddstart
1319                                  sublist ddend iend isep)))
1320               (t (setq rtn (concat rtn   ;; previous list
1321                                    lsep  ;; list separator
1322                                    (org-list-to-generic sublist p)
1323                                    lsep  ;; list separator
1324                                    )))))
1325       (format wrapper rtn))))
1326
1327 (defun org-list-to-latex (list &optional params)
1328   "Convert LIST into a LaTeX list.
1329 LIST is as returnd by `org-list-parse-list'.  PARAMS is a property list
1330 with overruling parameters for `org-list-to-generic'."
1331   (org-list-to-generic
1332    list
1333    (org-combine-plists
1334     '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1335                :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1336                :dstart "\\begin{description}" :dend "\\end{description}"
1337                :dtstart "[" :dtend "]"
1338                :ddstart "" :ddend ""
1339                :istart "\\item " :iend ""
1340                :isep "\n" :lsep "\n"
1341                :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
1342     params)))
1343
1344 (defun org-list-to-html (list &optional params)
1345   "Convert LIST into a HTML list.
1346 LIST is as returnd by `org-list-parse-list'.  PARAMS is a property list
1347 with overruling parameters for `org-list-to-generic'."
1348   (org-list-to-generic
1349    list
1350    (org-combine-plists
1351     '(:splicep nil :ostart "<ol>" :oend "</ol>"
1352                :ustart "<ul>" :uend "</ul>"
1353                :dstart "<dl>" :dend "</dl>"
1354                :dtstart "<dt>" :dtend "</dt>"
1355                :ddstart "<dd>" :ddend "</dd>"
1356                :istart "<li>" :iend "</li>"
1357                :isep "\n" :lsep "\n"
1358                :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
1359     params)))
1360
1361 (defun org-list-to-texinfo (list &optional params)
1362   "Convert LIST into a Texinfo list.
1363 LIST is as returnd by `org-list-parse-list'.  PARAMS is a property list
1364 with overruling parameters for `org-list-to-generic'."
1365   (org-list-to-generic
1366    list
1367    (org-combine-plists
1368     '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1369                :ustart "@enumerate" :uend "@end enumerate"
1370                :dstart "@table" :dend "@end table"
1371                :dtstart "@item " :dtend "\n"
1372                :ddstart "" :ddend ""
1373                :istart "@item\n" :iend ""
1374                :isep "\n" :lsep "\n"
1375                :cbon "@code{[X]}" :cboff "@code{[ ]}")
1376     params)))
1377
1378 (provide 'org-list)
1379
1380 ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
1381 ;;; org-list.el ends here