lisp/org-list.el

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