lisp/org-list.el

   1 ;;; org-list.el --- Plain lists for Org-mode
   2 ;;
   3 ;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   6 ;;         Bastien Guerry <bzg AT altern DOT org>
   7 ;; Keywords: outlines, hypermedia, calendar, wp
   8 ;; Homepage: http://orgmode.org
   9 ;; Version: 6.10a
  10 ;;
  11 ;; This file is part of GNU Emacs.
  12 ;;
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  26 ;;
  27 ;;; Commentary:
  28
  29 ;; This file contains the code dealing with plain lists in Org-mode.
  30
  31 ;;; Code:
  32
  33 (require 'org-macs)
  34 (require 'org-compat)
  35
  36 (defvar org-blank-before-new-entry)
  37 (defvar org-M-RET-may-split-line)
  38
  39 (declare-function org-invisible-p "org" ())
  40 (declare-function org-on-heading-p "org" (&optional invisible-ok))
  41 (declare-function outline-next-heading "org" ())
  42 (declare-function outline-back-to-heading "org" (&optional invisible-ok))
  43 (declare-function org-back-to-heading "org" (&optional invisible-ok))
  44 (declare-function org-back-over-empty-lines "org" ())
  45 (declare-function org-skip-whitespace "org" ())
  46 (declare-function org-trim "org" (s))
  47 (declare-function org-get-indentation "org" (&optional line))
  48
  49 (defgroup org-plain-lists nil
  50   "Options concerning plain lists in Org-mode."
  51   :tag "Org Plain lists"
  52   :group 'org-structure)
  53
  54 (defcustom org-cycle-include-plain-lists nil
  55   "Non-nil means, include plain lists into visibility cycling.
  56 This means that during cycling, plain list items will *temporarily* be
  57 interpreted as outline headlines with a level given by 1000+i where i is the
  58 indentation of the bullet.  In all other operations, plain list items are
  59 not seen as headlines.  For example, you cannot assign a TODO keyword to
  60 such an item."
  61   :group 'org-plain-lists
  62   :type 'boolean)
  63
  64 (defcustom org-plain-list-ordered-item-terminator t
  65   "The character that makes a line with leading number an ordered list item.
  66 Valid values are ?. and ?\).  To get both terminators, use t.  While
  67 ?. may look nicer, it creates the danger that a line with leading
  68 number may be incorrectly interpreted as an item.  ?\) therefore is
  69 the safe choice."
  70   :group 'org-plain-lists
  71   :type '(choice (const :tag "dot like in \"2.\"" ?.)
  72                  (const :tag "paren like in \"2)\"" ?\))
  73                  (const :tab "both" t)))
  74
  75 (defcustom org-empty-line-terminates-plain-lists nil
  76   "Non-nil means, an empty line ends all plain list levels.
  77 When nil, empty lines are part of the preceeding item."
  78   :group 'org-plain-lists
  79   :type 'boolean)
  80
  81 (defcustom org-auto-renumber-ordered-lists t
  82   "Non-nil means, automatically renumber ordered plain lists.
  83 Renumbering happens when the sequence have been changed with
  84 \\[org-shiftmetaup] or \\[org-shiftmetadown].  After other editing commands,
  85 use \\[org-ctrl-c-ctrl-c] to trigger renumbering."
  86   :group 'org-plain-lists
  87   :type 'boolean)
  88
  89 (defcustom org-provide-checkbox-statistics t
  90   "Non-nil means, update checkbox statistics after insert and toggle.
  91 When this is set, checkbox statistics is updated each time you either insert
  92 a new checkbox with \\[org-insert-todo-heading] or toggle a checkbox
  93 with \\[org-ctrl-c-ctrl-c\\]."
  94   :group 'org-plain-lists
  95   :type 'boolean)
  96
  97 (defcustom org-description-max-indent 20
  98   "Maximum indentation for the second line of a description list.
  99 When the indentation would be larger than this, it will become
 100 5 characters instead."
 101   :group 'org-plain-lists
 102   :type 'integer)
 103
 104 (defvar org-list-beginning-re
 105   "^\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) +\\(.*\\)$")
 106
 107 (defcustom org-list-radio-list-templates
 108   '((latex-mode "% BEGIN RECEIVE ORGLST %n
 109 % END RECEIVE ORGLST %n
 110 \\begin{comment}
 111 #+ORGLST: SEND %n org-list-to-latex
 112 | | |
 113 \\end{comment}\n")
 114     (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
 115 @c END RECEIVE ORGLST %n
 116 @ignore
 117 #+ORGLST: SEND %n org-list-to-texinfo
 118 | | |
 119 @end ignore\n")
 120     (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
 121 <!-- END RECEIVE ORGLST %n -->
 122 <!--
 123 #+ORGLST: SEND %n org-list-to-html
 124 | | |
 125 -->\n"))
 126   "Templates for radio lists in different major modes.
 127 All occurrences of %n in a template will be replaced with the name of the
 128 list, obtained by prompting the user."
 129   :group 'org-plain-lists
 130   :type '(repeat
 131           (list (symbol :tag "Major mode")
 132                 (string :tag "Format"))))
 133
 134 ;;;; Plain list items, including checkboxes
 135
 136 ;;; Plain list items
 137
 138 (defun org-at-item-p ()
 139   "Is point in a line starting a hand-formatted item?"
 140   (let ((llt org-plain-list-ordered-item-terminator))
 141     (save-excursion
 142       (goto-char (point-at-bol))
 143       (looking-at
 144        (cond
 145         ((eq llt t)  "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
 146         ((= llt ?.)  "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
 147         ((= llt ?\)) "\\([ \t]*\\([-+]\\|\\([0-9]+))\\)\\|[ \t]+\\*\\)\\( \\|$\\)")
 148         (t (error "Invalid value of `org-plain-list-ordered-item-terminator'")))))))
 149
 150 (defun org-in-item-p ()
 151   "It the cursor inside a plain list item.
 152 Does not have to be the first line."
 153   (save-excursion
 154     (condition-case nil
 155         (progn
 156           (org-beginning-of-item)
 157           (org-at-item-p)
 158           t)
 159       (error nil))))
 160
 161 (defun org-insert-item (&optional checkbox)
 162   "Insert a new item at the current level.
 163 Return t when things worked, nil when we are not in an item."
 164   (when (save-excursion
 165           (condition-case nil
 166               (progn
 167                 (org-beginning-of-item)
 168                 (org-at-item-p)
 169                 (if (org-invisible-p) (error "Invisible item"))
 170                 t)
 171             (error nil)))
 172     (let* ((bul (match-string 0))
 173            (descp (save-excursion (goto-char (match-beginning 0))
 174                                   (beginning-of-line 1)
 175                                   (save-match-data
 176                                     (looking-at "[ \t]*.*? ::"))))
 177            (eow (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")
 178                                 (match-end 0)))
 179            (blank (cdr (assq 'plain-list-item org-blank-before-new-entry)))
 180            pos)
 181       (if descp (setq checkbox nil))
 182       (cond
 183        ((and (org-at-item-p) (<= (point) eow))
 184         ;; before the bullet
 185         (beginning-of-line 1)
 186         (open-line (if blank 2 1)))
 187        ((<= (point) eow)
 188         (beginning-of-line 1))
 189        (t
 190         (unless (org-get-alist-option org-M-RET-may-split-line 'item)
 191           (end-of-line 1)
 192           (delete-horizontal-space))
 193         (newline (if blank 2 1))))
 194       (insert bul
 195               (if checkbox "[ ]" "")
 196               (if descp (concat (if checkbox " " "")
 197                                 (read-string "Term: ") " :: ") ""))
 198       (just-one-space)
 199       (setq pos (point))
 200       (end-of-line 1)
 201       (unless (= (point) pos) (just-one-space) (backward-delete-char 1)))
 202     (org-maybe-renumber-ordered-list)
 203     (and checkbox (org-update-checkbox-count-maybe))
 204     t))
 205
 206 ;;; Checkboxes
 207
 208 (defun org-at-item-checkbox-p ()
 209   "Is point at a line starting a plain-list item with a checklet?"
 210   (and (org-at-item-p)
 211        (save-excursion
 212          (goto-char (match-end 0))
 213          (skip-chars-forward " \t")
 214          (looking-at "\\[[- X]\\]"))))
 215
 216 (defun org-toggle-checkbox (&optional arg)
 217   "Toggle the checkbox in the current line."
 218   (interactive "P")
 219   (catch 'exit
 220     (let (beg end status (firstnew 'unknown))
 221       (cond
 222        ((org-region-active-p)
 223         (setq beg (region-beginning) end (region-end)))
 224        ((org-on-heading-p)
 225         (setq beg (point) end (save-excursion (outline-next-heading) (point))))
 226        ((org-at-item-checkbox-p)
 227         (let ((pos (point)))
 228           (replace-match
 229            (cond (arg "[-]")
 230                  ((member (match-string 0) '("[ ]" "[-]")) "[X]")
 231                  (t "[ ]"))
 232            t t)
 233           (goto-char pos))
 234         (throw 'exit t))
 235        (t (error "Not at a checkbox or heading, and no active region")))
 236       (save-excursion
 237         (goto-char beg)
 238         (while (< (point) end)
 239           (when (org-at-item-checkbox-p)
 240             (setq status (equal (match-string 0) "[X]"))
 241             (when (eq firstnew 'unknown)
 242               (setq firstnew (not status)))
 243             (replace-match
 244              (if (if arg (not status) firstnew) "[X]" "[ ]") t t))
 245           (beginning-of-line 2)))))
 246   (org-update-checkbox-count-maybe))
 247
 248 (defun org-update-checkbox-count-maybe ()
 249   "Update checkbox statistics unless turned off by user."
 250   (when org-provide-checkbox-statistics
 251     (org-update-checkbox-count)))
 252
 253 (defun org-update-checkbox-count (&optional all)
 254  "Update the checkbox statistics in the current section.
 255 This will find all statistic cookies like [57%] and [6/12] and update them
 256 with the current numbers.  With optional prefix argument ALL, do this for
 257 the whole buffer."
 258  (interactive "P")
 259  (save-excursion
 260    (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
 261           (beg (condition-case nil
 262                    (progn (outline-back-to-heading) (point))
 263                  (error (point-min))))
 264           (end (move-marker (make-marker)
 265                             (progn (outline-next-heading) (point))))
 266           (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
 267           (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
 268           (re-find (concat re "\\|" re-box))
 269           beg-cookie end-cookie is-percent c-on c-off lim
 270           eline curr-ind next-ind continue-from startsearch
 271           (cstat 0)
 272           )
 273      (when all
 274        (goto-char (point-min))
 275        (outline-next-heading)
 276        (setq beg (point) end (point-max)))
 277      (goto-char end)
 278      ;; find each statistic cookie
 279      (while (re-search-backward re-find beg t)
 280        (setq beg-cookie (match-beginning 1)
 281              end-cookie (match-end 1)
 282              cstat (+ cstat (if end-cookie 1 0))
 283              startsearch (point-at-eol)
 284              continue-from (point-at-bol)
 285              is-percent (match-beginning 2)
 286              lim (cond
 287                   ((org-on-heading-p) (outline-next-heading) (point))
 288                   ((org-at-item-p) (org-end-of-item) (point))
 289                   (t nil))
 290              c-on 0
 291              c-off 0)
 292        (when lim
 293          ;; find first checkbox for this cookie and gather
 294          ;; statistics from all that are at this indentation level
 295          (goto-char startsearch)
 296          (if (re-search-forward re-box lim t)
 297              (progn
 298                (org-beginning-of-item)
 299                (setq curr-ind (org-get-indentation))
 300                (setq next-ind curr-ind)
 301                (while (and (bolp) (org-at-item-p) (= curr-ind next-ind))
 302                  (save-excursion (end-of-line) (setq eline (point)))
 303                  (if (re-search-forward re-box eline t)
 304                      (if (member (match-string 2) '("[ ]" "[-]"))
 305                          (setq c-off (1+ c-off))
 306                        (setq c-on (1+ c-on))
 307                        )
 308                    )
 309                  (org-end-of-item)
 310                  (setq next-ind (org-get-indentation))
 311                  )))
 312          (goto-char continue-from)
 313          ;; update cookie
 314          (when end-cookie
 315            (delete-region beg-cookie end-cookie)
 316            (goto-char beg-cookie)
 317            (insert
 318             (if is-percent
 319                 (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
 320               (format "[%d/%d]" c-on (+ c-on c-off)))))
 321          ;; update items checkbox if it has one
 322          (when (org-at-item-p)
 323            (org-beginning-of-item)
 324            (when (and (> (+ c-on c-off) 0)
 325                       (re-search-forward re-box (point-at-eol) t))
 326              (setq beg-cookie (match-beginning 2)
 327                    end-cookie (match-end       2))
 328              (delete-region beg-cookie end-cookie)
 329              (goto-char beg-cookie)
 330              (cond ((= c-off 0) (insert "[X]"))
 331                    ((= c-on  0) (insert "[ ]"))
 332                    (t           (insert "[-]")))
 333              )))
 334        (goto-char continue-from))
 335      (when (interactive-p)
 336        (message "Checkbox satistics updated %s (%d places)"
 337                 (if all "in entire file" "in current outline entry") cstat)))))
 338
 339 (defun org-get-checkbox-statistics-face ()
 340   "Select the face for checkbox statistics.
 341 The face will be `org-done' when all relevant boxes are checked.  Otherwise
 342 it will be `org-todo'."
 343   (if (match-end 1)
 344       (if (equal (match-string 1) "100%") 'org-done 'org-todo)
 345     (if (and (> (match-end 2) (match-beginning 2))
 346              (equal (match-string 2) (match-string 3)))
 347         'org-done
 348       'org-todo)))
 349
 350 (defun org-beginning-of-item ()
 351   "Go to the beginning of the current hand-formatted item.
 352 If the cursor is not in an item, throw an error."
 353   (interactive)
 354   (let ((pos (point))
 355         (limit (save-excursion
 356                  (condition-case nil
 357                      (progn
 358                        (org-back-to-heading)
 359                        (beginning-of-line 2) (point))
 360                    (error (point-min)))))
 361         (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
 362         ind ind1)
 363     (if (org-at-item-p)
 364         (beginning-of-line 1)
 365       (beginning-of-line 1)
 366       (skip-chars-forward " \t")
 367       (setq ind (current-column))
 368       (if (catch 'exit
 369             (while t
 370               (beginning-of-line 0)
 371               (if (or (bobp) (< (point) limit)) (throw 'exit nil))
 372
 373               (if (looking-at "[ \t]*$")
 374                   (setq ind1 ind-empty)
 375                 (skip-chars-forward " \t")
 376                 (setq ind1 (current-column)))
 377               (if (< ind1 ind)
 378                   (progn (beginning-of-line 1) (throw 'exit (org-at-item-p))))))
 379           nil
 380         (goto-char pos)
 381         (error "Not in an item")))))
 382
 383 (defun org-end-of-item ()
 384   "Go to the end of the current hand-formatted item.
 385 If the cursor is not in an item, throw an error."
 386   (interactive)
 387   (let* ((pos (point))
 388          ind1
 389          (ind-empty (if org-empty-line-terminates-plain-lists 0 10000))
 390          (limit (save-excursion (outline-next-heading) (point)))
 391          (ind (save-excursion
 392                 (org-beginning-of-item)
 393                 (skip-chars-forward " \t")
 394                 (current-column)))
 395          (end (catch 'exit
 396                 (while t
 397                   (beginning-of-line 2)
 398                   (if (eobp) (throw 'exit (point)))
 399                   (if (>= (point) limit) (throw 'exit (point-at-bol)))
 400                   (if (looking-at "[ \t]*$")
 401                       (setq ind1 ind-empty)
 402                     (skip-chars-forward " \t")
 403                     (setq ind1 (current-column)))
 404                   (if (<= ind1 ind)
 405                       (throw 'exit (point-at-bol)))))))
 406     (if end
 407         (goto-char end)
 408       (goto-char pos)
 409       (error "Not in an item"))))
 410
 411 (defun org-next-item ()
 412   "Move to the beginning of the next item in the current plain list.
 413 Error if not at a plain list, or if this is the last item in the list."
 414   (interactive)
 415   (let (ind ind1 (pos (point)))
 416     (org-beginning-of-item)
 417     (setq ind (org-get-indentation))
 418     (org-end-of-item)
 419     (setq ind1 (org-get-indentation))
 420     (unless (and (org-at-item-p) (= ind ind1))
 421       (goto-char pos)
 422       (error "On last item"))))
 423
 424 (defun org-previous-item ()
 425   "Move to the beginning of the previous item in the current plain list.
 426 Error if not at a plain list, or if this is the first item in the list."
 427   (interactive)
 428   (let (beg ind ind1 (pos (point)))
 429     (org-beginning-of-item)
 430     (setq beg (point))
 431     (setq ind (org-get-indentation))
 432     (goto-char beg)
 433     (catch 'exit
 434       (while t
 435         (beginning-of-line 0)
 436         (if (looking-at "[ \t]*$")
 437             nil
 438           (if (<= (setq ind1 (org-get-indentation)) ind)
 439               (throw 'exit t)))))
 440     (condition-case nil
 441         (if (or (not (org-at-item-p))
 442                 (< ind1 (1- ind)))
 443             (error "")
 444           (org-beginning-of-item))
 445       (error (goto-char pos)
 446              (error "On first item")))))
 447
 448 (defun org-first-list-item-p ()
 449   "Is this heading the item in a plain list?"
 450   (unless (org-at-item-p)
 451     (error "Not at a plain list item"))
 452   (org-beginning-of-item)
 453   (= (point) (save-excursion (org-beginning-of-item-list))))
 454
 455 (defun org-move-item-down ()
 456   "Move the plain list item at point down, i.e. swap with following item.
 457 Subitems (items with larger indentation) are considered part of the item,
 458 so this really moves item trees."
 459   (interactive)
 460   (let ((col (current-column))
 461         (pos (point))
 462         beg beg0 end end0 ind ind1  txt ne-end ne-beg)
 463     (org-beginning-of-item)
 464     (setq beg0 (point))
 465     (save-excursion
 466       (setq ne-beg (org-back-over-empty-lines))
 467       (setq beg (point)))
 468     (goto-char beg0)
 469     (setq ind (org-get-indentation))
 470     (org-end-of-item)
 471     (setq end0 (point))
 472     (setq ind1 (org-get-indentation))
 473     (setq ne-end (org-back-over-empty-lines))
 474     (setq end (point))
 475     (goto-char beg0)
 476     (when (and (org-first-list-item-p) (< ne-end ne-beg))
 477       ;; include less whitespace
 478       (save-excursion
 479         (goto-char beg)
 480         (forward-line (- ne-beg ne-end))
 481         (setq beg (point))))
 482     (goto-char end0)
 483     (if (and (org-at-item-p) (= ind ind1))
 484         (progn
 485           (org-end-of-item)
 486           (org-back-over-empty-lines)
 487           (setq txt (buffer-substring beg end))
 488           (save-excursion
 489             (delete-region beg end))
 490           (setq pos (point))
 491           (insert txt)
 492           (goto-char pos) (org-skip-whitespace)
 493           (org-maybe-renumber-ordered-list)
 494           (move-to-column col))
 495       (goto-char pos)
 496       (move-to-column col)
 497       (error "Cannot move this item further down"))))
 498
 499 (defun org-move-item-up (arg)
 500   "Move the plain list item at point up, i.e. swap with previous item.
 501 Subitems (items with larger indentation) are considered part of the item,
 502 so this really moves item trees."
 503   (interactive "p")
 504   (let ((col (current-column)) (pos (point))
 505         beg beg0 end ind ind1  txt
 506         ne-beg ne-ins ins-end)
 507     (org-beginning-of-item)
 508     (setq beg0 (point))
 509     (setq ind (org-get-indentation))
 510     (save-excursion
 511       (setq ne-beg (org-back-over-empty-lines))
 512       (setq beg (point)))
 513     (goto-char beg0)
 514     (org-end-of-item)
 515     (org-back-over-empty-lines)
 516     (setq end (point))
 517     (goto-char beg0)
 518     (catch 'exit
 519       (while t
 520         (beginning-of-line 0)
 521         (if (looking-at "[ \t]*$")
 522             (if org-empty-line-terminates-plain-lists
 523                 (progn
 524                   (goto-char pos)
 525                   (error "Cannot move this item further up"))
 526               nil)
 527           (if (<= (setq ind1 (org-get-indentation)) ind)
 528               (throw 'exit t)))))
 529     (condition-case nil
 530         (org-beginning-of-item)
 531       (error (goto-char beg0)
 532              (move-to-column col)
 533              (error "Cannot move this item further up")))
 534     (setq ind1 (org-get-indentation))
 535     (if (and (org-at-item-p) (= ind ind1))
 536         (progn
 537           (setq ne-ins (org-back-over-empty-lines))
 538           (setq txt (buffer-substring beg end))
 539           (save-excursion
 540             (delete-region beg end))
 541           (setq pos (point))
 542           (insert txt)
 543           (setq ins-end (point))
 544           (goto-char pos) (org-skip-whitespace)
 545
 546           (when (and (org-first-list-item-p) (> ne-ins ne-beg))
 547             ;; Move whitespace back to beginning
 548             (save-excursion
 549               (goto-char ins-end)
 550               (let ((kill-whole-line t))
 551                 (kill-line (- ne-ins ne-beg)) (point)))
 552             (insert (make-string (- ne-ins ne-beg) ?\n)))
 553
 554           (org-maybe-renumber-ordered-list)
 555           (move-to-column col))
 556       (goto-char pos)
 557       (move-to-column col)
 558       (error "Cannot move this item further up"))))
 559
 560 (defun org-maybe-renumber-ordered-list ()
 561   "Renumber the ordered list at point if setup allows it.
 562 This tests the user option `org-auto-renumber-ordered-lists' before
 563 doing the renumbering."
 564   (interactive)
 565   (when (and org-auto-renumber-ordered-lists
 566              (org-at-item-p))
 567     (if (match-beginning 3)
 568         (org-renumber-ordered-list 1)
 569       (org-fix-bullet-type))))
 570
 571 (defun org-maybe-renumber-ordered-list-safe ()
 572   (condition-case nil
 573       (save-excursion
 574         (org-maybe-renumber-ordered-list))
 575     (error nil)))
 576
 577 (defun org-cycle-list-bullet (&optional which)
 578   "Cycle through the different itemize/enumerate bullets.
 579 This cycle the entire list level through the sequence:
 580
 581    `-'  ->  `+'  ->  `*'  ->  `1.'  ->  `1)'
 582
 583 If WHICH is a string, use that as the new bullet.  If WHICH is an integer,
 584 0 meand `-', 1 means `+' etc."
 585   (interactive "P")
 586   (org-preserve-lc
 587    (org-beginning-of-item-list)
 588    (org-at-item-p)
 589    (beginning-of-line 1)
 590    (let ((current (match-string 0))
 591          (prevp (eq which 'previous))
 592          new)
 593      (setq new (cond
 594                 ((and (numberp which)
 595                       (nth (1- which) '("-" "+" "*" "1." "1)"))))
 596                 ((string-match "-" current) (if prevp "1)" "+"))
 597                 ((string-match "\\+" current)
 598                  (if prevp "-" (if (looking-at "\\S-") "1." "*")))
 599                 ((string-match "\\*" current) (if prevp "+" "1."))
 600                 ((string-match "\\." current) (if prevp "*" "1)"))
 601                 ((string-match ")" current) (if prevp "1." "-"))
 602                 (t (error "This should not happen"))))
 603      (and (looking-at "\\([ \t]*\\)\\S-+") (replace-match (concat "\\1" new)))
 604      (org-fix-bullet-type)
 605      (org-maybe-renumber-ordered-list))))
 606
 607 (defun org-get-string-indentation (s)
 608   "What indentation has S due to SPACE and TAB at the beginning of the string?"
 609   (let ((n -1) (i 0) (w tab-width) c)
 610     (catch 'exit
 611       (while (< (setq n (1+ n)) (length s))
 612         (setq c (aref s n))
 613         (cond ((= c ?\ ) (setq i (1+ i)))
 614               ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
 615               (t (throw 'exit t)))))
 616     i))
 617
 618 (defun org-renumber-ordered-list (arg)
 619   "Renumber an ordered plain list.
 620 Cursor needs to be in the first line of an item, the line that starts
 621 with something like \"1.\" or \"2)\"."
 622   (interactive "p")
 623   (unless (and (org-at-item-p)
 624                (match-beginning 3))
 625     (error "This is not an ordered list"))
 626   (let ((line (org-current-line))
 627         (col (current-column))
 628         (ind (org-get-string-indentation
 629               (buffer-substring (point-at-bol) (match-beginning 3))))
 630         ;; (term (substring (match-string 3) -1))
 631         ind1 (n (1- arg))
 632         fmt bobp)
 633     ;; find where this list begins
 634     (org-beginning-of-item-list)
 635     (setq bobp (bobp))
 636     (looking-at "[ \t]*[0-9]+\\([.)]\\)")
 637     (setq fmt (concat "%d" (match-string 1)))
 638     (beginning-of-line 0)
 639     ;; walk forward and replace these numbers
 640     (catch 'exit
 641       (while t
 642         (catch 'next
 643           (if bobp (setq bobp nil) (beginning-of-line 2))
 644           (if (eobp) (throw 'exit nil))
 645           (if (looking-at "[ \t]*$") (throw 'next nil))
 646           (skip-chars-forward " \t") (setq ind1 (current-column))
 647           (if (> ind1 ind) (throw 'next t))
 648           (if (< ind1 ind) (throw 'exit t))
 649           (if (not (org-at-item-p)) (throw 'exit nil))
 650           (delete-region (match-beginning 2) (match-end 2))
 651           (goto-char (match-beginning 2))
 652           (insert (format fmt (setq n (1+ n)))))))
 653     (goto-line line)
 654     (org-move-to-column col)))
 655
 656 (defun org-fix-bullet-type ()
 657   "Make sure all items in this list have the same bullet as the firsst item."
 658   (interactive)
 659   (unless (org-at-item-p) (error "This is not a list"))
 660   (let ((line (org-current-line))
 661         (col (current-column))
 662         (ind (current-indentation))
 663         ind1 bullet)
 664     ;; find where this list begins
 665     (org-beginning-of-item-list)
 666     (beginning-of-line 1)
 667     ;; find out what the bullet type is
 668     (looking-at "[ \t]*\\(\\S-+\\)")
 669     (setq bullet (match-string 1))
 670     ;; walk forward and replace these numbers
 671     (beginning-of-line 0)
 672     (catch 'exit
 673       (while t
 674         (catch 'next
 675           (beginning-of-line 2)
 676           (if (eobp) (throw 'exit nil))
 677           (if (looking-at "[ \t]*$") (throw 'next nil))
 678           (skip-chars-forward " \t") (setq ind1 (current-column))
 679           (if (> ind1 ind) (throw 'next t))
 680           (if (< ind1 ind) (throw 'exit t))
 681           (if (not (org-at-item-p)) (throw 'exit nil))
 682           (skip-chars-forward " \t")
 683           (looking-at "\\S-+")
 684           (replace-match bullet))))
 685     (goto-line line)
 686     (org-move-to-column col)
 687     (if (string-match "[0-9]" bullet)
 688         (org-renumber-ordered-list 1))))
 689
 690 (defun org-beginning-of-item-list ()
 691   "Go to the beginning of the current item list.
 692 I.e. to the first item in this list."
 693   (interactive)
 694   (org-beginning-of-item)
 695   (let ((pos (point-at-bol))
 696         (ind (org-get-indentation))
 697         ind1)
 698     ;; find where this list begins
 699     (catch 'exit
 700       (while t
 701         (catch 'next
 702           (beginning-of-line 0)
 703           (if (looking-at "[ \t]*$")
 704               (throw (if (bobp) 'exit 'next) t))
 705           (skip-chars-forward " \t") (setq ind1 (current-column))
 706           (if (or (< ind1 ind)
 707                   (and (= ind1 ind)
 708                        (not (org-at-item-p)))
 709                   (and (= (point-at-bol) (point-min))
 710                        (setq pos (point-min))))
 711               (throw 'exit t)
 712             (when (org-at-item-p) (setq pos (point-at-bol)))))))
 713     (goto-char pos)))
 714
 715
 716 (defun org-end-of-item-list ()
 717   "Go to the end of the current item list.
 718 I.e. to the text after the last item."
 719   (interactive)
 720   (org-beginning-of-item)
 721   (let ((pos (point-at-bol))
 722         (ind (org-get-indentation))
 723         ind1)
 724     ;; find where this list begins
 725     (catch 'exit
 726       (while t
 727         (catch 'next
 728           (beginning-of-line 2)
 729           (if (looking-at "[ \t]*$")
 730               (throw (if (eobp) 'exit 'next) t))
 731           (skip-chars-forward " \t") (setq ind1 (current-column))
 732           (if (or (< ind1 ind)
 733                   (and (= ind1 ind)
 734                        (not (org-at-item-p)))
 735                   (eobp))
 736               (progn
 737                 (setq pos (point-at-bol))
 738                 (throw 'exit t))))))
 739     (goto-char pos)))
 740
 741
 742 (defvar org-last-indent-begin-marker (make-marker))
 743 (defvar org-last-indent-end-marker (make-marker))
 744
 745 (defun org-outdent-item (arg)
 746   "Outdent a local list item."
 747   (interactive "p")
 748   (org-indent-item (- arg)))
 749
 750 (defun org-indent-item (arg)
 751   "Indent a local list item."
 752   (interactive "p")
 753   (unless (org-at-item-p)
 754     (error "Not on an item"))
 755   (save-excursion
 756     (let (beg end ind ind1 tmp delta ind-down ind-up)
 757       (if (memq last-command '(org-shiftmetaright org-shiftmetaleft))
 758           (setq beg org-last-indent-begin-marker
 759                 end org-last-indent-end-marker)
 760         (org-beginning-of-item)
 761         (setq beg (move-marker org-last-indent-begin-marker (point)))
 762         (org-end-of-item)
 763         (setq end (move-marker org-last-indent-end-marker (point))))
 764       (goto-char beg)
 765       (setq tmp (org-item-indent-positions)
 766             ind (car tmp)
 767             ind-down (nth 2 tmp)
 768             ind-up (nth 1 tmp)
 769             delta (if (> arg 0)
 770                       (if ind-down (- ind-down ind) 2)
 771                     (if ind-up (- ind-up ind) -2)))
 772       (if (< (+ delta ind) 0) (error "Cannot outdent beyond margin"))
 773       (while (< (point) end)
 774         (beginning-of-line 1)
 775         (skip-chars-forward " \t") (setq ind1 (current-column))
 776         (delete-region (point-at-bol) (point))
 777         (or (eolp) (org-indent-to-column (+ ind1 delta)))
 778         (beginning-of-line 2))))
 779   (org-fix-bullet-type)
 780   (org-maybe-renumber-ordered-list-safe)
 781   (save-excursion
 782     (beginning-of-line 0)
 783     (condition-case nil (org-beginning-of-item) (error nil))
 784     (org-maybe-renumber-ordered-list-safe)))
 785
 786 (defun org-item-indent-positions ()
 787   "Return indentation for plain list items.
 788 This returns a list with three values:  The current indentation, the
 789 parent indentation and the indentation a child should habe.
 790 Assumes cursor in item line."
 791   (let* ((bolpos (point-at-bol))
 792          (ind (org-get-indentation))
 793          ind-down ind-up pos)
 794     (save-excursion
 795       (org-beginning-of-item-list)
 796       (skip-chars-backward "\n\r \t")
 797       (when (org-in-item-p)
 798         (org-beginning-of-item)
 799         (setq ind-up (org-get-indentation))))
 800     (setq pos (point))
 801     (save-excursion
 802       (cond
 803        ((and (condition-case nil (progn (org-previous-item) t)
 804                (error nil))
 805              (or (forward-char 1) t)
 806              (re-search-forward "^\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\( \\|$\\)" bolpos t))
 807         (setq ind-down (org-get-indentation)))
 808        ((and (goto-char pos)
 809              (org-at-item-p))
 810         (goto-char (match-end 0))
 811         (skip-chars-forward " \t")
 812         (setq ind-down (current-column)))))
 813     (list ind ind-up ind-down)))
 814
 815
 816 ;;; Send and receive lists
 817
 818 (defun org-list-parse-list (&optional delete)
 819   "Parse the list at point and maybe DELETE it.
 820 Return a list containing first level items as strings and
 821 sublevels as a list of strings."
 822   (let* ((item-beginning (org-list-item-beginning))
 823          (start (car item-beginning))
 824          (end (org-list-end (cdr item-beginning)))
 825          output itemsep ltype)
 826     (while (re-search-forward org-list-beginning-re end t)
 827       (goto-char (match-beginning 3))
 828       (save-match-data
 829         (cond ((string-match "[0-9]" (match-string 2))
 830                (setq itemsep "[0-9]+\\(?:\\.\\|)\\)"
 831                      ltype 'ordered))
 832               ((string-match "^.*::" (match-string 0))
 833                (setq itemsep "[-+]" ltype 'descriptive))
 834               (t (setq itemsep "[-+]" ltype 'unordered))))
 835       (let* ((indent1 (match-string 1))
 836              (nextitem (save-excursion
 837                          (save-match-data
 838                            (or (and (re-search-forward
 839                                      (concat "^" indent1 itemsep " *?") end t)
 840                                     (match-beginning 0)) end))))
 841              (item (buffer-substring
 842                     (point)
 843                     (or (and (re-search-forward
 844                               org-list-beginning-re end t)
 845                              (goto-char (match-beginning 0)))
 846                         (goto-char end))))
 847              (nextindent (match-string 1))
 848              (item (org-trim item))
 849              (item (if (string-match "^\\[.+\\]" item)
 850                        (replace-match "\\\\texttt{\\&}"
 851                                       t nil item) item)))
 852         (push item output)
 853         (when (> (length nextindent)
 854                  (length indent1))
 855           (narrow-to-region (point) nextitem)
 856           (push (org-list-parse-list) output)
 857           (widen))))
 858     (when delete (delete-region start end))
 859     (setq output (nreverse output))
 860     (push ltype output)))
 861
 862 (defun org-list-item-beginning ()
 863   "Find the beginning of the list item.
 864 Return a cons which car is the beginning position of the item and
 865 cdr is the indentation string."
 866   (save-excursion
 867     (if (not (or (looking-at org-list-beginning-re)
 868                  (re-search-backward
 869                   org-list-beginning-re nil t)))
 870         (progn (goto-char (point-min)) (point))
 871       (cons (match-beginning 0) (match-string 1)))))
 872
 873 (defun org-list-end (indent)
 874   "Return the position of the end of the list.
 875 INDENT is the indentation of the list."
 876   (save-excursion
 877     (catch 'exit
 878       (while (or (looking-at org-list-beginning-re)
 879                  (looking-at (concat "^" indent "[ \t]+\\|^$")))
 880         (if (eq (point) (point-max))
 881             (throw 'exit (point-max)))
 882         (forward-line 1))) (point)))
 883
 884 (defun org-list-insert-radio-list ()
 885   "Insert a radio list template appropriate for this major mode."
 886   (interactive)
 887   (let* ((e (assq major-mode org-list-radio-list-templates))
 888          (txt (nth 1 e))
 889          name pos)
 890     (unless e (error "No radio list setup defined for %s" major-mode))
 891     (setq name (read-string "List name: "))
 892     (while (string-match "%n" txt)
 893       (setq txt (replace-match name t t txt)))
 894     (or (bolp) (insert "\n"))
 895     (setq pos (point))
 896     (insert txt)
 897     (goto-char pos)))
 898
 899 (defun org-list-send-list (&optional maybe)
 900   "Send a tranformed version of this list to the receiver position.
 901 With argument MAYBE, fail quietly if no transformation is defined for
 902 this list."
 903   (interactive)
 904   (catch 'exit
 905     (unless (org-at-item-p) (error "Not at a list"))
 906     (save-excursion
 907       (goto-char (car (org-list-item-beginning)))
 908       (beginning-of-line 0)
 909       (unless (looking-at "#\\+ORGLST: *SEND +\\([a-zA-Z0-9_]+\\) +\\([^ \t\r\n]+\\)\\( +.*\\)?")
 910         (if maybe
 911             (throw 'exit nil)
 912           (error "Don't know how to transform this list"))))
 913     (let* ((name (match-string 1))
 914            (item-beginning (org-list-item-beginning))
 915            (transform (intern (match-string 2)))
 916            (txt (buffer-substring-no-properties
 917                  (car item-beginning)
 918                  (org-list-end (cdr item-beginning))))
 919            (list (org-list-parse-list))
 920            beg)
 921       (unless (fboundp transform)
 922         (error "No such transformation function %s" transform))
 923       (setq txt (funcall transform list))
 924       ;; Find the insertion place
 925       (save-excursion
 926         (goto-char (point-min))
 927         (unless (re-search-forward
 928                  (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
 929           (error "Don't know where to insert translated list"))
 930         (goto-char (match-beginning 0))
 931         (beginning-of-line 2)
 932         (setq beg (point))
 933         (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
 934           (error "Cannot find end of insertion region"))
 935         (beginning-of-line 1)
 936         (delete-region beg (point))
 937         (goto-char beg)
 938         (insert txt "\n"))
 939       (message "List converted and installed at receiver location"))))
 940
 941 (defun org-list-to-generic (list params)
 942   "Convert a LIST parsed through `org-list-parse-list' to other formats.
 943
 944 Valid parameters PARAMS are
 945
 946 :ustart     String to start an unordered list
 947 :uend       String to end an unordered list
 948
 949 :ostart     String to start an ordered list
 950 :oend       String to end an ordered list
 951
 952 :dstart     String to start a descriptive list
 953 :dend       String to end a descriptive list
 954 :dtstart    String to start a descriptive term
 955 :dtend      String to end a descriptive term
 956 :ddstart    String to start a description
 957 :ddend      String to end a description
 958
 959 :splice     When set to t, return only list body lines, don't wrap
 960             them into :[u/o]start and :[u/o]end.  Default is nil.
 961
 962 :istart     String to start a list item
 963 :iend       String to end a list item
 964 :isep       String to separate items
 965 :lsep       String to separate sublists"
 966   (interactive)
 967   (let* ((p params) sublist
 968          (splicep (plist-get p :splice))
 969          (ostart  (plist-get p :ostart))
 970          (oend  (plist-get p :oend))
 971          (ustart  (plist-get p :ustart))
 972          (uend  (plist-get p :uend))
 973          (dstart  (plist-get p :dstart))
 974          (dend  (plist-get p :dend))
 975          (dtstart  (plist-get p :dtstart))
 976          (dtend  (plist-get p :dtend))
 977          (ddstart  (plist-get p :ddstart))
 978          (ddend  (plist-get p :ddend))
 979          (istart  (plist-get p :istart))
 980          (iend  (plist-get p :iend))
 981          (isep  (plist-get p :isep))
 982          (lsep  (plist-get p :lsep)))
 983     (let ((wrapper
 984            (cond ((eq (car list) 'ordered)
 985                   (concat ostart "\n%s" oend "\n"))
 986                  ((eq (car list) 'unordered)
 987                   (concat ustart "\n%s" uend "\n"))
 988                  ((eq (car list) 'descriptive)
 989                   (concat dstart "\n%s" dend "\n"))))
 990           rtn term defstart defend)
 991       (while (setq sublist (pop list))
 992         (cond ((symbolp sublist) nil)
 993               ((stringp sublist)
 994                (when (string-match "^\\(.*\\) ::" sublist)
 995                  (setq term (org-trim (format (concat dtstart "%s" dtend)
 996                                               (match-string 1 sublist))))
 997                  (setq sublist (substring sublist (1+ (length term)))))
 998                (setq rtn (concat rtn istart term ddstart
 999                                  sublist ddend iend isep)))
1000               (t (setq rtn (concat rtn   ;; previous list
1001                                    lsep  ;; list separator
1002                                    (org-list-to-generic sublist p)
1003                                    lsep  ;; list separator
1004                                    )))))
1005       (format wrapper rtn))))
1006
1007 (defun org-list-to-latex (list)
1008   "Convert LIST into a LaTeX list."
1009   (org-list-to-generic
1010    list '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
1011                        :ustart "\\begin{itemize}" :uend "\\end{itemize}"
1012                        :dstart "\\begin{description}" :dend "\\end{description}"
1013                        :dtstart "[" :dtend "]"
1014                        :ddstart "" :ddend ""
1015                        :istart "\\item " :iend ""
1016                        :isep "\n" :lsep "\n")))
1017
1018 (defun org-list-to-html (list)
1019   "Convert LIST into a HTML list."
1020   (org-list-to-generic
1021    list '(:splicep nil :ostart "<ol>" :oend "</ol>"
1022                        :ustart "<ul>" :uend "</ul>"
1023                        :dstart "<dl>" :dend "</dl>"
1024                        :dtstart "<dt>" :dtend "</dt>"
1025                        :ddstart "<dd>" :ddend "</dd>"
1026                        :istart "<li>" :iend "</li>"
1027                        :isep "\n" :lsep "\n")))
1028
1029 (defun org-list-to-texinfo (list)
1030   "Convert LIST into a Texinfo list."
1031   (org-list-to-generic
1032    list '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
1033                        :ustart "@enumerate" :uend "@end enumerate"
1034                        :dstart "@table" :dend "@end table"
1035                        :dtstart "@item " :dtend "\n"
1036                        :ddstart "" :ddend ""
1037                        :istart "@item\n" :iend ""
1038                        :isep "\n" :lsep "\n")))
1039
1040 (provide 'org-list)
1041
1042 ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
1043 ;;; org-list.el ends here