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