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