config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

org-list.el (140236B)


      1 ;;; org-list.el --- Plain lists for Org              -*- lexical-binding: t; -*-
      2 ;;
      3 ;; Copyright (C) 2004-2024 Free Software Foundation, Inc.
      4 ;;
      5 ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
      6 ;;	   Bastien Guerry <bzg@gnu.org>
      7 ;; Keywords: outlines, hypermedia, calendar, text
      8 ;; URL: https://orgmode.org
      9 ;;
     10 ;; This file is part of GNU Emacs.
     11 ;;
     12 ;; GNU Emacs is free software: you can redistribute it and/or modify
     13 ;; it under the terms of the GNU General Public License as published by
     14 ;; the Free Software Foundation, either version 3 of the License, or
     15 ;; (at your option) any later version.
     16 
     17 ;; GNU Emacs is distributed in the hope that it will be useful,
     18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
     20 ;; GNU General Public License for more details.
     21 
     22 ;; You should have received a copy of the GNU General Public License
     23 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     25 ;;
     26 ;;; Commentary:
     27 
     28 ;; This file contains the code dealing with plain lists in Org mode.
     29 
     30 ;; The core concept behind lists is their structure.  A structure is
     31 ;; a snapshot of the list, in the shape of a data tree (see
     32 ;; `org-list-struct').
     33 
     34 ;; Once the list structure is stored, it is possible to make changes
     35 ;; on it that will be mirrored to the real list or to get information
     36 ;; about the list, using accessors and methods provided in the
     37 ;; library.  Most of them require the use of one or two helper
     38 ;; functions, namely `org-list-parents-alist' and
     39 ;; `org-list-prevs-alist'.
     40 
     41 ;; Structure is eventually applied to the buffer with
     42 ;; `org-list-write-struct'.  This function repairs (bullets,
     43 ;; indentation, checkboxes) the list in the process.  It should be
     44 ;; called near the end of any function working on structures.
     45 
     46 ;; Thus, a function applying to lists should usually follow this
     47 ;; template:
     48 
     49 ;; 1. Verify point is in a list and grab item beginning (with the same
     50 ;;    function `org-in-item-p').  If the function requires the cursor
     51 ;;    to be at item's bullet, `org-at-item-p' is more selective.  It
     52 ;;    is also possible to move point to the closest item with
     53 ;;    `org-list-search-backward', or `org-list-search-forward',
     54 ;;    applied to the function `org-item-beginning-re'.
     55 
     56 ;; 2. Get list structure with `org-list-struct'.
     57 
     58 ;; 3. Compute one, or both, helper functions,
     59 ;;    (`org-list-parents-alist', `org-list-prevs-alist') depending on
     60 ;;    needed accessors.
     61 
     62 ;; 4. Proceed with the modifications, using methods and accessors.
     63 
     64 ;; 5. Verify and apply structure to buffer, using
     65 ;;    `org-list-write-struct'.
     66 
     67 ;; 6. If changes made to the list might have modified check-boxes,
     68 ;;    call `org-update-checkbox-count-maybe'.
     69 
     70 ;; Computing a structure can be a costly operation on huge lists (a
     71 ;; few thousand lines long).  Thus, code should follow the rule:
     72 ;; "collect once, use many".  As a corollary, it is usually a bad idea
     73 ;; to use directly an interactive function inside the code, as those,
     74 ;; being independent entities, read the whole list structure another
     75 ;; time.
     76 
     77 ;;; Code:
     78 
     79 (require 'org-macs)
     80 (org-assert-version)
     81 
     82 (require 'cl-lib)
     83 (require 'org-macs)
     84 (require 'org-compat)
     85 (require 'org-fold-core)
     86 (require 'org-footnote)
     87 
     88 (defvar org-M-RET-may-split-line)
     89 (defvar org-adapt-indentation)
     90 (defvar org-auto-align-tags)
     91 (defvar org-blank-before-new-entry)
     92 (defvar org-clock-string)
     93 (defvar org-closed-string)
     94 (defvar org-deadline-string)
     95 (defvar org-done-keywords)
     96 (defvar org-drawer-regexp)
     97 (defvar org-element-all-objects)
     98 (defvar org-inhibit-startup)
     99 (defvar org-loop-over-headlines-in-active-region)
    100 (defvar org-odd-levels-only)
    101 (defvar org-outline-regexp-bol)
    102 (defvar org-scheduled-string)
    103 (defvar org-todo-line-regexp)
    104 (defvar org-ts-regexp)
    105 (defvar org-ts-regexp-both)
    106 
    107 (declare-function org-at-heading-p "org" (&optional invisible-ok))
    108 (declare-function org-back-to-heading "org" (&optional invisible-ok))
    109 (declare-function org-before-first-heading-p "org" ())
    110 (declare-function org-current-level "org" ())
    111 (declare-function org-element-at-point "org-element" (&optional pom cached-only))
    112 (declare-function org-element-context "org-element" (&optional element))
    113 (declare-function org-element-interpret-data "org-element" (data))
    114 (declare-function org-element-lineage "org-element-ast" (blob &optional types with-self))
    115 (declare-function org-element-macro-interpreter "org-element" (macro ##))
    116 (declare-function org-element-map "org-element" (data types fun &optional info first-match no-recursion with-affiliated))
    117 (declare-function org-element-normalize-string "org-element" (s))
    118 (declare-function org-element-parse-buffer "org-element" (&optional granularity visible-only keep-deferred))
    119 (declare-function org-element-property "org-element-ast" (property node))
    120 (declare-function org-element-begin "org-element" (node))
    121 (declare-function org-element-end "org-element" (node))
    122 (declare-function org-element-contents-begin "org-element" (node))
    123 (declare-function org-element-contents-end "org-element" (node))
    124 (declare-function org-element-post-affiliated "org-element" (node))
    125 (declare-function org-element-post-blank "org-element" (node))
    126 (declare-function org-element-parent "org-element-ast" (node))
    127 (declare-function org-element-put-property "org-element-ast" (node property value))
    128 (declare-function org-element-set "org-element-ast" (old new))
    129 (declare-function org-element-type-p "org-element-ast" (node types))
    130 (declare-function org-element-update-syntax "org-element" ())
    131 (declare-function org-end-of-meta-data "org" (&optional full))
    132 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
    133 (declare-function org-export-create-backend "ox" (&rest rest) t)
    134 (declare-function org-export-data-with-backend "ox" (data backend info))
    135 (declare-function org-export-get-backend "ox" (name))
    136 (declare-function org-export-get-environment "ox" (&optional backend subtreep ext-plist))
    137 (declare-function org-export-get-next-element "ox" (blob info &optional n))
    138 (declare-function org-export-with-backend "ox" (backend data &optional contents info))
    139 (declare-function org-fix-tags-on-the-fly "org" ())
    140 (declare-function org-get-todo-state "org" ())
    141 (declare-function org-in-block-p "org" (names))
    142 (declare-function org-inlinetask-goto-beginning "org-inlinetask" ())
    143 (declare-function org-inlinetask-goto-end "org-inlinetask" ())
    144 (declare-function org-inlinetask-in-task-p "org-inlinetask" ())
    145 (declare-function org-inlinetask-outline-regexp "org-inlinetask" ())
    146 (declare-function org-level-increment "org" ())
    147 (declare-function org-mode "org" ())
    148 (declare-function org-narrow-to-subtree "org" (&optional element))
    149 (declare-function org-outline-level "org" ())
    150 (declare-function org-previous-line-empty-p "org" ())
    151 (declare-function org-reduced-level "org" (L))
    152 (declare-function org-set-tags "org" (tags))
    153 (declare-function org-fold-show-subtree "org-fold" ())
    154 (declare-function org-fold-region "org-fold" (from to flag &optional spec))
    155 (declare-function org-sort-remove-invisible "org" (S))
    156 (declare-function org-time-string-to-seconds "org" (s))
    157 (declare-function org-timer-hms-to-secs "org-timer" (hms))
    158 (declare-function org-timer-item "org-timer" (&optional arg))
    159 (declare-function outline-next-heading "outline" ())
    160 (declare-function outline-previous-heading "outline" ())
    161 
    162 
    163 
    164 ;;; Configuration variables
    165 
    166 (defgroup org-plain-lists nil
    167   "Options concerning plain lists in Org mode."
    168   :tag "Org Plain lists"
    169   :group 'org-structure)
    170 
    171 (defcustom org-cycle-include-plain-lists t
    172   "When t, make TAB cycle visibility on plain list items.
    173 Cycling plain lists works only when the cursor is on a plain list
    174 item.  When the cursor is on an outline heading, plain lists are
    175 treated as text.  This is the most stable way of handling this,
    176 which is why it is the default.
    177 
    178 When this is the symbol `integrate', then integrate plain list
    179 items when cycling, as if they were children of outline headings.
    180 
    181 This setting can lead to strange effects when switching visibility
    182 to `children', because the first \"child\" in a subtree decides
    183 what children should be listed.  If that first \"child\" is a
    184 plain list item with an implied large level number, all true
    185 children and grand children of the outline heading will be
    186 exposed in a children' view."
    187   :group 'org-plain-lists
    188   :group 'org-cycle
    189   :type '(choice
    190 	  (const :tag "Never" nil)
    191 	  (const :tag "With cursor in plain list (recommended)" t)
    192 	  (const :tag "As children of outline headings" integrate)))
    193 
    194 (defcustom org-list-demote-modify-bullet nil
    195   "Default bullet type installed when demoting an item.
    196 This is an association list, for each bullet type, this alist will point
    197 to the bullet that should be used when this item is demoted.
    198 For example,
    199 
    200  (setq org-list-demote-modify-bullet
    201        \\='((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
    202 
    203 will make
    204 
    205   + Movies
    206     + Silence of the Lambs
    207     + My Cousin Vinny
    208   + Books
    209     + The Hunt for Red October
    210     + The Road to Omaha
    211 
    212 into
    213 
    214   + Movies
    215     - Silence of the Lambs
    216     - My Cousin Vinny
    217   + Books
    218     - The Hunt for Red October
    219     - The Road to Omaha"
    220   :group 'org-plain-lists
    221   :type '(repeat
    222 	  (cons
    223 	   (choice :tag "If the current bullet is  "
    224 		   (const "-")
    225 		   (const "+")
    226 		   (const "*")
    227 		   (const "1.")
    228 		   (const "1)"))
    229 	   (choice :tag "demotion will change it to"
    230 		   (const "-")
    231 		   (const "+")
    232 		   (const "*")
    233 		   (const "1.")
    234 		   (const "1)")))))
    235 
    236 (defcustom org-plain-list-ordered-item-terminator t
    237   "The character that makes a line with leading number an ordered list item.
    238 Valid values are ?. and ?\\).  To get both terminators, use t.
    239 
    240 This variable needs to be set before org.el is loaded.  If you
    241 need to make a change while Emacs is running, use the customize
    242 interface or run the following code after updating it:
    243 
    244   `\\[org-element-update-syntax]'"
    245   :group 'org-plain-lists
    246   :type '(choice (const :tag "dot like in \"2.\"" ?.)
    247 		 (const :tag "paren like in \"2)\"" ?\))
    248 		 (const :tag "both" t))
    249   :set (lambda (var val) (set-default-toplevel-value var val)
    250 	 (when (featurep 'org-element) (org-element-update-syntax))))
    251 
    252 (defcustom org-list-allow-alphabetical nil
    253   "Non-nil means single character alphabetical bullets are allowed.
    254 
    255 Both uppercase and lowercase are handled.  Lists with more than
    256 26 items will fallback to standard numbering.  Alphabetical
    257 counters like \"[@c]\" will be recognized.
    258 
    259 This variable needs to be set before org.el is loaded.  If you
    260 need to make a change while Emacs is running, use the customize
    261 interface or run the following code after updating it:
    262 
    263   `\\[org-element-update-syntax]'"
    264   :group 'org-plain-lists
    265   :version "24.1"
    266   :type 'boolean
    267   :set (lambda (var val) (set-default-toplevel-value var val)
    268 	 (when (featurep 'org-element) (org-element-update-syntax))))
    269 
    270 (defcustom org-list-two-spaces-after-bullet-regexp nil
    271   "A regular expression matching bullets that should have 2 spaces after them.
    272 When nil, no bullet will have two spaces after them.  When
    273 a string, it will be used as a regular expression.  When the
    274 bullet type of a list is changed, the new bullet type will be
    275 matched against this regexp.  If it matches, there will be two
    276 spaces instead of one after the bullet in each item of the list."
    277   :group 'org-plain-lists
    278   :type '(choice
    279 	  (const :tag "never" nil)
    280 	  (regexp)))
    281 
    282 (defcustom org-list-automatic-rules '((checkbox . t)
    283 				      (indent . t))
    284   "Non-nil means apply set of rules when acting on lists.
    285 \\<org-mode-map>
    286 By default, automatic actions are taken when using
    287   `\\[org-meta-return]',
    288   `\\[org-metaright]',
    289   `\\[org-metaleft]',
    290   `\\[org-shiftmetaright]',
    291   `\\[org-shiftmetaleft]',
    292   `\\[org-ctrl-c-minus]',
    293   `\\[org-toggle-checkbox]',
    294   `\\[org-insert-todo-heading]'.
    295 
    296 You can disable individually these rules by setting them to nil.
    297 Valid rules are:
    298 
    299 checkbox  when non-nil, checkbox statistics is updated each time
    300           you either insert a new checkbox or toggle a checkbox.
    301 indent    when non-nil, indenting or outdenting list top-item
    302           with its subtree will move the whole list and
    303           outdenting a list whose bullet is * to column 0 will
    304           change that bullet to \"-\"."
    305   :group 'org-plain-lists
    306   :version "24.1"
    307   :type '(alist :tag "Sets of rules"
    308 		:key-type
    309 		(choice
    310 		 (const :tag "Checkbox" checkbox)
    311 		 (const :tag "Indent" indent))
    312 		:value-type
    313 		(boolean :tag "Activate" :value t)))
    314 
    315 (defcustom org-list-use-circular-motion nil
    316   "Non-nil means commands implying motion in lists should be cyclic.
    317 \\<org-mode-map>
    318 In that case, the item following the last item is the first one,
    319 and the item preceding the first item is the last one.
    320 
    321 This affects the behavior of
    322   `\\[org-move-item-up]',
    323   `\\[org-move-item-down]',
    324   `\\[org-next-item]',
    325   `\\[org-previous-item]'."
    326   :group 'org-plain-lists
    327   :version "24.1"
    328   :type 'boolean)
    329 
    330 (defvar org-checkbox-statistics-hook nil
    331   "Hook that is run whenever Org thinks checkbox statistics should be updated.
    332 This hook runs even if checkbox rule in
    333 `org-list-automatic-rules' does not apply, so it can be used to
    334 implement alternative ways of collecting statistics
    335 information.")
    336 
    337 (defcustom org-checkbox-hierarchical-statistics t
    338   "Non-nil means checkbox statistics counts only the state of direct children.
    339 When nil, all boxes below the cookie are counted.
    340 This can be set to nil on a per-node basis using a COOKIE_DATA property
    341 with the word \"recursive\" in the value."
    342   :group 'org-plain-lists
    343   :type 'boolean)
    344 
    345 (defcustom org-list-indent-offset 0
    346   "Additional indentation for sub-items in a list.
    347 By setting this to a small number, usually 1 or 2, one can more
    348 clearly distinguish sub-items in a list."
    349   :group 'org-plain-lists
    350   :version "24.1"
    351   :type 'integer)
    352 
    353 (defvar org-list-forbidden-blocks '("example" "verse" "src" "export")
    354   "Names of blocks where lists are not allowed.
    355 Names must be in lower case.")
    356 
    357 
    358 ;;; Predicates and regexps
    359 
    360 (defconst org-list-end-re "^[ \t]*\n[ \t]*\n"
    361   "Regex matching the end of a plain list.")
    362 
    363 (defconst org-list-full-item-re
    364   (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)"
    365 	  "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?"
    366 	  "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?"
    367 	  "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?")
    368   "Matches a list item and puts everything into groups:
    369 group 1: bullet
    370 group 2: counter
    371 group 3: checkbox
    372 group 4: description tag")
    373 
    374 (defvar org--item-re-cache nil
    375   "Results cache for `org-item-re'.")
    376 (defsubst org-item-re ()
    377   "Return the correct regular expression for plain lists."
    378   (or (plist-get
    379        (plist-get org--item-re-cache
    380                   org-list-allow-alphabetical)
    381        org-plain-list-ordered-item-terminator)
    382       (let* ((term (cond
    383 	            ((eq org-plain-list-ordered-item-terminator t) "[.)]")
    384 	            ((= org-plain-list-ordered-item-terminator ?\)) ")")
    385 	            ((= org-plain-list-ordered-item-terminator ?.) "\\.")
    386 	            (t "[.)]")))
    387 	     (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))
    388              (re (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term
    389 	                 "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")))
    390         (setq org--item-re-cache
    391               (plist-put
    392                org--item-re-cache
    393                org-list-allow-alphabetical
    394                (plist-put
    395                 (plist-get org--item-re-cache
    396                            org-list-allow-alphabetical)
    397                 org-plain-list-ordered-item-terminator
    398                 re)))
    399         re)))
    400 
    401 (defsubst org-item-beginning-re ()
    402   "Regexp matching the beginning of a plain list item."
    403   (concat "^" (org-item-re)))
    404 
    405 (defun org-list-at-regexp-after-bullet-p (regexp)
    406   "Is point at a list item with REGEXP after bullet?"
    407   (and (org-at-item-p)
    408        (save-excursion
    409 	 (goto-char (match-end 0))
    410 	 (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?"
    411 				   (if org-list-allow-alphabetical
    412 				       "\\([0-9]+\\|[A-Za-z]\\)"
    413 				     "[0-9]+")
    414 				   "\\][ \t]*\\)")))
    415 	   ;; Ignore counter if any
    416 	   (when (looking-at counter-re) (goto-char (match-end 0))))
    417 	 (looking-at regexp))))
    418 
    419 (defun org-list-in-valid-context-p ()
    420   "Is point in a context where lists are allowed?"
    421   (not (org-in-block-p org-list-forbidden-blocks)))
    422 
    423 (defun org-in-item-p ()
    424   "Return item beginning position when in a plain list, nil otherwise."
    425   (save-excursion
    426     (forward-line 0)
    427     (let* ((case-fold-search t)
    428 	   (context (org-list-context))
    429 	   (lim-up (car context))
    430 	   (inlinetask-re (and (featurep 'org-inlinetask)
    431 			       (org-inlinetask-outline-regexp)))
    432 	   (item-re (org-item-re))
    433 	   ;; Indentation isn't meaningful when point starts at an empty
    434 	   ;; line or an inline task.
    435 	   (ind-ref (if (or (looking-at "^[ \t]*$")
    436 			    (and inlinetask-re (looking-at inlinetask-re)))
    437 			10000
    438 		      (org-current-text-indentation))))
    439       (cond
    440        ((eq (nth 2 context) 'invalid) nil)
    441        ((looking-at item-re) (point))
    442        (t
    443 	;; Detect if cursor in amidst `org-list-end-re'.  First, count
    444 	;; number HL of hard lines it takes, then call `org-in-regexp'
    445 	;; to compute its boundaries END-BOUNDS.  When point is
    446 	;; in-between, move cursor before regexp beginning.
    447 	(let ((hl 0) (i -1) end-bounds)
    448 	  (when (and (progn
    449 		       (while (setq i (string-match
    450 				       "[\r\n]" org-list-end-re (1+ i)))
    451 			 (setq hl (1+ hl)))
    452 		       (setq end-bounds (org-in-regexp org-list-end-re hl)))
    453 		     (>= (point) (car end-bounds))
    454 		     (< (point) (cdr end-bounds)))
    455 	    (goto-char (car end-bounds))
    456 	    (forward-line -1)))
    457 	;; Look for an item, less indented that reference line.
    458 	(catch 'exit
    459 	  (while t
    460 	    (let ((ind (org-current-text-indentation)))
    461 	      (cond
    462 	       ;; This is exactly what we want.
    463 	       ((and (looking-at item-re) (< ind ind-ref))
    464 		(throw 'exit (point)))
    465 	       ;; At upper bound of search or looking at the end of a
    466 	       ;; previous list: search is over.
    467 	       ((<= (point) lim-up) (throw 'exit nil))
    468 	       ((looking-at org-list-end-re) (throw 'exit nil))
    469 	       ;; Skip blocks, drawers, inline-tasks, blank lines
    470 	       ((and (looking-at "^[ \t]*#\\+end_")
    471 		     (re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
    472 	       ((and (looking-at "^[ \t]*:END:")
    473 		     (re-search-backward org-drawer-regexp lim-up t))
    474 		(forward-line 0))
    475 	       ((and inlinetask-re (looking-at inlinetask-re))
    476 		(org-inlinetask-goto-beginning)
    477 		(forward-line -1))
    478 	       ((looking-at "^[ \t]*$") (forward-line -1))
    479 	       ;; Text at column 0 cannot belong to a list: stop.
    480 	       ((zerop ind) (throw 'exit nil))
    481 	       ;; Normal text less indented than reference line, take
    482 	       ;; it as new reference.
    483 	       ((< ind ind-ref)
    484 		(setq ind-ref ind)
    485 		(forward-line -1))
    486 	       (t (forward-line -1)))))))))))
    487 
    488 ;; FIXME: We should make use of org-element API in more places here.
    489 (defun org-at-item-p ()
    490   "Is point in a line starting a hand-formatted item?
    491 Modify match data, matching against `org-item-re'."
    492   (save-excursion
    493     (forward-line 0)
    494     (and
    495      (org-element-type-p
    496       (org-element-at-point)
    497       '(plain-list item))
    498      ;; Set match data.
    499      (looking-at (org-item-re)))))
    500 
    501 (defun org-at-item-bullet-p ()
    502   "Is point at the bullet of a plain list item?"
    503   (and (org-at-item-p)
    504        (not (member (char-after) '(?\  ?\t)))
    505        (< (point) (match-end 0))))
    506 
    507 (defun org-at-item-timer-p ()
    508   "Is point at a line starting a plain list item with a timer?"
    509   (org-list-at-regexp-after-bullet-p
    510    "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
    511 
    512 (defun org-at-item-description-p ()
    513   "Is point at a description list item?"
    514   (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)"))
    515 
    516 (defun org-at-item-checkbox-p ()
    517   "Is point at a line starting a plain-list item with a checklet?"
    518   (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
    519 
    520 (defun org-at-item-counter-p ()
    521   "Is point at a line starting a plain-list item with a counter?"
    522   (and (org-at-item-p)
    523        (looking-at org-list-full-item-re)
    524        (match-string 2)))
    525 
    526 
    527 
    528 ;;; Structures and helper functions
    529 
    530 (defun org-list-context ()
    531   "Determine context, and its boundaries, around point.
    532 
    533 Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX
    534 are boundaries and CONTEXT is a symbol among `drawer', `block',
    535 `invalid', `inlinetask' and nil.
    536 
    537 Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'."
    538   (save-match-data
    539     (save-excursion
    540       (org-with-limited-levels
    541        (forward-line 0)
    542        (let ((case-fold-search t) (pos (point)) beg end context-type
    543 	     ;; Get positions of surrounding headings.  This is the
    544 	     ;; default context.
    545 	     (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t))
    546 					      (point)))
    547 			 (point-min)))
    548 	     (lim-down (or (save-excursion (outline-next-heading)) (point-max))))
    549 	 ;; Is point inside a drawer?
    550 	 (let ((end-re "^[ \t]*:END:")
    551 	       (beg-re org-drawer-regexp))
    552 	   (when (save-excursion
    553 		   (and (not (looking-at beg-re))
    554 			(not (looking-at end-re))
    555 			(setq beg (and (re-search-backward beg-re lim-up t)
    556                                        (1+ (line-end-position))))
    557 			(setq end (or (and (re-search-forward end-re lim-down t)
    558 					   (1- (match-beginning 0)))
    559 				      lim-down))
    560 			(>= end pos)))
    561 	     (setq lim-up beg lim-down end context-type 'drawer)))
    562 	 ;; Is point strictly in a block, and of which type?
    563 	 (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type)
    564 	   (when (save-excursion
    565 		   (and (not (looking-at block-re))
    566 			(setq beg (and (re-search-backward block-re lim-up t)
    567                                        (1+ (line-end-position))))
    568 			(looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)")
    569 			(setq type (downcase (match-string 1)))
    570 			(goto-char beg)
    571 			(setq end (or (and (re-search-forward block-re lim-down t)
    572                                            (1- (line-beginning-position)))
    573 				      lim-down))
    574 			(>= end pos)
    575 			(equal (downcase (match-string 1)) "end")))
    576 	     (setq lim-up beg lim-down end
    577 		   context-type (if (member type org-list-forbidden-blocks)
    578 				    'invalid 'block))))
    579 	 ;; Is point in an inlinetask?
    580 	 (when (and (featurep 'org-inlinetask)
    581 		    (save-excursion
    582 		      (let* ((beg-re (org-inlinetask-outline-regexp))
    583 			     (end-re (concat beg-re "END[ \t]*$")))
    584 			(and (not (looking-at "^\\*+"))
    585 			     (setq beg (and (re-search-backward beg-re lim-up t)
    586                                             (1+ (line-end-position))))
    587 			     (not (looking-at end-re))
    588 			     (setq end (and (re-search-forward end-re lim-down t)
    589 					    (1- (match-beginning 0))))
    590 			     (> (point) pos)))))
    591 	   (setq lim-up beg lim-down end context-type 'inlinetask))
    592 	 ;; Return context boundaries and type.
    593 	 (list lim-up lim-down context-type))))))
    594 
    595 (defun org-list-struct ()
    596   "Return structure of list at point.
    597 
    598 A list structure is an alist where key is point at item, and
    599 values are:
    600 1. indentation,
    601 2. bullet with trailing whitespace,
    602 3. bullet counter, if any,
    603 4. checkbox, if any,
    604 5. description tag, if any,
    605 6. position at item end.
    606 
    607 Thus the following list, where numbers in parens are
    608 line-beginning-position:
    609 
    610 - [X] first item                             (1)
    611   1. sub-item 1                              (18)
    612   5. [@5] sub-item 2                         (34)
    613   some other text belonging to first item    (55)
    614 - last item                                  (97)
    615   + tag :: description                       (109)
    616                                              (131)
    617 
    618 will get the following structure:
    619 
    620  ((1 0 \"- \"  nil \"[X]\" nil 97)
    621   (18 2 \"1. \"  nil nil nil 34)
    622   (34 2 \"5. \" \"5\" nil nil 55)
    623   (97 0 \"- \"  nil nil nil 131)
    624   (109 2 \"+ \" nil nil \"tag\" 131))
    625 
    626 Assume point is at an item."
    627   (save-excursion
    628     (forward-line 0)
    629     (let* ((case-fold-search t)
    630 	   (context (org-list-context))
    631 	   (lim-up (car context))
    632 	   (lim-down (nth 1 context))
    633 	   (text-min-ind 10000)
    634 	   (item-re (org-item-re))
    635 	   (inlinetask-re (and (featurep 'org-inlinetask)
    636 			       (org-inlinetask-outline-regexp)))
    637 	   (beg-cell (cons (point) (org-current-text-indentation)))
    638            itm-lst itm-lst-2 end-lst end-lst-2 struct
    639 	   (assoc-at-point
    640 	    ;; Return association at point.
    641 	    (lambda (ind)
    642 	      (looking-at org-list-full-item-re)
    643 	      (let ((bullet (match-string-no-properties 1)))
    644 		(list (point)
    645 		      ind
    646 		      bullet
    647 		      (match-string-no-properties 2) ; counter
    648 		      (match-string-no-properties 3) ; checkbox
    649 		      ;; Description tag.
    650 		      (and (string-match-p "[-+*]" bullet)
    651 			   (match-string-no-properties 4))))))
    652 	   (end-before-blank
    653 	    ;; Ensure list ends at the first blank line.
    654 	    (lambda ()
    655 	      (skip-chars-backward " \r\t\n")
    656               (min (1+ (line-end-position)) lim-down))))
    657       ;; 1. Read list from starting item to its beginning, and save
    658       ;;    top item position and indentation in BEG-CELL.  Also store
    659       ;;    ending position of items in END-LST.
    660       (save-excursion
    661 	(catch 'exit
    662 	  (while t
    663 	    (let ((ind (org-current-text-indentation)))
    664 	      (cond
    665 	       ((<= (point) lim-up)
    666 		;; At upward limit: if we ended at an item, store it,
    667 		;; else dismiss useless data recorded above BEG-CELL.
    668 		;; Jump to part 2.
    669 		(throw 'exit
    670 		       (setq itm-lst
    671 			     (if (not (looking-at item-re))
    672 				 (memq (assq (car beg-cell) itm-lst) itm-lst)
    673 			       (setq beg-cell (cons (point) ind))
    674 			       (cons (funcall assoc-at-point ind) itm-lst)))))
    675 	       ;; Looking at a list ending regexp.  Dismiss useless
    676 	       ;; data recorded above BEG-CELL.  Jump to part 2.
    677 	       ((looking-at org-list-end-re)
    678 		(throw 'exit
    679 		       (setq itm-lst
    680 			     (memq (assq (car beg-cell) itm-lst) itm-lst))))
    681 	       ;; Point is at an item.  Add data to ITM-LST. It may
    682 	       ;; also end a previous item: save it in END-LST.  If
    683 	       ;; ind is less or equal than BEG-CELL and there is no
    684 	       ;; end at this ind or lesser, this item becomes the new
    685 	       ;; BEG-CELL.
    686 	       ((looking-at item-re)
    687 		(push (funcall assoc-at-point ind) itm-lst)
    688 		(push (cons ind (point)) end-lst)
    689 		(when (< ind text-min-ind) (setq beg-cell (cons (point) ind)))
    690 		(forward-line -1))
    691 	       ;; Skip blocks, drawers, inline tasks, blank lines.
    692 	       ((and (looking-at "^[ \t]*#\\+end_")
    693 		     (re-search-backward "^[ \t]*#\\+begin_" lim-up t)))
    694 	       ((and (looking-at "^[ \t]*:END:")
    695 		     (re-search-backward org-drawer-regexp lim-up t))
    696 		(forward-line 0))
    697 	       ((and inlinetask-re (looking-at inlinetask-re))
    698 		(org-inlinetask-goto-beginning)
    699 		(forward-line -1))
    700 	       ((looking-at "^[ \t]*$")
    701 		(forward-line -1))
    702 	       ;; From there, point is not at an item.  Interpret
    703 	       ;; line's indentation:
    704 	       ;; - text at column 0 is necessarily out of any list.
    705 	       ;;   Dismiss data recorded above BEG-CELL.  Jump to
    706 	       ;;   part 2.
    707 	       ;; - any other case may be an ending position for an
    708 	       ;;   hypothetical item above.  Store it and proceed.
    709 	       ((zerop ind)
    710 		(throw 'exit
    711 		       (setq itm-lst
    712 			     (memq (assq (car beg-cell) itm-lst) itm-lst))))
    713 	       (t
    714 		(when (< ind text-min-ind) (setq text-min-ind ind))
    715 		(push (cons ind (point)) end-lst)
    716 		(forward-line -1)))))))
    717       ;; 2. Read list from starting point to its end, that is until we
    718       ;;    get out of context, or that a non-item line is less or
    719       ;;    equally indented than BEG-CELL's cdr.  Also, store ending
    720       ;;    position of items in END-LST-2.
    721       (catch 'exit
    722 	(while t
    723 	  (let ((ind (org-current-text-indentation)))
    724 	    (cond
    725 	     ((>= (point) lim-down)
    726 	      ;; At downward limit: this is de facto the end of the
    727 	      ;; list.  Save point as an ending position, and jump to
    728 	      ;; part 3.
    729 	      (throw 'exit
    730 		     (push (cons 0 (funcall end-before-blank)) end-lst-2)))
    731 	     ;; Looking at a list ending regexp.  Save point as an
    732 	     ;; ending position and jump to part 3.
    733 	     ((looking-at org-list-end-re)
    734 	      (throw 'exit (push (cons 0 (point)) end-lst-2)))
    735 	     ((looking-at item-re)
    736 	      ;; Point is at an item.  Add data to ITM-LST-2. It may
    737 	      ;; also end a previous item, so save it in END-LST-2.
    738 	      (push (funcall assoc-at-point ind) itm-lst-2)
    739 	      (push (cons ind (point)) end-lst-2)
    740 	      (forward-line 1))
    741 	     ;; Skip inline tasks and blank lines along the way
    742 	     ((and inlinetask-re (looking-at inlinetask-re))
    743 	      (org-inlinetask-goto-end))
    744 	     ((looking-at "^[ \t]*$")
    745 	      (forward-line 1))
    746 	     ;; Ind is lesser or equal than BEG-CELL's.  The list is
    747 	     ;; over: store point as an ending position and jump to
    748 	     ;; part 3.
    749 	     ((<= ind (cdr beg-cell))
    750 	      (throw 'exit
    751 		     (push (cons 0 (funcall end-before-blank)) end-lst-2)))
    752 	     ;; Else, if ind is lesser or equal than previous item's,
    753 	     ;; this is an ending position: store it.  In any case,
    754 	     ;; skip block or drawer at point, and move to next line.
    755 	     (t
    756 	      (when (<= ind (nth 1 (car itm-lst-2)))
    757 		(push (cons ind (point)) end-lst-2))
    758 	      (cond
    759 	       ((and (looking-at "^[ \t]*#\\+begin_")
    760 		     (re-search-forward "^[ \t]*#\\+end_" lim-down t)))
    761 	       ((and (looking-at org-drawer-regexp)
    762 		     (re-search-forward "^[ \t]*:END:" lim-down t))))
    763 	      (forward-line 1))))))
    764       (setq struct (append itm-lst (cdr (nreverse itm-lst-2)))
    765 	    end-lst (append end-lst (cdr (nreverse end-lst-2))))
    766       ;; 3. Associate each item to its end position.
    767       (org-list-struct-assoc-end struct end-lst)
    768       ;; 4. Return STRUCT
    769       struct)))
    770 
    771 (defun org-list-struct-assoc-end (struct end-list)
    772   "Associate proper ending point to items in STRUCT.
    773 
    774 END-LIST is a pseudo-alist where car is indentation and cdr is
    775 ending position.
    776 
    777 This function modifies STRUCT."
    778   (let ((endings end-list))
    779     (mapc
    780      (lambda (elt)
    781        (let ((pos (car elt))
    782 	     (ind (nth 1 elt)))
    783 	 ;; Remove end candidates behind current item.
    784 	 (while (or (<= (cdar endings) pos))
    785 	   (pop endings))
    786 	 ;; Add end position to item assoc.
    787 	 (let ((old-end (nthcdr 6 elt))
    788 	       (new-end (assoc-default ind endings '<=)))
    789 	   (if old-end
    790 	       (setcar old-end new-end)
    791 	     (setcdr elt (append (cdr elt) (list new-end)))))))
    792      struct)))
    793 
    794 (defun org-list-prevs-alist (struct)
    795   "Return alist between item and previous item in STRUCT."
    796   (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e)))
    797 				struct)))
    798     (mapcar (lambda (e)
    799 	      (let ((prev (car (rassq (car e) item-end-alist))))
    800 		(cons (car e) prev)))
    801 	    struct)))
    802 
    803 (defun org-list-parents-alist (struct)
    804   "Return alist between item and parent in STRUCT."
    805   (let* ((ind-to-ori (list (list (nth 1 (car struct)))))
    806 	 (top-item (org-list-get-top-point struct))
    807 	 (prev-pos (list top-item)))
    808     (cons prev-pos
    809 	  (mapcar (lambda (item)
    810 		    (let ((pos (car item))
    811 			  (ind (nth 1 item))
    812 			  (prev-ind (caar ind-to-ori)))
    813 		      (push pos prev-pos)
    814 		      (cond
    815 		       ((> prev-ind ind)
    816 			;; A sub-list is over.  Find the associated
    817 			;; origin in IND-TO-ORI.  If it cannot be
    818 			;; found (ill-formed list), set its parent as
    819 			;; the first item less indented.  If there is
    820 			;; none, make it a top-level item.
    821 			(setq ind-to-ori
    822 			      (or (member (assq ind ind-to-ori) ind-to-ori)
    823                                   (catch 'exit
    824                                     (mapc
    825                                      (lambda (e)
    826                                        (when (< (car e) ind)
    827                                          (throw 'exit (member e ind-to-ori))))
    828                                      ind-to-ori)
    829                                     (list (list ind)))))
    830 			(cons pos (cdar ind-to-ori)))
    831                        ;; A sub-list starts.  Every item at IND will
    832                        ;; have previous item as its parent.
    833 		       ((< prev-ind ind)
    834 			(let ((origin (nth 1 prev-pos)))
    835 			  (push (cons ind origin) ind-to-ori)
    836 			  (cons pos origin)))
    837                        ;; Another item in the same sub-list: it shares
    838                        ;; the same parent as the previous item.
    839 		       (t (cons pos (cdar ind-to-ori))))))
    840 		  (cdr struct)))))
    841 
    842 (defun org-list--delete-metadata ()
    843   "Delete metadata from the heading at point.
    844 Metadata are tags, planning information and properties drawers."
    845   (save-match-data
    846     (org-with-wide-buffer
    847      (org-set-tags nil)
    848      (delete-region (line-beginning-position 2)
    849 		    (save-excursion
    850 		      (org-end-of-meta-data)
    851 		      (org-skip-whitespace)
    852 		      (if (eobp) (point) (line-beginning-position)))))))
    853 
    854 
    855 ;;; Accessors
    856 
    857 (defsubst org-list-get-nth (n key struct)
    858   "Return the Nth value of KEY in STRUCT."
    859   (nth n (assq key struct)))
    860 
    861 (defun org-list-set-nth (n key struct new)
    862   "Set the Nth value of KEY in STRUCT to NEW.
    863 \nThis function modifies STRUCT."
    864   (setcar (nthcdr n (assq key struct)) new))
    865 
    866 (defsubst org-list-get-ind (item struct)
    867   "Return indentation of ITEM in STRUCT."
    868   (org-list-get-nth 1 item struct))
    869 
    870 (defun org-list-set-ind (item struct ind)
    871   "Set indentation of ITEM in STRUCT to IND.
    872 \nThis function modifies STRUCT."
    873   (org-list-set-nth 1 item struct ind))
    874 
    875 (defsubst org-list-get-bullet (item struct)
    876   "Return bullet of ITEM in STRUCT."
    877   (org-list-get-nth 2 item struct))
    878 
    879 (defun org-list-set-bullet (item struct bullet)
    880   "Set bullet of ITEM in STRUCT to BULLET.
    881 \nThis function modifies STRUCT."
    882   (org-list-set-nth 2 item struct bullet))
    883 
    884 (defsubst org-list-get-counter (item struct)
    885   "Return counter of ITEM in STRUCT."
    886   (org-list-get-nth 3 item struct))
    887 
    888 (defsubst org-list-get-checkbox (item struct)
    889   "Return checkbox of ITEM in STRUCT or nil."
    890   (org-list-get-nth 4 item struct))
    891 
    892 (defun org-list-set-checkbox (item struct checkbox)
    893   "Set checkbox of ITEM in STRUCT to CHECKBOX.
    894 \nThis function modifies STRUCT."
    895   (org-list-set-nth 4 item struct checkbox))
    896 
    897 (defsubst org-list-get-tag (item struct)
    898   "Return end position of ITEM in STRUCT."
    899   (org-list-get-nth 5 item struct))
    900 
    901 (defun org-list-get-item-end (item struct)
    902   "Return end position of ITEM in STRUCT."
    903   (org-list-get-nth 6 item struct))
    904 
    905 (defun org-list-get-item-end-before-blank (item struct)
    906   "Return point at end of ITEM in STRUCT, before any blank line.
    907 Point returned is at end of line."
    908   (save-excursion
    909     (goto-char (org-list-get-item-end item struct))
    910     (skip-chars-backward " \r\t\n")
    911     (line-end-position)))
    912 
    913 (defun org-list-get-parent (item struct parents)
    914   "Return parent of ITEM or nil.
    915 STRUCT is the list structure.  PARENTS is the alist of parents,
    916 as returned by `org-list-parents-alist'."
    917   (let ((parents (or parents (org-list-parents-alist struct))))
    918     (cdr (assq item parents))))
    919 
    920 (defun org-list-has-child-p (item struct)
    921   "Non-nil if ITEM has a child.
    922 
    923 STRUCT is the list structure.
    924 
    925 Value returned is the position of the first child of ITEM."
    926   (let ((ind (org-list-get-ind item struct))
    927 	(child-maybe (car (nth 1 (member (assq item struct) struct)))))
    928     (when (and child-maybe
    929 	       (< ind (org-list-get-ind child-maybe struct)))
    930       child-maybe)))
    931 
    932 (defun org-list-get-next-item (item _struct prevs)
    933   "Return next item in same sub-list as ITEM, or nil.
    934 STRUCT is the list structure.  PREVS is the alist of previous
    935 items, as returned by `org-list-prevs-alist'."
    936   (car (rassq item prevs)))
    937 
    938 (defun org-list-get-prev-item (item _struct prevs)
    939   "Return previous item in same sub-list as ITEM, or nil.
    940 STRUCT is the list structure.  PREVS is the alist of previous
    941 items, as returned by `org-list-prevs-alist'."
    942   (cdr (assq item prevs)))
    943 
    944 (defun org-list-get-subtree (item struct)
    945   "List all items having ITEM as a common ancestor, or nil.
    946 STRUCT is the list structure."
    947   (let* ((item-end (org-list-get-item-end item struct))
    948 	 (sub-struct (cdr (member (assq item struct) struct)))
    949 	 items)
    950     (catch :exit
    951       (pcase-dolist (`(,pos . ,_) sub-struct)
    952 	(if (< pos item-end)
    953 	    (push pos items)
    954 	  (throw :exit nil))))
    955     (nreverse items)))
    956 
    957 (defun org-list-get-all-items (item struct prevs)
    958   "List all items in the same sub-list as ITEM.
    959 STRUCT is the list structure.  PREVS is the alist of previous
    960 items, as returned by `org-list-prevs-alist'."
    961   (let ((prev-item item)
    962 	(next-item item)
    963 	before-item after-item)
    964     (while (setq prev-item (org-list-get-prev-item prev-item struct prevs))
    965       (push prev-item before-item))
    966     (while (setq next-item (org-list-get-next-item next-item struct prevs))
    967       (push next-item after-item))
    968     (append before-item (list item) (nreverse after-item))))
    969 
    970 (defun org-list-get-children (item _struct parents)
    971   "List all children of ITEM, or nil.
    972 STRUCT is the list structure.  PARENTS is the alist of parents,
    973 as returned by `org-list-parents-alist'."
    974   (let (all child)
    975     (while (setq child (car (rassq item parents)))
    976       (setq parents (cdr (member (assq child parents) parents)))
    977       (push child all))
    978     (nreverse all)))
    979 
    980 (defun org-list-get-top-point (struct)
    981   "Return point at beginning of list.
    982 STRUCT is the list structure."
    983   (caar struct))
    984 
    985 (defun org-list-get-bottom-point (struct)
    986   "Return point at bottom of list.
    987 STRUCT is the list structure."
    988   (apply #'max
    989 	 (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct)))
    990 
    991 (defun org-list-get-list-begin (item struct prevs)
    992   "Return point at beginning of sub-list ITEM belongs.
    993 STRUCT is the list structure.  PREVS is the alist of previous
    994 items, as returned by `org-list-prevs-alist'."
    995   (let ((first-item item) prev-item)
    996     (while (setq prev-item (org-list-get-prev-item first-item struct prevs))
    997       (setq first-item prev-item))
    998     first-item))
    999 
   1000 (defalias 'org-list-get-first-item 'org-list-get-list-begin)
   1001 
   1002 (defun org-list-get-last-item (item struct prevs)
   1003   "Return point at last item of sub-list ITEM belongs.
   1004 STRUCT is the list structure.  PREVS is the alist of previous
   1005 items, as returned by `org-list-prevs-alist'."
   1006   (let ((last-item item) next-item)
   1007     (while (setq next-item (org-list-get-next-item last-item struct prevs))
   1008       (setq last-item next-item))
   1009     last-item))
   1010 
   1011 (defun org-list-get-list-end (item struct prevs)
   1012   "Return point at end of sub-list ITEM belongs.
   1013 STRUCT is the list structure.  PREVS is the alist of previous
   1014 items, as returned by `org-list-prevs-alist'."
   1015   (org-list-get-item-end (org-list-get-last-item item struct prevs) struct))
   1016 
   1017 (defun org-list-get-list-type (item struct prevs)
   1018   "Return the type of the list containing ITEM, as a symbol.
   1019 
   1020 STRUCT is the list structure.  PREVS is the alist of previous
   1021 items, as returned by `org-list-prevs-alist'.
   1022 
   1023 Possible types are `descriptive', `ordered' and `unordered'.  The
   1024 type is determined by the first item of the list."
   1025   (let ((first (org-list-get-list-begin item struct prevs)))
   1026     (cond
   1027      ((string-match-p "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered)
   1028      ((org-list-get-tag first struct) 'descriptive)
   1029      (t 'unordered))))
   1030 
   1031 (defun org-list-get-item-number (item struct prevs parents)
   1032   "Return ITEM's sequence number.
   1033 
   1034 STRUCT is the list structure.  PREVS is the alist of previous
   1035 items, as returned by `org-list-prevs-alist'.  PARENTS is the
   1036 alist of ancestors, as returned by `org-list-parents-alist'.
   1037 
   1038 Return value is a list of integers.  Counters have an impact on
   1039 that value."
   1040   (let ((get-relative-number
   1041 	 (lambda (item struct prevs)
   1042 	   ;; Return relative sequence number of ITEM in the sub-list
   1043 	   ;; it belongs.  STRUCT is the list structure.  PREVS is
   1044 	   ;; the alist of previous items.
   1045 	   (let ((seq 0) (pos item) counter)
   1046 	     (while (and (not (setq counter (org-list-get-counter pos struct)))
   1047 			 (setq pos (org-list-get-prev-item pos struct prevs)))
   1048 	       (cl-incf seq))
   1049 	     (if (not counter) (1+ seq)
   1050 	       (cond
   1051 		((string-match "[A-Za-z]" counter)
   1052 		 (+ (- (string-to-char (upcase (match-string 0 counter))) 64)
   1053 		    seq))
   1054 		((string-match "[0-9]+" counter)
   1055 		 (+ (string-to-number (match-string 0 counter)) seq))
   1056 		(t (1+ seq))))))))
   1057     ;; Cons each parent relative number into return value (OUT).
   1058     (let ((out (list (funcall get-relative-number item struct prevs)))
   1059 	  (parent item))
   1060       (while (setq parent (org-list-get-parent parent struct parents))
   1061 	(push (funcall get-relative-number parent struct prevs) out))
   1062       ;; Return value.
   1063       out)))
   1064 
   1065 
   1066 
   1067 ;;; Searching
   1068 
   1069 (defun org-list-search-generic (search re bound noerr)
   1070   "Search a string in valid contexts for lists.
   1071 Arguments SEARCH, RE, BOUND and NOERR are similar to those used
   1072 in `re-search-forward'."
   1073   (catch 'exit
   1074     (let ((origin (point)))
   1075       (while t
   1076 	;; 1. No match: return to origin or bound, depending on NOERR.
   1077 	(unless (funcall search re bound noerr)
   1078 	  (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound))
   1079 			    nil)))
   1080 	;; 2. Match in valid context: return point.  Else, continue
   1081 	;;    searching.
   1082 	(when (org-list-in-valid-context-p) (throw 'exit (point)))))))
   1083 
   1084 (defun org-list-search-backward (regexp &optional bound noerror)
   1085   "Like `re-search-backward' but stop only where lists are recognized.
   1086 Arguments REGEXP, BOUND and NOERROR are similar to those used in
   1087 `re-search-backward'."
   1088   (org-list-search-generic #'re-search-backward
   1089 			   regexp (or bound (point-min)) noerror))
   1090 
   1091 (defun org-list-search-forward (regexp &optional bound noerror)
   1092   "Like `re-search-forward' but stop only where lists are recognized.
   1093 Arguments REGEXP, BOUND and NOERROR are similar to those used in
   1094 `re-search-forward'."
   1095   (org-list-search-generic #'re-search-forward
   1096 			   regexp (or bound (point-max)) noerror))
   1097 
   1098 
   1099 
   1100 ;;; Methods on structures
   1101 
   1102 (defsubst org-list-bullet-string (bullet)
   1103   "Return BULLET with the correct number of whitespaces.
   1104 It determines the number of whitespaces to append by looking at
   1105 `org-list-two-spaces-after-bullet-regexp'."
   1106   (save-match-data
   1107     (let ((spaces (if (and org-list-two-spaces-after-bullet-regexp
   1108 			   (string-match
   1109 			    org-list-two-spaces-after-bullet-regexp bullet))
   1110 		      "  "
   1111 		    " ")))
   1112       (if (string-match "\\S-+\\([ \t]*\\)" bullet)
   1113 	  (replace-match spaces nil nil bullet 1)
   1114 	bullet))))
   1115 
   1116 (defun org-list-swap-items (beg-A beg-B struct)
   1117   "Swap item starting at BEG-A with item starting at BEG-B in STRUCT.
   1118 
   1119 Blank lines at the end of items are left in place.  Item
   1120 visibility is preserved.  Return the new structure after the
   1121 changes.
   1122 
   1123 Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong
   1124 to the same sub-list.
   1125 
   1126 This function modifies STRUCT."
   1127   (save-excursion
   1128     (org-fold-core-ignore-modifications
   1129       (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct))
   1130 	     (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct))
   1131 	     (end-A (org-list-get-item-end beg-A struct))
   1132 	     (end-B (org-list-get-item-end beg-B struct))
   1133 	     (size-A (- end-A-no-blank beg-A))
   1134 	     (size-B (- end-B-no-blank beg-B))
   1135 	     (body-A (buffer-substring beg-A end-A-no-blank))
   1136 	     (body-B (buffer-substring beg-B end-B-no-blank))
   1137 	     (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B))
   1138 	     (sub-A (cons beg-A (org-list-get-subtree beg-A struct)))
   1139 	     (sub-B (cons beg-B (org-list-get-subtree beg-B struct)))
   1140 	     ;; Store inner folds responsible for visibility status.
   1141 	     (folds
   1142 	      (cons
   1143                (org-fold-core-get-regions :from beg-A :to end-A :relative t)
   1144                (org-fold-core-get-regions :from beg-B :to end-B :relative t))))
   1145         ;; Clear up the folds.
   1146         (org-fold-region beg-A end-B-no-blank nil)
   1147         ;; 1. Move effectively items in buffer.
   1148         (goto-char beg-A)
   1149         (delete-region beg-A end-B-no-blank)
   1150         (insert (concat body-B between-A-no-blank-and-B body-A))
   1151         ;; Restore visibility status.
   1152         (org-fold-core-regions (cdr folds) :relative beg-A)
   1153         (org-fold-core-regions
   1154          (car folds)
   1155          :relative (+ beg-A size-B (length between-A-no-blank-and-B)))
   1156         ;; 2. Now modify struct.  No need to re-read the list, the
   1157         ;;    transformation is just a shift of positions.  Some special
   1158         ;;    attention is required for items ending at END-A and END-B
   1159         ;;    as empty spaces are not moved there.  In others words,
   1160         ;;    item BEG-A will end with whitespaces that were at the end
   1161         ;;    of BEG-B and the same applies to BEG-B.
   1162         (dolist (e struct)
   1163 	  (let ((pos (car e)))
   1164 	    (cond
   1165 	     ((< pos beg-A))
   1166 	     ((memq pos sub-A)
   1167 	      (let ((end-e (nth 6 e)))
   1168 	        (setcar e (+ pos (- end-B-no-blank end-A-no-blank)))
   1169 	        (setcar (nthcdr 6 e)
   1170 		        (+ end-e (- end-B-no-blank end-A-no-blank)))
   1171 	        (when (= end-e end-A) (setcar (nthcdr 6 e) end-B))))
   1172 	     ((memq pos sub-B)
   1173 	      (let ((end-e (nth 6 e)))
   1174 	        (setcar e (- (+ pos beg-A) beg-B))
   1175 	        (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B)))
   1176 	        (when (= end-e end-B)
   1177 		  (setcar (nthcdr 6 e)
   1178 			  (+ beg-A size-B (- end-A end-A-no-blank))))))
   1179 	     ((< pos beg-B)
   1180 	      (let ((end-e (nth 6 e)))
   1181 	        (setcar e (+ pos (- size-B size-A)))
   1182 	        (setcar (nthcdr 6 e) (+ end-e (- size-B size-A))))))))
   1183         (setq struct (sort struct #'car-less-than-car))
   1184         ;; Return structure.
   1185         struct))))
   1186 
   1187 (defun org-list-separating-blank-lines-number (pos struct prevs)
   1188   "Return number of blank lines that should separate items in list.
   1189 
   1190 POS is the position of point where `org-list-insert-item' was called.
   1191 
   1192 STRUCT is the list structure.  PREVS is the alist of previous
   1193 items, as returned by `org-list-prevs-alist'.
   1194 
   1195 Assume point is at item's beginning.  If the item is alone, apply
   1196 some heuristics to guess the result."
   1197   (save-excursion
   1198     (let ((item (point))
   1199 	  (insert-blank-p
   1200 	   (cdr (assq 'plain-list-item org-blank-before-new-entry)))
   1201 	  usr-blank
   1202 	  (count-blanks
   1203 	   (lambda ()
   1204 	     ;; Count blank lines above beginning of line.
   1205 	     (save-excursion
   1206                (count-lines (goto-char (line-beginning-position))
   1207 			    (progn (skip-chars-backward " \r\t\n")
   1208 				   (forward-line)
   1209 				   (point)))))))
   1210       (cond
   1211        ;; Trivial cases where there should be none.
   1212        ((not insert-blank-p) 0)
   1213        ;; When `org-blank-before-new-entry' says so, it is 1.
   1214        ((eq insert-blank-p t) 1)
   1215        ;; `plain-list-item' is 'auto.  Count blank lines separating
   1216        ;; neighbors' items in list.
   1217        (t (let ((next-p (org-list-get-next-item item struct prevs)))
   1218 	    (cond
   1219 	     ;; Is there a next item?
   1220 	     (next-p (goto-char next-p)
   1221 		     (funcall count-blanks))
   1222 	     ;; Is there a previous item?
   1223 	     ((org-list-get-prev-item item struct prevs)
   1224 	      (funcall count-blanks))
   1225 	     ;; User inserted blank lines, trust him.
   1226 	     ((and (> pos (org-list-get-item-end-before-blank item struct))
   1227 		   (> (save-excursion (goto-char pos)
   1228 				      (setq usr-blank (funcall count-blanks)))
   1229 		      0))
   1230 	      usr-blank)
   1231 	     ;; Are there blank lines inside the list so far?
   1232 	     ((save-excursion
   1233 		(goto-char (org-list-get-top-point struct))
   1234 		;; Do not use `org-list-search-forward' so blank lines
   1235 		;; in blocks can be counted in.
   1236 		(re-search-forward
   1237 		 "^[ \t]*$" (org-list-get-item-end-before-blank item struct) t))
   1238 	      1)
   1239 	     ;; Default choice: no blank line.
   1240 	     (t 0))))))))
   1241 
   1242 (defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet)
   1243   "Insert a new list item at POS and return the new structure.
   1244 If POS is before first character after bullet of the item, the
   1245 new item will be created before the current one.
   1246 
   1247 STRUCT is the list structure.  PREVS is the alist of previous
   1248 items, as returned by `org-list-prevs-alist'.
   1249 
   1250 Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
   1251 after the bullet.  Cursor will be after this text once the
   1252 function ends.
   1253 
   1254 This function modifies STRUCT."
   1255   (let* ((case-fold-search t)
   1256 	 ;; Get information about list: ITEM containing POS, position
   1257 	 ;; of point with regards to item start (BEFOREP), blank lines
   1258 	 ;; number separating items (BLANK-NB), if we're allowed to
   1259 	 ;; (SPLIT-LINE-P).
   1260 	 (item
   1261 	  (catch :exit
   1262 	    (let ((i nil))
   1263 	      (pcase-dolist (`(,start ,_ ,_ ,_ ,_ ,_ ,end) struct)
   1264 		(cond
   1265 		 ((> start pos) (throw :exit i))
   1266 		 ((< end pos) nil)	;skip sub-lists before point
   1267 		 (t (setq i start))))
   1268 	      ;; If no suitable item is found, insert a sibling of the
   1269 	      ;; last item in buffer.
   1270 	      (or i (caar (reverse struct))))))
   1271 	 (item-end (org-list-get-item-end item struct))
   1272 	 (item-end-no-blank (org-list-get-item-end-before-blank item struct))
   1273 	 (beforep
   1274 	  (progn
   1275 	    (goto-char item)
   1276 	    (looking-at org-list-full-item-re)
   1277 	    (<= pos
   1278 		(cond
   1279 		 ((not (match-beginning 4)) (match-end 0))
   1280 		 ;; Ignore tag in a non-descriptive list.
   1281 		 ((save-match-data (string-match "[.)]" (match-string 1)))
   1282 		  (match-beginning 4))
   1283 		 (t (save-excursion
   1284 		      (goto-char (match-end 4))
   1285 		      (skip-chars-forward " \t")
   1286 		      (point)))))))
   1287 	 (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item))
   1288 	 (blank-nb (org-list-separating-blank-lines-number pos struct prevs))
   1289 	 ;; Build the new item to be created.  Concatenate same bullet
   1290 	 ;; as item, checkbox, text AFTER-BULLET if provided, and text
   1291 	 ;; cut from point to end of item (TEXT-CUT) to form item's
   1292 	 ;; BODY.  TEXT-CUT depends on BEFOREP and SPLIT-LINE-P.  The
   1293 	 ;; difference of size between what was cut and what was
   1294 	 ;; inserted in buffer is stored in SIZE-OFFSET.
   1295 	 (ind (org-list-get-ind item struct))
   1296 	 (ind-size (if indent-tabs-mode
   1297 		       (+ (/ ind tab-width) (mod ind tab-width))
   1298 		     ind))
   1299 	 (bullet (org-list-bullet-string (org-list-get-bullet item struct)))
   1300 	 (box (and checkbox "[ ]"))
   1301 	 (text-cut
   1302 	  (and (not beforep)
   1303 	       split-line-p
   1304 	       (progn
   1305 		 (goto-char pos)
   1306 		 ;; If POS is greater than ITEM-END, then point is in
   1307 		 ;; some white lines after the end of the list.  Those
   1308 		 ;; must be removed, or they will be left, stacking up
   1309 		 ;; after the list.
   1310 		 (when (< item-end pos)
   1311                    (delete-region (1- item-end) (line-end-position)))
   1312 		 (skip-chars-backward " \r\t\n")
   1313 		 ;; Cut position is after any blank on the line.
   1314 		 (save-excursion
   1315 		   (skip-chars-forward " \t")
   1316 		   (setq pos (point)))
   1317 		 (delete-and-extract-region (point) item-end-no-blank))))
   1318 	 (body
   1319 	  (concat bullet
   1320 		  (and box (concat box " "))
   1321 		  after-bullet
   1322 		  (and text-cut
   1323 		       (if (string-match "\\`[ \t]+" text-cut)
   1324 			   (replace-match "" t t text-cut)
   1325 			 text-cut))))
   1326 	 (item-sep (make-string  (1+ blank-nb) ?\n))
   1327 	 (item-size (+ ind-size (length body) (length item-sep)))
   1328 	 (size-offset (- item-size (length text-cut))))
   1329     ;; Insert effectively item into buffer.
   1330     (goto-char item)
   1331     (indent-to-column ind)
   1332     (insert body item-sep)
   1333     ;; Add new item to STRUCT.
   1334     (dolist (e struct)
   1335       (let ((p (car e)) (end (nth 6 e)))
   1336 	(cond
   1337 	 ;; Before inserted item, positions don't change but an item
   1338 	 ;; ending after insertion has its end shifted by SIZE-OFFSET.
   1339 	 ((< p item)
   1340 	  (when (> end item)
   1341 	    (setcar (nthcdr 6 e) (+ end size-offset))))
   1342 	 ;; Item where insertion happens may be split in two parts.
   1343 	 ;; In this case, move start by ITEM-SIZE and end by
   1344 	 ;; SIZE-OFFSET.
   1345 	 ((and (= p item) (not beforep) split-line-p)
   1346 	  (setcar e (+ p item-size))
   1347 	  (setcar (nthcdr 6 e) (+ end size-offset)))
   1348 	 ;; Items starting after modified item fall into two
   1349 	 ;; categories.
   1350 	 ;;
   1351 	 ;; If modified item was split, and current sub-item was
   1352 	 ;; located after split point, it was moved to the new item:
   1353 	 ;; the part between body start and split point (POS) was
   1354 	 ;; removed.  So we compute the length of that part and shift
   1355 	 ;; item's positions accordingly.
   1356 	 ;;
   1357 	 ;; Otherwise, the item was simply shifted by SIZE-OFFSET.
   1358 	 ((and split-line-p (not beforep) (>= p pos) (<= p item-end-no-blank))
   1359 	  (let ((offset (- pos item ind (length bullet) (length after-bullet))))
   1360 	    (setcar e (- p offset))
   1361 	    (setcar (nthcdr 6 e) (- end offset))))
   1362 	 (t
   1363 	  (setcar e (+ p size-offset))
   1364 	  (setcar (nthcdr 6 e) (+ end size-offset))))))
   1365     (push (list item ind bullet nil box nil (+ item item-size)) struct)
   1366     (setq struct (sort struct #'car-less-than-car))
   1367     ;; If not BEFOREP, new item must appear after ITEM, so exchange
   1368     ;; ITEM with the next item in list.  Position cursor after bullet,
   1369     ;; counter, checkbox, and label.
   1370     (if beforep
   1371 	(goto-char item)
   1372       (setq struct (org-list-swap-items item (+ item item-size) struct))
   1373       (goto-char (org-list-get-next-item
   1374 		  item struct (org-list-prevs-alist struct))))
   1375     struct))
   1376 
   1377 (defun org-list-delete-item (item struct)
   1378   "Remove ITEM from the list and return the new structure.
   1379 
   1380 STRUCT is the list structure."
   1381   (let* ((end (org-list-get-item-end item struct))
   1382 	 (beg (if (= (org-list-get-bottom-point struct) end)
   1383 		  ;; If ITEM ends with the list, delete blank lines
   1384 		  ;; before it.
   1385 		  (save-excursion
   1386 		    (goto-char item)
   1387 		    (skip-chars-backward " \r\t\n")
   1388                     (min (1+ (line-end-position)) (point-max)))
   1389 		item)))
   1390     ;; Remove item from buffer.
   1391     (delete-region beg end)
   1392     ;; Remove item from structure and shift others items accordingly.
   1393     ;; Don't forget to shift also ending position when appropriate.
   1394     (let ((size (- end beg)))
   1395       (delq nil (mapcar (lambda (e)
   1396 			  (let ((pos (car e)))
   1397 			    (cond
   1398 			     ((< pos item)
   1399 			      (let ((end-e (nth 6 e)))
   1400 				(cond
   1401 				 ((< end-e item) e)
   1402 				 ((= end-e item)
   1403 				  (append (butlast e) (list beg)))
   1404 				 (t
   1405 				  (append (butlast e) (list (- end-e size)))))))
   1406 			     ((< pos end) nil)
   1407 			     (t
   1408 			      (cons (- pos size)
   1409 				    (append (butlast (cdr e))
   1410 					    (list (- (nth 6 e) size))))))))
   1411 			struct)))))
   1412 
   1413 (defun org-list-send-item (item dest struct)
   1414   "Send ITEM to destination DEST.
   1415 
   1416 STRUCT is the list structure.
   1417 
   1418 DEST can have various values.
   1419 
   1420 If DEST is a buffer position, the function will assume it points
   1421 to another item in the same list as ITEM, and will move the
   1422 latter just before the former.
   1423 
   1424 If DEST is `begin' (respectively `end'), ITEM will be moved at
   1425 the beginning (respectively end) of the list it belongs to.
   1426 
   1427 If DEST is a string like \"N\", where N is an integer, ITEM will
   1428 be moved at the Nth position in the list.
   1429 
   1430 If DEST is `kill', ITEM will be deleted and its body will be
   1431 added to the kill-ring.
   1432 
   1433 If DEST is `delete', ITEM will be deleted.
   1434 
   1435 Visibility of item is preserved.
   1436 
   1437 This function returns, destructively, the new list structure."
   1438   (let* ((prevs (org-list-prevs-alist struct))
   1439 	 (item-end (org-list-get-item-end item struct))
   1440 	 ;; Grab full item body minus its bullet.
   1441 	 (body (org-trim
   1442 		(buffer-substring
   1443 		 (save-excursion
   1444 		   (goto-char item)
   1445 		   (looking-at
   1446 		    (concat "[ \t]*"
   1447 			    (regexp-quote (org-list-get-bullet item struct))))
   1448 		   (match-end 0))
   1449 		 item-end)))
   1450 	 ;; Change DEST into a buffer position.  A trick is needed
   1451 	 ;; when ITEM is meant to be sent at the end of the list.
   1452 	 ;; Indeed, by setting locally `org-M-RET-may-split-line' to
   1453 	 ;; nil and insertion point (INS-POINT) to the first line's
   1454 	 ;; end of the last item, we ensure the new item will be
   1455 	 ;; inserted after the last item, and not after any of its
   1456 	 ;; hypothetical sub-items.
   1457 	 (ins-point (cond
   1458 		     ((or (eq dest 'kill) (eq dest 'delete)))
   1459 		     ((eq dest 'begin)
   1460 		      (setq dest (org-list-get-list-begin item struct prevs)))
   1461 		     ((eq dest 'end)
   1462 		      (setq dest (org-list-get-list-end item struct prevs))
   1463 		      (save-excursion
   1464 			(goto-char (org-list-get-last-item item struct prevs))
   1465                         (line-end-position)))
   1466 		     ((and (stringp dest) (string-match-p "\\`[0-9]+\\'" dest))
   1467 		      (let* ((all (org-list-get-all-items item struct prevs))
   1468 			     (len (length all))
   1469 			     (index (mod (string-to-number dest) len)))
   1470 			(if (not (zerop index))
   1471 			    (setq dest (nth (1- index) all))
   1472 			  ;; Send ITEM at the end of the list.
   1473 			  (setq dest (org-list-get-list-end item struct prevs))
   1474 			  (save-excursion
   1475 			    (goto-char
   1476 			     (org-list-get-last-item item struct prevs))
   1477                             (line-end-position)))))
   1478 		     (t dest)))
   1479 	 (org-M-RET-may-split-line nil)
   1480 	 ;; Store inner overlays (to preserve visibility).
   1481 	 (overlays (cl-remove-if (lambda (o) (or (< (overlay-start o) item)
   1482 						 (> (overlay-end o) item)))
   1483 				 (overlays-in item item-end))))
   1484     (cond
   1485      ((eq dest 'delete) (org-list-delete-item item struct))
   1486      ((eq dest 'kill)
   1487       (kill-new body)
   1488       (org-list-delete-item item struct))
   1489      ((and (integerp dest) (/= item ins-point))
   1490       (setq item (copy-marker item))
   1491       (setq struct (org-list-insert-item ins-point struct prevs nil body))
   1492       ;; 1. Structure returned by `org-list-insert-item' may not be
   1493       ;;    accurate, as it cannot see sub-items included in BODY.
   1494       ;;    Thus, first compute the real structure so far.
   1495       (let ((moved-items
   1496 	     (cons (marker-position item)
   1497 		   (org-list-get-subtree (marker-position item) struct)))
   1498 	    (new-end (org-list-get-item-end (point) struct))
   1499 	    (old-end (org-list-get-item-end (marker-position item) struct))
   1500 	    (new-item (point))
   1501 	    (shift (- (point) item)))
   1502 	;; 1.1. Remove the item just created in structure.
   1503 	(setq struct (delete (assq new-item struct) struct))
   1504 	;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM.
   1505 	(setq struct (sort
   1506 		      (append
   1507 		       struct
   1508 		       (mapcar (lambda (e)
   1509 				 (let* ((cell (assq e struct))
   1510 					(pos (car cell))
   1511 					(end (nth 6 cell)))
   1512 				   (cons (+ pos shift)
   1513 					 (append (butlast (cdr cell))
   1514 						 (list (if (= end old-end)
   1515 							   new-end
   1516 							 (+ end shift)))))))
   1517 			       moved-items))
   1518 		      #'car-less-than-car)))
   1519       ;; 2. Restore inner overlays.
   1520       (dolist (o overlays)
   1521 	(move-overlay o
   1522 		      (+ (overlay-start o) (- (point) item))
   1523 		      (+ (overlay-end o) (- (point) item))))
   1524       ;; 3. Eventually delete extra copy of the item and clean marker.
   1525       (prog1 (org-list-delete-item (marker-position item) struct)
   1526 	(move-marker item nil)))
   1527      (t struct))))
   1528 
   1529 (defun org-list-struct-outdent (start end struct parents)
   1530   "Outdent items between positions START and END.
   1531 
   1532 STRUCT is the list structure.  PARENTS is the alist of items'
   1533 parents, as returned by `org-list-parents-alist'.
   1534 
   1535 START is included, END excluded."
   1536   (let* (acc
   1537 	 (out (lambda (cell)
   1538 		(let* ((item (car cell))
   1539 		       (parent (cdr cell)))
   1540 		  (cond
   1541 		   ;; Item not yet in zone: keep association.
   1542 		   ((< item start) cell)
   1543 		   ;; Item out of zone: follow associations in ACC.
   1544 		   ((>= item end)
   1545 		    (let ((convert (and parent (assq parent acc))))
   1546 		      (if convert (cons item (cdr convert)) cell)))
   1547 		   ;; Item has no parent: error
   1548 		   ((not parent)
   1549 		    (error "Cannot outdent top-level items"))
   1550 		   ;; Parent is outdented: keep association.
   1551 		   ((>= parent start)
   1552 		    (push (cons parent item) acc) cell)
   1553 		   (t
   1554 		    ;; Parent isn't outdented: reparent to grand-parent.
   1555 		    (let ((grand-parent (org-list-get-parent
   1556 					 parent struct parents)))
   1557 		      (push (cons parent item) acc)
   1558 		      (cons item grand-parent))))))))
   1559     (mapcar out parents)))
   1560 
   1561 (defun org-list-struct-indent (start end struct parents prevs)
   1562   "Indent items between positions START and END.
   1563 
   1564 STRUCT is the list structure.  PARENTS is the alist of parents
   1565 and PREVS is the alist of previous items, returned by,
   1566 respectively, `org-list-parents-alist' and
   1567 `org-list-prevs-alist'.
   1568 
   1569 START is included and END excluded.
   1570 
   1571 STRUCT may be modified if `org-list-demote-modify-bullet' matches
   1572 bullets between START and END."
   1573   (let* (acc
   1574 	 (set-assoc (lambda (cell) (push cell acc) cell))
   1575 	 (ind
   1576 	  (lambda (cell)
   1577 	    (let* ((item (car cell))
   1578 		   (parent (cdr cell)))
   1579 	      (cond
   1580 	       ;; Item not yet in zone: keep association.
   1581 	       ((< item start) cell)
   1582 	       ((>= item end)
   1583 		;; Item out of zone: follow associations in ACC.
   1584 		(let ((convert (assq parent acc)))
   1585 		  (if convert (cons item (cdr convert)) cell)))
   1586 	       (t
   1587 		;; Item is in zone...
   1588 		(let ((prev (org-list-get-prev-item item struct prevs)))
   1589 		  ;; Check if bullet needs to be changed.
   1590 		  (pcase (assoc (let ((b (org-list-get-bullet item struct))
   1591 				      (case-fold-search nil))
   1592 				  (cond ((string-match "[A-Z]\\." b) "A.")
   1593 					((string-match "[A-Z])" b) "A)")
   1594 					((string-match "[a-z]\\." b) "a.")
   1595 					((string-match "[a-z])" b) "a)")
   1596 					((string-match "[0-9]\\." b) "1.")
   1597 					((string-match "[0-9])" b) "1)")
   1598 					(t (org-trim b))))
   1599 				org-list-demote-modify-bullet)
   1600 		    (`(,_ . ,bullet)
   1601 		     (org-list-set-bullet
   1602 		      item struct (org-list-bullet-string bullet)))
   1603 		    (_ nil))
   1604 		  (cond
   1605 		   ;; First item indented but not parent: error
   1606 		   ((and (not prev) (or (not parent) (< parent start)))
   1607 		    (user-error "Cannot indent the first item of a list"))
   1608 		   ;; First item and parent indented: keep same
   1609 		   ;; parent.
   1610 		   ((not prev) (funcall set-assoc cell))
   1611 		   ;; Previous item not indented: reparent to it.
   1612 		   ((< prev start) (funcall set-assoc (cons item prev)))
   1613 		   ;; Previous item indented: reparent like it.
   1614 		   (t
   1615 		    (funcall set-assoc
   1616 			     (cons item (cdr (assq prev acc)))))))))))))
   1617     (mapcar ind parents)))
   1618 
   1619 
   1620 
   1621 ;;; Repairing structures
   1622 
   1623 (defun org-list-use-alpha-bul-p (first struct prevs)
   1624   "Non-nil if list starting at FIRST can have alphabetical bullets.
   1625 
   1626 STRUCT is list structure.  PREVS is the alist of previous items,
   1627 as returned by `org-list-prevs-alist'."
   1628   (and org-list-allow-alphabetical
   1629        (catch 'exit
   1630 	 (let ((item first) (ascii 64) (case-fold-search nil))
   1631 	   ;; Pretend that bullets are uppercase and check if alphabet
   1632 	   ;; is sufficient, taking counters into account.
   1633 	   (while item
   1634 	     (let ((count (org-list-get-counter item struct)))
   1635 	       ;; Virtually determine current bullet
   1636 	       (if (and count (string-match-p "[a-zA-Z]" count))
   1637 		   ;; Counters are not case-sensitive.
   1638 		   (setq ascii (string-to-char (upcase count)))
   1639 		 (setq ascii (1+ ascii)))
   1640 	       ;; Test if bullet would be over z or Z.
   1641 	       (if (> ascii 90)
   1642 		   (throw 'exit nil)
   1643 		 (setq item (org-list-get-next-item item struct prevs)))))
   1644 	   ;; All items checked.  All good.
   1645 	   t))))
   1646 
   1647 (defun org-list-inc-bullet-maybe (bullet)
   1648   "Increment BULLET if applicable."
   1649   (let ((case-fold-search nil))
   1650     (cond
   1651      ;; Num bullet: increment it.
   1652      ((string-match "[0-9]+" bullet)
   1653       (replace-match
   1654        (number-to-string (1+ (string-to-number (match-string 0 bullet))))
   1655        nil nil bullet))
   1656      ;; Alpha bullet: increment it.
   1657      ((string-match "[A-Za-z]" bullet)
   1658       (replace-match
   1659        (char-to-string (1+ (string-to-char (match-string 0 bullet))))
   1660        nil nil bullet))
   1661      ;; Unordered bullet: leave it.
   1662      (t bullet))))
   1663 
   1664 (defun org-list-struct-fix-bul (struct prevs)
   1665   "Verify and correct bullets in STRUCT.
   1666 PREVS is the alist of previous items, as returned by
   1667 `org-list-prevs-alist'.
   1668 
   1669 This function modifies STRUCT."
   1670   (let ((case-fold-search nil)
   1671 	(fix-bul
   1672 	 ;; Set bullet of ITEM in STRUCT, depending on the type of
   1673 	 ;; first item of the list, the previous bullet and counter
   1674 	 ;; if any.
   1675 	 (lambda (item)
   1676 	   (let* ((prev (org-list-get-prev-item item struct prevs))
   1677 		  (prev-bul (and prev (org-list-get-bullet prev struct)))
   1678 		  (counter (org-list-get-counter item struct))
   1679 		  (bullet (org-list-get-bullet item struct))
   1680 		  (alphap (and (not prev)
   1681 			       (org-list-use-alpha-bul-p item struct prevs))))
   1682 	     (org-list-set-bullet
   1683 	      item struct
   1684 	      (org-list-bullet-string
   1685 	       (cond
   1686 		;; Alpha counter in alpha list: use counter.
   1687 		((and prev counter
   1688 		      (string-match "[a-zA-Z]" counter)
   1689 		      (string-match "[a-zA-Z]" prev-bul))
   1690 		 ;; Use cond to be sure `string-match' is used in
   1691 		 ;; both cases.
   1692 		 (let ((real-count
   1693 			(cond
   1694 			 ((string-match "[a-z]" prev-bul) (downcase counter))
   1695 			 ((string-match "[A-Z]" prev-bul) (upcase counter)))))
   1696 		   (replace-match real-count nil nil prev-bul)))
   1697 		;; Num counter in a num list: use counter.
   1698 		((and prev counter
   1699 		      (string-match "[0-9]+" counter)
   1700 		      (string-match "[0-9]+" prev-bul))
   1701 		 (replace-match counter nil nil prev-bul))
   1702 		;; No counter: increase, if needed, previous bullet.
   1703 		(prev
   1704 		 (org-list-inc-bullet-maybe (org-list-get-bullet prev struct)))
   1705 		;; Alpha counter at first item: use counter.
   1706 		((and counter (org-list-use-alpha-bul-p item struct prevs)
   1707 		      (string-match "[A-Za-z]" counter)
   1708 		      (string-match "[A-Za-z]" bullet))
   1709 		 (let ((real-count
   1710 			(cond
   1711 			 ((string-match "[a-z]" bullet) (downcase counter))
   1712 			 ((string-match "[A-Z]" bullet) (upcase counter)))))
   1713 		   (replace-match real-count nil nil bullet)))
   1714 		;; Num counter at first item: use counter.
   1715 		((and counter
   1716 		      (string-match "[0-9]+" counter)
   1717 		      (string-match "[0-9]+" bullet))
   1718 		 (replace-match counter nil nil bullet))
   1719 		;; First bullet is alpha uppercase: use "A".
   1720 		((and alphap (string-match "[A-Z]" bullet))
   1721 		 (replace-match "A" nil nil bullet))
   1722 		;; First bullet is alpha lowercase: use "a".
   1723 		((and alphap (string-match "[a-z]" bullet))
   1724 		 (replace-match "a" nil nil bullet))
   1725 		;; First bullet is num: use "1".
   1726 		((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet)
   1727 		 (replace-match "1" nil nil bullet))
   1728 		;; Not an ordered list: keep bullet.
   1729 		(t bullet))))))))
   1730     (mapc fix-bul (mapcar #'car struct))))
   1731 
   1732 (defun org-list-struct-fix-ind (struct parents &optional bullet-size)
   1733   "Verify and correct indentation in STRUCT.
   1734 
   1735 PARENTS is the alist of parents, as returned by
   1736 `org-list-parents-alist'.
   1737 
   1738 If numeric optional argument BULLET-SIZE is set, assume all
   1739 bullets in list have this length to determine new indentation.
   1740 
   1741 This function modifies STRUCT."
   1742   (let* ((ancestor (org-list-get-top-point struct))
   1743          (top-ind (org-list-get-ind ancestor struct))
   1744          (new-ind
   1745           (lambda (item)
   1746             (let ((parent (org-list-get-parent item struct parents)))
   1747               (if parent
   1748                   ;; Indent like parent + length of parent's bullet +
   1749 		  ;; sub-list offset.
   1750                   (org-list-set-ind
   1751 		   item struct (+ (or bullet-size
   1752 				      (length
   1753 				       (org-list-get-bullet parent struct)))
   1754 				  (org-list-get-ind parent struct)
   1755 				  org-list-indent-offset))
   1756                 ;; If no parent, indent like top-point.
   1757 		(org-list-set-ind item struct top-ind))))))
   1758     (mapc new-ind (mapcar #'car (cdr struct)))))
   1759 
   1760 (defun org-list-struct-fix-box (struct parents prevs &optional ordered)
   1761   "Verify and correct checkboxes in STRUCT.
   1762 
   1763 PARENTS is the alist of parents and PREVS is the alist of
   1764 previous items, as returned by, respectively,
   1765 `org-list-parents-alist' and `org-list-prevs-alist'.
   1766 
   1767 If ORDERED is non-nil, a checkbox can only be checked when every
   1768 checkbox before it is checked too.  If there was an attempt to
   1769 break this rule, the function will return the blocking item.  In
   1770 all others cases, the return value will be nil.
   1771 
   1772 This function modifies STRUCT."
   1773   (let ((all-items (mapcar #'car struct))
   1774 	(set-parent-box
   1775 	 (lambda (item)
   1776 	   (let* ((box-list
   1777 		   (mapcar (lambda (child)
   1778 			     (org-list-get-checkbox child struct))
   1779 			   (org-list-get-children item struct parents))))
   1780 	     (org-list-set-checkbox
   1781 	      item struct
   1782 	      (cond
   1783 	       ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]")
   1784 	       ((member "[-]" box-list) "[-]")
   1785 	       ((member "[X]" box-list) "[X]")
   1786 	       ((member "[ ]" box-list) "[ ]")
   1787 	       ;; Parent has no boxed child: leave box as-is.
   1788 	       (t (org-list-get-checkbox item struct)))))))
   1789 	parent-list)
   1790     ;; 1. List all parents with a checkbox.
   1791     (mapc
   1792      (lambda (e)
   1793        (let* ((parent (org-list-get-parent e struct parents))
   1794 	      (parent-box-p (org-list-get-checkbox parent struct)))
   1795 	 (when (and parent-box-p (not (memq parent parent-list)))
   1796 	   (push parent parent-list))))
   1797      all-items)
   1798     ;; 2. Sort those parents by decreasing indentation.
   1799     (setq parent-list (sort parent-list
   1800 			    (lambda (e1 e2)
   1801 			      (> (org-list-get-ind e1 struct)
   1802 				 (org-list-get-ind e2 struct)))))
   1803     ;; 3. For each parent, get all children's checkboxes to determine
   1804     ;;    and set its checkbox accordingly.
   1805     (mapc set-parent-box parent-list)
   1806     ;; 4. If ORDERED is set, see if we need to uncheck some boxes.
   1807     (when ordered
   1808       (let* ((box-list
   1809 	      (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items))
   1810 	     (after-unchecked (member "[ ]" box-list)))
   1811 	;; There are boxes checked after an unchecked one: fix that.
   1812 	(when (member "[X]" after-unchecked)
   1813 	  (let ((index (- (length struct) (length after-unchecked))))
   1814 	    (dolist (e (nthcdr index all-items))
   1815 	      (when (org-list-get-checkbox e struct)
   1816 		(org-list-set-checkbox e struct "[ ]")))
   1817 	    ;; Verify once again the structure, without ORDERED.
   1818 	    (org-list-struct-fix-box struct parents prevs nil)
   1819 	    ;; Return blocking item.
   1820 	    (nth index all-items)))))))
   1821 
   1822 (defun org-list-struct-fix-item-end (struct)
   1823   "Verify and correct each item end position in STRUCT.
   1824 
   1825 This function modifies STRUCT."
   1826   (let (end-list acc-end)
   1827     (pcase-dolist (`(,pos . ,_) struct)
   1828       (let ((ind-pos (org-list-get-ind pos struct))
   1829 	    (end-pos (org-list-get-item-end pos struct)))
   1830 	(unless (assq end-pos struct)
   1831 	  ;; To determine real ind of an ending position that is not
   1832 	  ;; at an item, we have to find the item it belongs to: it is
   1833 	  ;; the last item (ITEM-UP), whose ending is further than the
   1834 	  ;; position we're interested in.
   1835 	  (let ((item-up (assoc-default end-pos acc-end #'>)))
   1836 	    (push (cons
   1837 		   ;; Else part is for the bottom point.
   1838 		   (if item-up (+ (org-list-get-ind item-up struct) 2) 0)
   1839 		   end-pos)
   1840 		  end-list)))
   1841 	(push (cons ind-pos pos) end-list)
   1842 	(push (cons end-pos pos) acc-end)))
   1843     (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
   1844     (org-list-struct-assoc-end struct end-list)))
   1845 
   1846 (defun org-list-struct-apply-struct (struct old-struct)
   1847   "Apply set difference between STRUCT and OLD-STRUCT to the buffer.
   1848 
   1849 OLD-STRUCT is the structure before any modifications, and STRUCT
   1850 the structure to be applied.  The function will only modify parts
   1851 of the list which have changed.
   1852 
   1853 Initial position of cursor is restored after the changes."
   1854   (let* ((origin (point-marker))
   1855 	 (inlinetask-re (and (featurep 'org-inlinetask)
   1856 			     (org-inlinetask-outline-regexp)))
   1857 	 (item-re (org-item-re))
   1858 	 (shift-body-ind
   1859 	  ;; Shift the indentation between END and BEG by DELTA.
   1860 	  ;; Start from the line before END.
   1861 	  (lambda (end beg delta)
   1862 	    (goto-char end)
   1863 	    (skip-chars-backward " \r\t\n")
   1864 	    (forward-line 0)
   1865 	    (while (or (> (point) beg)
   1866 		       (and (= (point) beg)
   1867 			    (not (looking-at item-re))))
   1868 	      (cond
   1869 	       ;; Skip inline tasks.
   1870 	       ((and inlinetask-re (looking-at inlinetask-re))
   1871 		(org-inlinetask-goto-beginning))
   1872 	       ;; Shift only non-empty lines.
   1873 	       ((looking-at-p "^[ \t]*\\S-")
   1874 		(indent-line-to (+ (org-current-text-indentation) delta))))
   1875 	      (forward-line -1))))
   1876 	 (modify-item
   1877 	  ;; Replace ITEM first line elements with new elements from
   1878 	  ;; STRUCT, if appropriate.
   1879 	  (lambda (item)
   1880 	    (goto-char item)
   1881 	    (let* ((new-ind (org-list-get-ind item struct))
   1882 		   (old-ind (org-current-text-indentation))
   1883 		   (new-bul (org-list-bullet-string
   1884 			     (org-list-get-bullet item struct)))
   1885 		   (old-bul (org-list-get-bullet item old-struct))
   1886 		   (new-box (org-list-get-checkbox item struct)))
   1887 	      (looking-at org-list-full-item-re)
   1888 	      ;; a.  Replace bullet
   1889 	      (unless (equal old-bul new-bul)
   1890                 (let ((keep-space ""))
   1891                   (save-excursion
   1892                     ;; If origin is inside the bullet, preserve the
   1893                     ;; spaces after origin.
   1894                     (when (<= (match-beginning 1) origin (match-end 1))
   1895                       (org-with-point-at origin
   1896                         (save-match-data
   1897                           (when (looking-at "[ \t]+")
   1898                             (setq keep-space (match-string 0))))))
   1899                     (replace-match "" nil nil nil 1)
   1900                     (goto-char (match-end 1))
   1901                     (insert-before-markers new-bul)
   1902                     (insert keep-space))))
   1903               ;; Refresh potentially shifted match markers.
   1904               (goto-char item)
   1905               (looking-at org-list-full-item-re)
   1906 	      ;; b.  Replace checkbox.
   1907 	      (cond
   1908 	       ((equal (match-string 3) new-box))
   1909 	       ((and (match-string 3) new-box)
   1910 		(replace-match new-box nil nil nil 3))
   1911 	       ((match-string 3)
   1912 		(looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)")
   1913 		(replace-match "" nil nil nil 1))
   1914 	       (t (let ((counterp (match-end 2)))
   1915 		    (goto-char (if counterp (1+ counterp) (match-end 1)))
   1916 		    (insert (concat new-box (unless counterp " "))))))
   1917 	      ;; c.  Indent item to appropriate column.
   1918 	      (unless (= new-ind old-ind)
   1919                 (delete-region (goto-char (line-beginning-position))
   1920 			       (progn (skip-chars-forward " \t") (point)))
   1921 		(indent-to new-ind))))))
   1922     ;; 1. First get list of items and position endings.  We maintain
   1923     ;;    two alists: ITM-SHIFT, determining indentation shift needed
   1924     ;;    at item, and END-LIST, a pseudo-alist where key is ending
   1925     ;;    position and value point.
   1926     (let (end-list acc-end itm-shift all-ends sliced-struct)
   1927       (dolist (e old-struct)
   1928 	(let* ((pos (car e))
   1929 	       (ind-pos (org-list-get-ind pos struct))
   1930 	       (ind-old (org-list-get-ind pos old-struct))
   1931 	       (bul-pos (org-list-get-bullet pos struct))
   1932 	       (bul-old (org-list-get-bullet pos old-struct))
   1933 	       (ind-shift (- (+ ind-pos (length bul-pos))
   1934 			     (+ ind-old (length bul-old))))
   1935 	       (end-pos (org-list-get-item-end pos old-struct)))
   1936 	  (push (cons pos ind-shift) itm-shift)
   1937 	  (unless (assq end-pos old-struct)
   1938 	    ;; To determine real ind of an ending position that
   1939 	    ;; is not at an item, we have to find the item it
   1940 	    ;; belongs to: it is the last item (ITEM-UP), whose
   1941 	    ;; ending is further than the position we're
   1942 	    ;; interested in.
   1943 	    (let ((item-up (assoc-default end-pos acc-end #'>)))
   1944 	      (push (cons end-pos item-up) end-list)))
   1945 	  (push (cons end-pos pos) acc-end)))
   1946       ;; 2. Slice the items into parts that should be shifted by the
   1947       ;;    same amount of indentation.  Each slice follow the pattern
   1948       ;;    (END BEG DELTA).  Slices are returned in reverse order.
   1949       (setq all-ends (sort (append (mapcar #'car itm-shift)
   1950 				   (org-uniquify (mapcar #'car end-list)))
   1951 			   #'<)
   1952 	    acc-end (nreverse acc-end))
   1953       (while (cdr all-ends)
   1954 	(let* ((up (pop all-ends))
   1955 	       (down (car all-ends))
   1956 	       (itemp (assq up struct))
   1957 	       (delta
   1958 		(if itemp (cdr (assq up itm-shift))
   1959 		  ;; If we're not at an item, there's a child of the
   1960 		  ;; item point belongs to above.  Make sure the less
   1961 		  ;; indented line in this slice has the same column
   1962 		  ;; as that child.
   1963 		  (let* ((child (cdr (assq up acc-end)))
   1964 			 (ind (org-list-get-ind child struct))
   1965 			 (min-ind most-positive-fixnum))
   1966 		    (save-excursion
   1967 		      (goto-char up)
   1968 		      (while (< (point) down)
   1969 			;; Ignore empty lines.  Also ignore blocks and
   1970 			;; drawers contents.
   1971 			(unless (looking-at-p "[ \t]*$")
   1972 			  (setq min-ind (min (org-current-text-indentation) min-ind))
   1973 			  (cond
   1974 			   ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)")
   1975 				 (re-search-forward
   1976 				  (format "^[ \t]*#\\+END%s[ \t]*$"
   1977 					  (match-string 1))
   1978 				  down t)))
   1979 			   ((and (looking-at org-drawer-regexp)
   1980 				 (re-search-forward "^[ \t]*:END:[ \t]*$"
   1981 						    down t)))))
   1982 			(forward-line)))
   1983 		    (- ind min-ind)))))
   1984 	  (push (list down up delta) sliced-struct)))
   1985       ;; 3. Shift each slice in buffer, provided delta isn't 0, from
   1986       ;;    end to beginning.  Take a special action when beginning is
   1987       ;;    at item bullet.
   1988       (dolist (e sliced-struct)
   1989 	(unless (zerop (nth 2 e)) (apply shift-body-ind e))
   1990 	(let* ((beg (nth 1 e))
   1991 	       (cell (assq beg struct)))
   1992 	  (unless (or (not cell) (equal cell (assq beg old-struct)))
   1993 	    (funcall modify-item beg)))))
   1994     ;; 4. Go back to initial position and clean marker.
   1995     (goto-char origin)
   1996     (move-marker origin nil)))
   1997 
   1998 (defun org-list-write-struct (struct parents &optional old-struct)
   1999   "Correct bullets, checkboxes and indentation in list at point.
   2000 
   2001 STRUCT is the list structure.  PARENTS is the alist of parents,
   2002 as returned by `org-list-parents-alist'.
   2003 
   2004 When non-nil, optional argument OLD-STRUCT is the reference
   2005 structure of the list.  It should be provided whenever STRUCT
   2006 doesn't correspond anymore to the real list in buffer."
   2007   ;; Order of functions matters here: checkboxes and endings need
   2008   ;; correct indentation to be set, and indentation needs correct
   2009   ;; bullets.
   2010   ;;
   2011   ;; 0. Save a copy of structure before modifications
   2012   (let ((old-struct (or old-struct (copy-tree struct))))
   2013     ;; 1. Set a temporary, but coherent with PARENTS, indentation in
   2014     ;;    order to get items endings and bullets properly
   2015     (org-list-struct-fix-ind struct parents 2)
   2016     ;; 2. Fix each item end to get correct prevs alist.
   2017     (org-list-struct-fix-item-end struct)
   2018     ;; 3. Get bullets right.
   2019     (let ((prevs (org-list-prevs-alist struct)))
   2020       (org-list-struct-fix-bul struct prevs)
   2021       ;; 4. Now get real indentation.
   2022       (org-list-struct-fix-ind struct parents)
   2023       ;; 5. Eventually fix checkboxes.
   2024       (org-list-struct-fix-box struct parents prevs))
   2025     ;; 6. Apply structure modifications to buffer.
   2026     (org-list-struct-apply-struct struct old-struct))
   2027   ;; 7. Return the updated structure
   2028   struct)
   2029 
   2030 
   2031 
   2032 ;;; Misc Tools
   2033 
   2034 (defun org-apply-on-list (function init-value &rest args)
   2035   "Call FUNCTION on each item of the list at point.
   2036 FUNCTION must be called with at least one argument: INIT-VALUE,
   2037 that will contain the value returned by the function at the
   2038 previous item, plus ARGS extra arguments.
   2039 
   2040 FUNCTION is applied on items in reverse order.
   2041 
   2042 As an example, \(org-apply-on-list \(lambda \(result) \(1+ result)) 0)
   2043 will return the number of items in the current list.
   2044 
   2045 Sublists of the list are skipped.  Cursor is always at the
   2046 beginning of the item."
   2047   (let* ((struct (org-list-struct))
   2048 	 (prevs (org-list-prevs-alist struct))
   2049          (item (copy-marker (line-beginning-position)))
   2050 	 (all (org-list-get-all-items (marker-position item) struct prevs))
   2051 	 (value init-value))
   2052     (dolist (e (nreverse all))
   2053       (goto-char e)
   2054       (setq value (apply function value args)))
   2055     (goto-char item)
   2056     (move-marker item nil)
   2057     value))
   2058 
   2059 (defun org-list-set-item-visibility (item struct view)
   2060   "Set visibility of ITEM in STRUCT to VIEW.
   2061 
   2062 Possible values are: `folded', `children' or `subtree'.  See
   2063 `org-cycle' for more information."
   2064   (cond
   2065    ((eq view 'folded)
   2066     (let ((item-end (org-list-get-item-end-before-blank item struct)))
   2067       ;; Hide from eol
   2068       (org-fold-region (save-excursion (goto-char item) (line-end-position))
   2069 		       item-end t 'outline)))
   2070    ((eq view 'children)
   2071     ;; First show everything.
   2072     (org-list-set-item-visibility item struct 'subtree)
   2073     ;; Then fold every child.
   2074     (let* ((parents (org-list-parents-alist struct))
   2075 	   (children (org-list-get-children item struct parents)))
   2076       (dolist (child children)
   2077 	(org-list-set-item-visibility child struct 'folded))))
   2078    ((eq view 'subtree)
   2079     ;; Show everything
   2080     (let ((item-end (org-list-get-item-end item struct)))
   2081       (org-fold-region item item-end nil 'outline)))))
   2082 
   2083 (defun org-list-item-body-column (item)
   2084   "Return column at which body of ITEM should start."
   2085   (save-excursion
   2086     (goto-char item)
   2087     (looking-at "[ \t]*\\(\\S-+\\)")
   2088     (+ (progn (goto-char (match-end 1)) (current-column))
   2089        (if (and org-list-two-spaces-after-bullet-regexp
   2090 		(string-match-p org-list-two-spaces-after-bullet-regexp
   2091 				(match-string 1)))
   2092 	   2
   2093 	 1))))
   2094 
   2095 
   2096 
   2097 ;;; Interactive functions
   2098 
   2099 (defalias 'org-list-get-item-begin 'org-in-item-p)
   2100 
   2101 (defun org-beginning-of-item ()
   2102   "Go to the beginning of the current item.
   2103 Throw an error when not in a list."
   2104   (interactive)
   2105   (let ((begin (org-in-item-p)))
   2106     (if begin (goto-char begin) (error "Not in an item"))))
   2107 
   2108 (defun org-beginning-of-item-list ()
   2109   "Go to the beginning item of the current list or sublist.
   2110 Throw an error when not in a list."
   2111   (interactive)
   2112   (let ((begin (org-in-item-p)))
   2113     (if (not begin)
   2114 	(error "Not in an item")
   2115       (goto-char begin)
   2116       (let* ((struct (org-list-struct))
   2117 	     (prevs (org-list-prevs-alist struct)))
   2118 	(goto-char (org-list-get-list-begin begin struct prevs))))))
   2119 
   2120 (defun org-end-of-item-list ()
   2121   "Go to the end of the current list or sublist.
   2122 Throw an error when not in a list."
   2123   (interactive)
   2124   (let ((begin (org-in-item-p)))
   2125     (if (not begin)
   2126 	(error "Not in an item")
   2127       (goto-char begin)
   2128       (let* ((struct (org-list-struct))
   2129 	     (prevs (org-list-prevs-alist struct)))
   2130 	(goto-char (org-list-get-list-end begin struct prevs))))))
   2131 
   2132 (defun org-end-of-item ()
   2133   "Go to the end of the current item.
   2134 Throw an error when not in a list."
   2135   (interactive)
   2136   (let ((begin (org-in-item-p)))
   2137     (if (not begin)
   2138 	(error "Not in an item")
   2139       (goto-char begin)
   2140       (let ((struct (org-list-struct)))
   2141 	(goto-char (org-list-get-item-end begin struct))))))
   2142 
   2143 (defun org-previous-item ()
   2144   "Move to the beginning of the previous item.
   2145 Throw an error when not in a list.  Also throw an error when at
   2146 first item, unless `org-list-use-circular-motion' is non-nil."
   2147   (interactive)
   2148   (let ((item (org-in-item-p)))
   2149     (if (not item)
   2150 	(error "Not in an item")
   2151       (goto-char item)
   2152       (let* ((struct (org-list-struct))
   2153 	     (prevs (org-list-prevs-alist struct))
   2154 	     (prevp (org-list-get-prev-item item struct prevs)))
   2155 	(cond
   2156 	 (prevp (goto-char prevp))
   2157 	 (org-list-use-circular-motion
   2158 	  (goto-char (org-list-get-last-item item struct prevs)))
   2159 	 (t (error "On first item")))))))
   2160 
   2161 (defun org-next-item ()
   2162   "Move to the beginning of the next item.
   2163 Throw an error when not in a list.  Also throw an error when at
   2164 last item, unless `org-list-use-circular-motion' is non-nil."
   2165   (interactive)
   2166   (let ((item (org-in-item-p)))
   2167     (if (not item)
   2168 	(error "Not in an item")
   2169       (goto-char item)
   2170       (let* ((struct (org-list-struct))
   2171 	     (prevs (org-list-prevs-alist struct))
   2172 	     (prevp (org-list-get-next-item item struct prevs)))
   2173 	(cond
   2174 	 (prevp (goto-char prevp))
   2175 	 (org-list-use-circular-motion
   2176 	  (goto-char (org-list-get-first-item item struct prevs)))
   2177 	 (t (error "On last item")))))))
   2178 
   2179 (defun org-move-item-down ()
   2180   "Move the item at point down, i.e. swap with following item.
   2181 Sub-items (items with larger indentation) are considered part of
   2182 the item, so this really moves item trees."
   2183   (interactive)
   2184   (unless (org-at-item-p) (error "Not at an item"))
   2185   (let* ((col (current-column))
   2186          (item (line-beginning-position))
   2187 	 (struct (org-list-struct))
   2188 	 (prevs (org-list-prevs-alist struct))
   2189          (next-item (org-list-get-next-item (line-beginning-position) struct prevs)))
   2190     (unless (or next-item org-list-use-circular-motion)
   2191       (user-error "Cannot move this item further down"))
   2192     (if (not next-item)
   2193 	(setq struct (org-list-send-item item 'begin struct))
   2194       (setq struct (org-list-swap-items item next-item struct))
   2195       (goto-char
   2196        (org-list-get-next-item item struct (org-list-prevs-alist struct))))
   2197     (org-list-write-struct struct (org-list-parents-alist struct))
   2198     (org-move-to-column col)))
   2199 
   2200 (defun org-move-item-up ()
   2201   "Move the item at point up, i.e. swap with previous item.
   2202 Sub-items (items with larger indentation) are considered part of
   2203 the item, so this really moves item trees."
   2204   (interactive)
   2205   (unless (org-at-item-p) (error "Not at an item"))
   2206   (let* ((col (current-column))
   2207          (item (line-beginning-position))
   2208 	 (struct (org-list-struct))
   2209 	 (prevs (org-list-prevs-alist struct))
   2210          (prev-item (org-list-get-prev-item (line-beginning-position) struct prevs)))
   2211     (unless (or prev-item org-list-use-circular-motion)
   2212       (user-error "Cannot move this item further up"))
   2213     (if (not prev-item)
   2214 	(setq struct (org-list-send-item item 'end struct))
   2215       (setq struct (org-list-swap-items prev-item item struct)))
   2216     (org-list-write-struct struct (org-list-parents-alist struct))
   2217     (org-move-to-column col)))
   2218 
   2219 (defun org-insert-item (&optional checkbox)
   2220   "Insert a new item at the current level.
   2221 If cursor is before first character after bullet of the item, the
   2222 new item will be created before the current one.
   2223 
   2224 If CHECKBOX is non-nil, add a checkbox next to the bullet.
   2225 
   2226 Return t when things worked, nil when we are not in an item, or
   2227 item is invisible."
   2228   (interactive "P")
   2229   (let ((itemp (org-in-item-p))
   2230 	(pos (point)))
   2231     ;; If cursor isn't is a list or if list is invisible, return nil.
   2232     (unless (or (not itemp)
   2233 		(save-excursion
   2234 		  (goto-char itemp)
   2235 		  (org-invisible-p)))
   2236       (if (save-excursion
   2237 	    (goto-char itemp)
   2238 	    (org-at-item-timer-p))
   2239 	  ;; Timer list: delegate to `org-timer-item'.
   2240 	  (progn (org-timer-item) t)
   2241 	(let* ((struct (save-excursion (goto-char itemp)
   2242 				       (org-list-struct)))
   2243 	       (prevs (org-list-prevs-alist struct))
   2244 	       ;; If we're in a description list, ask for the new term.
   2245 	       (desc (when (eq (org-list-get-list-type itemp struct prevs)
   2246 			       'descriptive)
   2247 		       " :: ")))
   2248 	  (setq struct (org-list-insert-item pos struct prevs checkbox desc))
   2249 	  (org-list-write-struct struct (org-list-parents-alist struct))
   2250 	  (when checkbox (org-update-checkbox-count-maybe))
   2251           (forward-line 0)
   2252 	  (looking-at org-list-full-item-re)
   2253 	  (goto-char (if (and (match-beginning 4)
   2254 			      (save-match-data
   2255 				(string-match "[.)]" (match-string 1))))
   2256 			 (match-beginning 4)
   2257 		       (match-end 0)))
   2258 	  (when desc (backward-char 1))
   2259 	  t)))))
   2260 
   2261 (defun org-list-repair ()
   2262   "Fix indentation, bullets and checkboxes in the list at point."
   2263   (interactive)
   2264   (unless (org-at-item-p) (error "This is not a list"))
   2265   (let* ((struct (org-list-struct))
   2266 	 (parents (org-list-parents-alist struct)))
   2267     (org-list-write-struct struct parents)))
   2268 
   2269 (defun org-cycle-list-bullet (&optional which)
   2270   "Cycle through the different itemize/enumerate bullets.
   2271 This cycle the entire list level through the sequence:
   2272 
   2273    `-'  ->  `+'  ->  `*'  ->  `1.'  ->  `1)'
   2274 
   2275 If WHICH is a valid string, use that as the new bullet.  If WHICH
   2276 is an integer, 0 means `-', 1 means `+' etc.  If WHICH is
   2277 `previous', cycle backwards."
   2278   (interactive "P")
   2279   (unless (org-at-item-p) (error "Not at an item"))
   2280   (let ((origin (point-marker)))
   2281     (forward-line 0)
   2282     (let* ((struct (org-list-struct))
   2283            (parents (org-list-parents-alist struct))
   2284            (prevs (org-list-prevs-alist struct))
   2285            (list-beg (org-list-get-first-item (point) struct prevs))
   2286            ;; Record relative point position to bullet beginning.
   2287            (origin-offset (- origin
   2288                              (+ (point) (org-list-get-ind (point) struct))))
   2289            ;; Record relative point position to bullet end.
   2290            (origin-offset2 (- origin
   2291                               (+ (point) (org-list-get-ind (point) struct)
   2292                                  (length (org-list-get-bullet (point) struct)))))
   2293            (bullet (org-list-get-bullet list-beg struct))
   2294 	   (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs))
   2295 	   (case-fold-search nil)
   2296 	   (current (cond
   2297 		     ((string-match "[a-z]\\." bullet) "a.")
   2298 		     ((string-match "[a-z])" bullet) "a)")
   2299 		     ((string-match "[A-Z]\\." bullet) "A.")
   2300 		     ((string-match "[A-Z])" bullet) "A)")
   2301 		     ((string-match "\\." bullet) "1.")
   2302 		     ((string-match ")" bullet) "1)")
   2303 		     (t (org-trim bullet))))
   2304            ;; Compute list of possible bullets, depending on context.
   2305 	   (bullet-list
   2306 	    (append '("-" "+" )
   2307 		    ;; *-bullets are not allowed at column 0.
   2308 		    (unless (looking-at "\\S-") '("*"))
   2309 		    ;; Description items cannot be numbered.
   2310 		    (unless (or (eq org-plain-list-ordered-item-terminator ?\))
   2311 				(org-at-item-description-p))
   2312 		      '("1."))
   2313 		    (unless (or (eq org-plain-list-ordered-item-terminator ?.)
   2314 				(org-at-item-description-p))
   2315 		      '("1)"))
   2316 		    (unless (or (not alpha-p)
   2317 				(eq org-plain-list-ordered-item-terminator ?\))
   2318 				(org-at-item-description-p))
   2319 		      '("a." "A."))
   2320 		    (unless (or (not alpha-p)
   2321 				(eq org-plain-list-ordered-item-terminator ?.)
   2322 				(org-at-item-description-p))
   2323 		      '("a)" "A)"))))
   2324 	   (len (length bullet-list))
   2325 	   (item-index (- len (length (member current bullet-list))))
   2326 	   (get-value (lambda (index) (nth (mod index len) bullet-list)))
   2327 	   (new (cond
   2328 		 ((member which bullet-list) which)
   2329 		 ((numberp which) (funcall get-value which))
   2330 		 ((eq 'previous which) (funcall get-value (1- item-index)))
   2331 		 (t (funcall get-value (1+ item-index))))))
   2332       ;; Use a short variation of `org-list-write-struct' as there's
   2333       ;; no need to go through all the steps.
   2334       (let ((old-struct (copy-tree struct)))
   2335         (org-list-set-bullet list-beg struct (org-list-bullet-string new))
   2336         (org-list-struct-fix-bul struct prevs)
   2337         (org-list-struct-fix-ind struct parents)
   2338         (org-list-struct-apply-struct struct old-struct))
   2339       (goto-char origin)
   2340       (setq struct (org-list-struct))
   2341       (cond
   2342        ((>= origin-offset2 0)
   2343         (forward-line 0)
   2344         (move-marker origin (+ (point)
   2345                                (org-list-get-ind (point) struct)
   2346                                (length (org-list-get-bullet (point) struct))
   2347                                origin-offset2))
   2348         (goto-char origin))
   2349        ((>= origin-offset 0)
   2350         (forward-line 0)
   2351         (move-marker origin (+ (point)
   2352                                (org-list-get-ind (point) struct)
   2353                                origin-offset))
   2354         (goto-char origin)))
   2355       (move-marker origin nil))))
   2356 
   2357 ;;;###autoload
   2358 (define-minor-mode org-list-checkbox-radio-mode
   2359   "When turned on, use list checkboxes as radio buttons."
   2360   :lighter " CheckBoxRadio"
   2361   (unless (eq major-mode 'org-mode)
   2362     (user-error "Cannot turn this mode outside org-mode buffers")))
   2363 
   2364 (defun org-toggle-radio-button (&optional arg)
   2365   "Toggle off all checkboxes and toggle on the one at point."
   2366   (interactive "P")
   2367   (if (not (org-at-item-p))
   2368       (user-error "Cannot toggle checkbox outside of a list")
   2369     (let* ((cpos (org-in-item-p))
   2370 	   (struct (org-list-struct))
   2371 	   (orderedp (org-entry-get nil "ORDERED"))
   2372 	   (parents (org-list-parents-alist struct))
   2373 	   (old-struct (copy-tree struct))
   2374 	   (cbox (org-list-get-checkbox cpos struct))
   2375            (prevs (org-list-prevs-alist struct))
   2376            (start (org-list-get-list-begin (line-beginning-position) struct prevs))
   2377 	   (new (unless (and cbox (equal arg '(4)) (equal start cpos))
   2378 		  "[ ]")))
   2379       (dolist (pos (org-list-get-all-items
   2380 		    start struct (org-list-prevs-alist struct)))
   2381 	(org-list-set-checkbox pos struct new))
   2382       (when new
   2383 	(org-list-set-checkbox
   2384 	 cpos struct
   2385 	 (cond ((equal arg '(4)) (unless cbox "[ ]"))
   2386 	       ((equal arg '(16)) (unless cbox "[-]"))
   2387 	       (t (if (equal cbox "[X]") "[ ]" "[X]")))))
   2388       (org-list-struct-fix-box struct parents prevs orderedp)
   2389       (org-list-struct-apply-struct struct old-struct)
   2390       (org-update-checkbox-count-maybe))))
   2391 
   2392 (defun org-at-radio-list-p ()
   2393   "Is point at a list item with radio buttons?"
   2394   (when (org-match-line (org-item-re))	;short-circuit
   2395     (let* ((e (save-excursion (forward-line 0) (org-element-at-point))))
   2396       ;; Check we're really on a line with a bullet.
   2397       (when (org-element-type-p e '(item plain-list))
   2398 	;; Look for ATTR_ORG attribute in the current plain list.
   2399 	(let ((plain-list (org-element-lineage e 'plain-list t)))
   2400 	  (org-with-point-at (org-element-post-affiliated plain-list)
   2401 	    (let ((case-fold-search t)
   2402 		  (regexp "^[ \t]*#\\+attr_org:.* :radio \\(\\S-+\\)")
   2403 		  (begin (org-element-begin plain-list)))
   2404 	      (and (re-search-backward regexp begin t)
   2405 		   (not (string-equal "nil" (match-string 1)))))))))))
   2406 
   2407 (defun org-toggle-checkbox (&optional toggle-presence)
   2408   "Toggle the checkbox in the current line.
   2409 
   2410 With prefix argument TOGGLE-PRESENCE, add or remove checkboxes.
   2411 With a double prefix argument, set the checkbox to \"[-]\".
   2412 
   2413 When there is an active region, toggle status or presence of the
   2414 first checkbox there, and make every item inside have the same
   2415 status or presence, respectively.
   2416 
   2417 If point is on a headline, apply this to all checkbox items in
   2418 the text below the heading, taking as reference the first item in
   2419 subtree, ignoring planning line and any drawer following it."
   2420   (interactive "P")
   2421   (if (org-at-radio-list-p)
   2422       (org-toggle-radio-button toggle-presence)
   2423     (save-excursion
   2424       (let* (singlep
   2425 	     block-item
   2426 	     lim-up
   2427 	     lim-down
   2428 	     (orderedp (org-entry-get nil "ORDERED"))
   2429 	     (_bounds
   2430 	      ;; In a region, start at first item in region.
   2431 	      (cond
   2432 	       ((org-region-active-p)
   2433 		(let ((limit (region-end)))
   2434 		  (goto-char (region-beginning))
   2435 		  (if (org-list-search-forward (org-item-beginning-re) limit t)
   2436                       (setq lim-up (line-beginning-position))
   2437 		    (error "No item in region"))
   2438 		  (setq lim-down (copy-marker limit))))
   2439 	       ((org-at-heading-p)
   2440 		;; On a heading, start at first item after drawers and
   2441 		;; timestamps (scheduled, etc.).
   2442 		(let ((limit (save-excursion (outline-next-heading) (point))))
   2443 		  (org-end-of-meta-data t)
   2444 		  (if (org-list-search-forward (org-item-beginning-re) limit t)
   2445                       (setq lim-up (line-beginning-position))
   2446 		    (error "No item in subtree"))
   2447 		  (setq lim-down (copy-marker limit))))
   2448 	       ;; Just one item: set SINGLEP flag.
   2449 	       ((org-at-item-p)
   2450 		(setq singlep t)
   2451                 (setq lim-up (line-beginning-position)
   2452                       lim-down (copy-marker (line-end-position))))
   2453 	       (t (error "Not at an item or heading, and no active region"))))
   2454 	     ;; Determine the checkbox going to be applied to all items
   2455 	     ;; within bounds.
   2456 	     (ref-checkbox
   2457 	      (progn
   2458 		(goto-char lim-up)
   2459 		(let ((cbox (and (org-at-item-checkbox-p) (match-string 1))))
   2460 		  (cond
   2461 		   ((equal toggle-presence '(16)) "[-]")
   2462 		   ((equal toggle-presence '(4))
   2463 		    (unless cbox "[ ]"))
   2464 		   ((equal "[X]" cbox) "[ ]")
   2465 		   (t "[X]"))))))
   2466 	;; When an item is found within bounds, grab the full list at
   2467 	;; point structure, then: (1) set check-box of all its items
   2468 	;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the
   2469 	;; whole list, (3) move point after the list.
   2470 	(goto-char lim-up)
   2471 	(while (and (< (point) lim-down)
   2472 		    (org-list-search-forward (org-item-beginning-re)
   2473 					     lim-down 'move))
   2474 	  (let* ((struct (org-list-struct))
   2475 		 (struct-copy (copy-tree struct))
   2476 		 (parents (org-list-parents-alist struct))
   2477 		 (prevs (org-list-prevs-alist struct))
   2478 		 (bottom (copy-marker (org-list-get-bottom-point struct)))
   2479 		 (items-to-toggle (cl-remove-if
   2480 				   (lambda (e) (or (< e lim-up) (> e lim-down)))
   2481 				   (mapcar #'car struct))))
   2482 	    (dolist (e items-to-toggle)
   2483 	      (org-list-set-checkbox
   2484 	       e struct
   2485 	       ;; If there is no box at item, leave as-is unless
   2486 	       ;; function was called with C-u prefix.
   2487 	       (let ((cur-box (org-list-get-checkbox e struct)))
   2488 		 (if (or cur-box (equal toggle-presence '(4)))
   2489 		     ref-checkbox
   2490 		   cur-box))))
   2491 	    (setq block-item (org-list-struct-fix-box
   2492 			      struct parents prevs orderedp))
   2493 	    ;; Report some problems due to ORDERED status of subtree.
   2494 	    ;; If only one box was being checked, throw an error, else,
   2495 	    ;; only signal problems.
   2496 	    (cond
   2497 	     ((and singlep block-item (> lim-up block-item))
   2498 	      (error
   2499 	       "Checkbox blocked because of unchecked box at line %d"
   2500 	       (org-current-line block-item)))
   2501 	     (block-item
   2502 	      (message
   2503 	       "Checkboxes were removed due to unchecked box at line %d"
   2504 	       (org-current-line block-item))))
   2505 	    (goto-char bottom)
   2506 	    (move-marker bottom nil)
   2507 	    (org-list-struct-apply-struct struct struct-copy)))
   2508 	(move-marker lim-down nil))))
   2509   (org-update-checkbox-count-maybe))
   2510 
   2511 (defun org-reset-checkbox-state-subtree ()
   2512   "Reset all checkboxes in an entry subtree."
   2513   (interactive "*")
   2514   (if (org-before-first-heading-p)
   2515       (error "Not inside a tree")
   2516     (save-restriction
   2517       (save-excursion
   2518 	(org-narrow-to-subtree)
   2519 	(org-fold-show-subtree)
   2520 	(goto-char (point-min))
   2521 	(let ((end (point-max)))
   2522 	  (while (< (point) end)
   2523 	    (when (org-at-item-checkbox-p)
   2524 	      (replace-match "[ ]" t t nil 1))
   2525 	    (forward-line 1)))
   2526 	(org-update-checkbox-count-maybe 'narrow)))))
   2527 
   2528 (defun org-update-checkbox-count (&optional all)
   2529   "Update the checkbox statistics in the current section.
   2530 
   2531 This will find all statistic cookies like [57%] and [6/12] and
   2532 update them with the current numbers.
   2533 
   2534 With optional prefix argument ALL, do this for the whole buffer.
   2535 When ALL is symbol `narrow', update statistics only in the accessible
   2536 portion of the buffer."
   2537   (interactive "P")
   2538   (save-excursion
   2539     (save-restriction
   2540       (unless (eq all 'narrow) (widen))
   2541       (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
   2542 	     (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
   2543 \\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
   2544              (cookie-data (or (org-entry-get nil "COOKIE_DATA") ""))
   2545 	     (recursivep
   2546 	      (or (not org-checkbox-hierarchical-statistics)
   2547 	          (string-match-p "\\<recursive\\>" cookie-data)))
   2548 	     (within-inlinetask (and (not all)
   2549 				     (featurep 'org-inlinetask)
   2550 				     (org-inlinetask-in-task-p)))
   2551 	     (end (cond (all (point-max))
   2552 		        (within-inlinetask
   2553 		         (save-excursion (outline-next-heading) (point)))
   2554 		        (t (save-excursion
   2555 			     (org-with-limited-levels (outline-next-heading))
   2556 			     (point)))))
   2557 	     (count-boxes
   2558 	      (lambda (item structs recursivep)
   2559 	        ;; Return number of checked boxes and boxes of all types
   2560 	        ;; in all structures in STRUCTS.  If RECURSIVEP is
   2561 	        ;; non-nil, also count boxes in sub-lists.  If ITEM is
   2562 	        ;; nil, count across the whole structure, else count only
   2563 	        ;; across subtree whose ancestor is ITEM.
   2564 	        (let ((c-on 0) (c-all 0))
   2565 	          (dolist (s structs (list c-on c-all))
   2566 		    (let* ((pre (org-list-prevs-alist s))
   2567 			   (par (org-list-parents-alist s))
   2568 			   (items
   2569 			    (cond
   2570 			     ((and recursivep item) (org-list-get-subtree item s))
   2571 			     (recursivep (mapcar #'car s))
   2572 			     (item (org-list-get-children item s par))
   2573 			     (t (org-list-get-all-items
   2574 			         (org-list-get-top-point s) s pre))))
   2575 			   (cookies (delq nil (mapcar
   2576 					     (lambda (e)
   2577 					       (org-list-get-checkbox e s))
   2578 					     items))))
   2579 		      (cl-incf c-all (length cookies))
   2580 		      (cl-incf c-on (cl-count "[X]" cookies :test #'equal)))))))
   2581 	     cookies-list cache)
   2582         ;; Move to start.
   2583         (cond (all (goto-char (point-min)))
   2584 	      (within-inlinetask (org-back-to-heading t))
   2585 	      (t (org-with-limited-levels (outline-previous-heading))))
   2586         ;; Build an alist for each cookie found.  The key is the position
   2587         ;; at beginning of cookie and values ending position, format of
   2588         ;; cookie, number of checked boxes to report and total number of
   2589         ;; boxes.
   2590         (while (re-search-forward cookie-re end t)
   2591           (let ((context (save-excursion (backward-char)
   2592 				         (save-match-data (org-element-context)))))
   2593 	    (when (and (org-element-type-p context 'statistics-cookie)
   2594                        (not (string-match-p "\\<todo\\>" cookie-data)))
   2595 	      (push
   2596 	       (append
   2597 	        (list (match-beginning 1) (match-end 1) (match-end 2))
   2598 	        (let* ((container
   2599 		        (org-element-lineage
   2600 		         context
   2601 		         '(drawer center-block dynamic-block inlinetask item
   2602 			          quote-block special-block verse-block)))
   2603 		       (beg (if container
   2604 			        (org-element-contents-begin container)
   2605 			      (save-excursion
   2606 			        (org-with-limited-levels
   2607 			         (outline-previous-heading))
   2608 			        (point)))))
   2609 	          (or (cdr (assq beg cache))
   2610 		      (save-excursion
   2611 		        (goto-char beg)
   2612 		        (let ((end
   2613 			       (if container
   2614 				   (org-element-contents-end container)
   2615 			         (save-excursion
   2616 				   (org-with-limited-levels (outline-next-heading))
   2617 				   (point))))
   2618 			      structs)
   2619 		          (while (re-search-forward box-re end t)
   2620 			    (let ((element (org-element-at-point)))
   2621 			      (when (org-element-type-p element 'item)
   2622 			        (push (org-element-property :structure element)
   2623 				      structs)
   2624 			        ;; Skip whole list since we have its
   2625 			        ;; structure anyway.
   2626 			        (while (setq element (org-element-lineage
   2627 						      element 'plain-list))
   2628 			          (goto-char
   2629 				   (min (org-element-end element)
   2630 				        end))))))
   2631 		          ;; Cache count for cookies applying to the same
   2632 		          ;; area.  Then return it.
   2633 		          (let ((count
   2634 			         (funcall count-boxes
   2635 				          (and (org-element-type-p
   2636                                                 container 'item)
   2637 					       (org-element-property
   2638 					        :begin container))
   2639 				          structs
   2640 				          recursivep)))
   2641 			    (push (cons beg count) cache)
   2642 			    count))))))
   2643 	       cookies-list))))
   2644         ;; Apply alist to buffer.
   2645         (dolist (cookie cookies-list)
   2646           (let* ((beg (car cookie))
   2647 	         (end (nth 1 cookie))
   2648 	         (percent (nth 2 cookie))
   2649 	         (checked (nth 3 cookie))
   2650 	         (total (nth 4 cookie)))
   2651 	    (goto-char beg)
   2652             (org-fold-core-ignore-modifications
   2653 	      (insert-and-inherit
   2654 	       (if percent (format "[%d%%]" (floor (* 100.0 checked)
   2655 					           (max 1 total)))
   2656 	         (format "[%d/%d]" checked total)))
   2657 	      (delete-region (point) (+ (point) (- end beg))))
   2658 	    (when org-auto-align-tags (org-fix-tags-on-the-fly))))))))
   2659 
   2660 (defun org-get-checkbox-statistics-face ()
   2661   "Select the face for checkbox statistics.
   2662 The face will be `org-done' when all relevant boxes are checked.
   2663 Otherwise it will be `org-todo'."
   2664   (if (match-end 1)
   2665       (if (equal (match-string 1) "100%")
   2666 	  'org-checkbox-statistics-done
   2667 	'org-checkbox-statistics-todo)
   2668     (if (and (> (match-end 2) (match-beginning 2))
   2669 	     (equal (match-string 2) (match-string 3)))
   2670 	'org-checkbox-statistics-done
   2671       'org-checkbox-statistics-todo)))
   2672 
   2673 (defun org-update-checkbox-count-maybe (&optional all)
   2674   "Update checkbox statistics unless turned off by user.
   2675 With an optional argument ALL, update them in the whole buffer.
   2676 When ALL is symbol `narrow', update statistics only in the accessible
   2677 portion of the buffer."
   2678   (when (cdr (assq 'checkbox org-list-automatic-rules))
   2679     (org-update-checkbox-count all))
   2680   (run-hooks 'org-checkbox-statistics-hook))
   2681 
   2682 (defvar org-last-indent-begin-marker (make-marker))
   2683 (defvar org-last-indent-end-marker (make-marker))
   2684 (defun org-list-indent-item-generic (arg no-subtree struct)
   2685   "Indent a local list item including its children.
   2686 When number ARG is a negative, item will be outdented, otherwise
   2687 it will be indented.
   2688 
   2689 If a region is active, all items inside will be moved.
   2690 
   2691 If NO-SUBTREE is non-nil, only indent the item itself, not its
   2692 children.
   2693 
   2694 STRUCT is the list structure.
   2695 
   2696 Return t if successful."
   2697   (save-excursion
   2698     (let* ((regionp (org-region-active-p))
   2699 	   (rbeg (and regionp (region-beginning)))
   2700 	   (rend (and regionp (region-end)))
   2701 	   (top (org-list-get-top-point struct))
   2702 	   (parents (org-list-parents-alist struct))
   2703 	   (prevs (org-list-prevs-alist struct))
   2704 	   ;; Are we going to move the whole list?
   2705 	   (specialp
   2706 	    (and (not regionp)
   2707                  (= top (line-beginning-position))
   2708 		 (cdr (assq 'indent org-list-automatic-rules))
   2709 		 (if no-subtree
   2710 		     (user-error
   2711 		      "At first item: use S-M-<left/right> to move the whole list")
   2712 		   t))))
   2713       ;; Determine begin and end points of zone to indent.  If moving
   2714       ;; more than one item, save them for subsequent moves.
   2715       (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
   2716 		   (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
   2717 	(if regionp
   2718 	    (progn
   2719 	      (set-marker org-last-indent-begin-marker rbeg)
   2720 	      (set-marker org-last-indent-end-marker rend))
   2721           (set-marker org-last-indent-begin-marker (line-beginning-position))
   2722 	  (set-marker org-last-indent-end-marker
   2723 		      (cond
   2724 		       (specialp (org-list-get-bottom-point struct))
   2725                        (no-subtree (1+ (line-beginning-position)))
   2726                        (t (org-list-get-item-end (line-beginning-position) struct))))))
   2727       (let* ((beg (marker-position org-last-indent-begin-marker))
   2728 	     (end (marker-position org-last-indent-end-marker))
   2729              (deactivate-mark nil))
   2730 	(cond
   2731 	 ;; Special case: moving top-item with indent rule.
   2732 	 (specialp
   2733 	  (let* ((level-skip (org-level-increment))
   2734 		 (offset (if (< arg 0) (- level-skip) level-skip))
   2735 		 (top-ind (org-list-get-ind beg struct))
   2736 		 (old-struct (copy-tree struct)))
   2737 	    (if (< (+ top-ind offset) 0)
   2738 		(error "Cannot outdent beyond margin")
   2739 	      ;; Change bullet if necessary.
   2740 	      (when (and (= (+ top-ind offset) 0)
   2741 			 (string-match "\\*"
   2742 				       (org-list-get-bullet beg struct)))
   2743 		(org-list-set-bullet beg struct
   2744 				     (org-list-bullet-string "-")))
   2745 	      ;; Shift every item by OFFSET and fix bullets.  Then
   2746 	      ;; apply changes to buffer.
   2747 	      (pcase-dolist (`(,pos . ,_) struct)
   2748 		(let ((ind (org-list-get-ind pos struct)))
   2749 		  (org-list-set-ind pos struct (+ ind offset))))
   2750 	      (org-list-struct-fix-bul struct prevs)
   2751 	      (org-list-struct-apply-struct struct old-struct))))
   2752 	 ;; Forbidden move:
   2753 	 ((and (< arg 0)
   2754 	       ;; If only one item is moved, it mustn't have a child.
   2755 	       (or (and no-subtree
   2756 			(not regionp)
   2757 			(org-list-has-child-p beg struct))
   2758 		   ;; If a subtree or region is moved, the last item
   2759 		   ;; of the subtree mustn't have a child.
   2760 		   (let ((last-item (caar
   2761 				     (reverse
   2762 				      (cl-remove-if
   2763 				       (lambda (e) (>= (car e) end))
   2764 				       struct)))))
   2765 		     (org-list-has-child-p last-item struct))))
   2766 	  (error "Cannot outdent an item without its children"))
   2767 	 ;; Normal shifting
   2768 	 (t
   2769 	  (let* ((old-struct (copy-tree struct))
   2770 		 (new-parents
   2771 		  (if (< arg 0)
   2772 		      (org-list-struct-outdent beg end struct parents)
   2773 		    (org-list-struct-indent beg end struct parents prevs))))
   2774 	    (org-list-write-struct struct new-parents old-struct))
   2775 	  (org-update-checkbox-count-maybe))))))
   2776   t)
   2777 
   2778 (defun org-outdent-item ()
   2779   "Outdent a local list item, but not its children.
   2780 If a region is active, all items inside will be moved."
   2781   (interactive)
   2782   (let ((regionp (org-region-active-p)))
   2783     (cond
   2784      ((or (org-at-item-p)
   2785 	  (and regionp
   2786 	       (save-excursion (goto-char (region-beginning))
   2787 			       (org-at-item-p))))
   2788       (let ((struct (if (not regionp) (org-list-struct)
   2789 		      (save-excursion (goto-char (region-beginning))
   2790 				      (org-list-struct)))))
   2791 	(org-list-indent-item-generic -1 t struct)))
   2792      (regionp (error "Region not starting at an item"))
   2793      (t (error "Not at an item")))))
   2794 
   2795 (defun org-indent-item ()
   2796   "Indent a local list item, but not its children.
   2797 If a region is active, all items inside will be moved."
   2798   (interactive)
   2799   (let ((regionp (org-region-active-p)))
   2800     (cond
   2801      ((or (org-at-item-p)
   2802 	  (and regionp
   2803 	       (save-excursion (goto-char (region-beginning))
   2804 			       (org-at-item-p))))
   2805       (let ((struct (if (not regionp) (org-list-struct)
   2806 		      (save-excursion (goto-char (region-beginning))
   2807 				      (org-list-struct)))))
   2808 	(org-list-indent-item-generic 1 t struct)))
   2809      (regionp (error "Region not starting at an item"))
   2810      (t (error "Not at an item")))))
   2811 
   2812 (defun org-outdent-item-tree ()
   2813   "Outdent a local list item including its children.
   2814 If a region is active, all items inside will be moved."
   2815   (interactive)
   2816   (let ((regionp (org-region-active-p)))
   2817     (cond
   2818      ((or (org-at-item-p)
   2819 	  (and regionp
   2820 	       (save-excursion (goto-char (region-beginning))
   2821 			       (org-at-item-p))))
   2822       (let ((struct (if (not regionp) (org-list-struct)
   2823 		      (save-excursion (goto-char (region-beginning))
   2824 				      (org-list-struct)))))
   2825 	(org-list-indent-item-generic -1 nil struct)))
   2826      (regionp (error "Region not starting at an item"))
   2827      (t (error "Not at an item")))))
   2828 
   2829 (defun org-indent-item-tree ()
   2830   "Indent a local list item including its children.
   2831 If a region is active, all items inside will be moved."
   2832   (interactive)
   2833   (let ((regionp (org-region-active-p)))
   2834     (cond
   2835      ((or (org-at-item-p)
   2836 	  (and regionp
   2837 	       (save-excursion (goto-char (region-beginning))
   2838 			       (org-at-item-p))))
   2839       (let ((struct (if (not regionp) (org-list-struct)
   2840 		      (save-excursion (goto-char (region-beginning))
   2841 				      (org-list-struct)))))
   2842 	(org-list-indent-item-generic 1 nil struct)))
   2843      (regionp (error "Region not starting at an item"))
   2844      (t (error "Not at an item")))))
   2845 
   2846 (defvar org-tab-ind-state)
   2847 (defun org-cycle-item-indentation ()
   2848   "Cycle levels of indentation of an empty item.
   2849 
   2850 The first run indents the item, if applicable.  Subsequent runs
   2851 outdent it at meaningful levels in the list.  When done, item is
   2852 put back at its original position with its original bullet.
   2853 
   2854 Return t at each successful move."
   2855   (when (org-at-item-p)
   2856     (let* ((struct (org-list-struct))
   2857 	   (item (line-beginning-position))
   2858 	   (ind (org-list-get-ind item struct)))
   2859       ;; Accept empty items or if cycle has already started.
   2860       (when (or (eq last-command 'org-cycle-item-indentation)
   2861 		(and (org-match-line org-list-full-item-re)
   2862 		     (>= (match-end 0)
   2863 			 (save-excursion
   2864 			   (goto-char (org-list-get-item-end item struct))
   2865 			   (skip-chars-backward " \t\n")
   2866 			   (point)))))
   2867 	(setq this-command 'org-cycle-item-indentation)
   2868 	(let ((prevs (org-list-prevs-alist struct))
   2869 	      (parents (org-list-parents-alist struct)))
   2870 	  (if (eq last-command 'org-cycle-item-indentation)
   2871 	      ;; When in the middle of the cycle, try to outdent.  If
   2872 	      ;; it fails, move point back to its initial position and
   2873 	      ;; reset cycle.
   2874 	      (pcase-let ((`(,old-ind . ,old-bul) org-tab-ind-state)
   2875 			  (allow-outdent
   2876 			   (lambda (struct prevs parents)
   2877 			     ;; Non-nil if current item can be
   2878 			     ;; outdented.
   2879 			     (and (not (org-list-get-next-item item nil prevs))
   2880 				  (not (org-list-has-child-p item struct))
   2881 				  (org-list-get-parent item struct parents)))))
   2882 		(cond
   2883 		 ((and (> ind old-ind)
   2884 		       (org-list-get-prev-item item nil prevs))
   2885 		  (org-list-indent-item-generic 1 t struct))
   2886 		 ((and (< ind old-ind)
   2887 		       (funcall allow-outdent struct prevs parents))
   2888 		  (org-list-indent-item-generic -1 t struct))
   2889 		 (t
   2890 		  (delete-region (line-beginning-position) (line-end-position))
   2891 		  (indent-to-column old-ind)
   2892 		  (insert old-bul " ")
   2893 		  (let* ((struct (org-list-struct))
   2894 			 (parents (org-list-parents-alist struct)))
   2895 		    (if (and (> ind old-ind)
   2896 			     ;; We were previously indenting item.  It
   2897 			     ;; is no longer possible.  Try to outdent
   2898 			     ;; from initial position.
   2899 			     (funcall allow-outdent
   2900 				      struct
   2901 				      (org-list-prevs-alist struct)
   2902 				      parents))
   2903 			(org-list-indent-item-generic -1 t struct)
   2904 		      (org-list-write-struct struct parents)
   2905 		      ;; Start cycle over.
   2906 		      (setq this-command 'identity)
   2907 		      t)))))
   2908 	    ;; If a cycle is starting, remember initial indentation
   2909 	    ;; and bullet, then try to indent.  If it fails, try to
   2910 	    ;; outdent.
   2911 	    (setq org-tab-ind-state
   2912 		  (cons ind (org-trim (org-current-line-string))))
   2913 	    (cond
   2914 	     ((org-list-get-prev-item item nil prevs)
   2915 	      (org-list-indent-item-generic 1 t struct))
   2916 	     ((and (not (org-list-get-next-item item nil prevs))
   2917 		   (org-list-get-parent item struct parents))
   2918 	      (org-list-indent-item-generic -1 t struct))
   2919 	     (t
   2920 	      ;; This command failed.  So will the following one.
   2921 	      ;; There's no point in starting the cycle.
   2922 	      (setq this-command 'identity)
   2923 	      (user-error "Cannot move item")))))))))
   2924 
   2925 (defun org-sort-list
   2926     (&optional with-case sorting-type getkey-func compare-func interactive?)
   2927   "Sort list items.
   2928 The cursor may be at any item of the list that should be sorted.
   2929 Sublists are not sorted.  Checkboxes, if any, are ignored.
   2930 
   2931 Sorting can be alphabetically, numerically, by date/time as given
   2932 by a time stamp, by a property or by priority.
   2933 
   2934 Comparing entries ignores case by default.  However, with an
   2935 optional argument WITH-CASE, the sorting considers case as well,
   2936 if the current locale allows for it.
   2937 
   2938 The command prompts for the sorting type unless it has been given
   2939 to the function through the SORTING-TYPE argument, which needs to
   2940 be a character, among ?n ?N ?a ?A ?t ?T ?f ?F ?x or ?X.  Here is
   2941 the detailed meaning of each character:
   2942 
   2943 n   Numerically, by converting the beginning of the item to a number.
   2944 a   Alphabetically.  Only the first line of item is checked.
   2945 t   By date/time, either the first active time stamp in the entry, if
   2946     any, or by the first inactive one.  In a timer list, sort the timers.
   2947 x   By \"checked\" status of a check list.
   2948 
   2949 Capital letters will reverse the sort order.
   2950 
   2951 If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
   2952 a function to be called with point at the beginning of the
   2953 record.  It must return a value that is compatible with COMPARE-FUNC,
   2954 the function used to compare entries.
   2955 
   2956 Sorting is done against the visible part of the headlines, it
   2957 ignores hidden links.
   2958 
   2959 A non-nil value for INTERACTIVE? is used to signal that this
   2960 function is being called interactively."
   2961   (interactive (list current-prefix-arg nil nil nil t))
   2962   (let* ((case-func (if with-case 'identity 'downcase))
   2963          (struct (org-list-struct))
   2964          (prevs (org-list-prevs-alist struct))
   2965          (start (org-list-get-list-begin (line-beginning-position) struct prevs))
   2966          (end (org-list-get-list-end (line-beginning-position) struct prevs))
   2967 	 (sorting-type
   2968 	  (or sorting-type
   2969 	      (progn
   2970 		(message
   2971 		 "Sort plain list: [a]lpha  [n]umeric  [t]ime  [f]unc  [x]checked  A/N/T/F/X means reversed:")
   2972 		(read-char-exclusive))))
   2973 	 (dcst (downcase sorting-type))
   2974 	 (getkey-func
   2975 	  (and (= dcst ?f)
   2976 	       (or getkey-func
   2977 		   (and interactive?
   2978 			(org-read-function "Function for extracting keys: "))
   2979 		   (error "Missing key extractor"))))
   2980 	 (sort-func
   2981 	  (cond
   2982 	   ((= dcst ?a) #'org-string<)
   2983 	   ((= dcst ?f)
   2984 	    (or compare-func
   2985 		(and interactive?
   2986 		     (org-read-function
   2987 		      (concat "Function for comparing keys "
   2988 			      "(empty for default `sort-subr' predicate): ")
   2989 		      'allow-empty))))
   2990 	   ((= dcst ?t) #'<)
   2991 	   ((= dcst ?x) #'string<))))
   2992     (message "Sorting items...")
   2993     (save-restriction
   2994       (narrow-to-region start end)
   2995       (goto-char (point-min))
   2996       (let* ((case-fold-search nil)
   2997 	     (now (current-time))
   2998 	     (next-record (lambda ()
   2999 			    (skip-chars-forward " \r\t\n")
   3000 			    (or (eobp) (forward-line 0))))
   3001 	     (end-record (lambda ()
   3002 			   (goto-char (org-list-get-item-end-before-blank
   3003 				       (point) struct))))
   3004 	     (value-to-sort
   3005 	      (lambda ()
   3006 		(when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
   3007 		  (cond
   3008 		   ((= dcst ?n)
   3009 		    (string-to-number
   3010 		     (org-sort-remove-invisible
   3011                       (buffer-substring (match-end 0) (line-end-position)))))
   3012 		   ((= dcst ?a)
   3013 		    (funcall case-func
   3014 			     (org-sort-remove-invisible
   3015 			      (buffer-substring
   3016                                (match-end 0) (line-end-position)))))
   3017 		   ((= dcst ?t)
   3018 		    (cond
   3019 		     ;; If it is a timer list, convert timer to seconds
   3020 		     ((org-at-item-timer-p)
   3021 		      (org-timer-hms-to-secs (match-string 1)))
   3022 		     ((or (save-excursion
   3023                             (re-search-forward org-ts-regexp (line-end-position) t))
   3024 			  (save-excursion (re-search-forward org-ts-regexp-both
   3025                                                              (line-end-position) t)))
   3026 		      (org-time-string-to-seconds (match-string 0)))
   3027 		     (t (float-time now))))
   3028 		   ((= dcst ?x) (or (and (stringp (match-string 1))
   3029 					 (match-string 1))
   3030 				    ""))
   3031 		   ((= dcst ?f)
   3032 		    (if getkey-func
   3033 			(let ((value (funcall getkey-func)))
   3034 			  (if (stringp value)
   3035 			      (funcall case-func value)
   3036 			    value))
   3037 		      (error "Invalid key function `%s'" getkey-func)))
   3038 		   (t (error "Invalid sorting type `%c'" sorting-type)))))))
   3039 	(sort-subr (/= dcst sorting-type)
   3040 		   next-record
   3041 		   end-record
   3042 		   value-to-sort
   3043 		   nil
   3044 		   sort-func)
   3045 	;; Read and fix list again, as `sort-subr' probably destroyed
   3046 	;; its structure.
   3047 	(org-list-repair)
   3048 	(run-hooks 'org-after-sorting-entries-or-items-hook)
   3049 	(message "Sorting items...done")))))
   3050 
   3051 (defun org-toggle-item (arg)
   3052   "Convert headings or normal lines to items, items to normal lines.
   3053 If there is no active region, only the current line is considered.
   3054 
   3055 If the first non blank line in the region is a headline, convert
   3056 all headlines to items, shifting text accordingly.
   3057 
   3058 If it is an item, convert all items to normal lines.
   3059 
   3060 If it is normal text, change region into a list of items.
   3061 With a prefix argument ARG, change the region in a single item."
   3062   (interactive "P")
   3063   (let ((extract-footnote-definitions
   3064          (lambda (end)
   3065            ;; Remove footnote definitions from point to END.
   3066            ;; Return the list of the extracted definitions.
   3067            (let (definitions element)
   3068              (save-excursion
   3069                (while (re-search-forward org-footnote-definition-re end t)
   3070                  (setq element (org-element-at-point))
   3071                  (when (org-element-type-p element 'footnote-definition)
   3072                    (push (buffer-substring-no-properties
   3073                           (org-element-begin element)
   3074                           (org-element-end element))
   3075                          definitions)
   3076                    ;; Ensure at least 2 blank lines after the last
   3077                    ;; footnote definition, thus not slurping the
   3078                    ;; following element.
   3079                    (unless (<= 2 (org-element-post-blank
   3080                                   (org-element-at-point)))
   3081                      (setf (car definitions)
   3082                            (concat (car definitions)
   3083                                    (make-string
   3084                                     (- 2 (org-element-post-blank
   3085                                           (org-element-at-point)))
   3086                                     ?\n))))
   3087                    (delete-region
   3088                     (org-element-begin element)
   3089                     (org-element-end element))))
   3090                definitions))))
   3091         (shift-text
   3092 	 (lambda (ind end)
   3093 	   ;; Shift text in current section to IND, from point to END.
   3094 	   ;; The function leaves point to END line.
   3095 	   (let ((min-i 1000) (end (copy-marker end)))
   3096 	     ;; First determine the minimum indentation (MIN-I) of
   3097 	     ;; the text.
   3098 	     (save-excursion
   3099 	       (catch 'exit
   3100 		 (while (< (point) end)
   3101 		   (let ((i (org-current-text-indentation)))
   3102 		     (cond
   3103 		      ;; Skip blank lines and inline tasks.
   3104 		      ((looking-at "^[ \t]*$"))
   3105 		      ((looking-at org-outline-regexp-bol))
   3106 		      ;; We can't find less than 0 indentation.
   3107 		      ((zerop i) (throw 'exit (setq min-i 0)))
   3108 		      ((< i min-i) (setq min-i i))))
   3109 		   (forward-line))))
   3110 	     ;; Then indent each line so that a line indented to
   3111 	     ;; MIN-I becomes indented to IND.  Ignore blank lines
   3112 	     ;; and inline tasks in the process.
   3113 	     (let ((delta (- ind min-i)))
   3114 	       (while (< (point) end)
   3115 		 (unless (or (looking-at "^[ \t]*$")
   3116 			     (looking-at org-outline-regexp-bol))
   3117 		   (indent-line-to (+ (org-current-text-indentation) delta)))
   3118 		 (forward-line))))))
   3119 	(skip-blanks
   3120 	 (lambda (pos)
   3121 	   ;; Return beginning of first non-blank line, starting from
   3122 	   ;; line at POS.
   3123 	   (save-excursion
   3124 	     (goto-char pos)
   3125 	     (skip-chars-forward " \r\t\n")
   3126              (line-beginning-position))))
   3127 	beg end)
   3128     ;; Determine boundaries of changes.
   3129     (if (org-region-active-p)
   3130 	(setq beg (funcall skip-blanks (region-beginning))
   3131 	      end (copy-marker (region-end)))
   3132       (setq beg (line-beginning-position)
   3133             end (copy-marker (line-end-position))))
   3134     ;; Depending on the starting line, choose an action on the text
   3135     ;; between BEG and END.
   3136     (org-with-limited-levels
   3137      (save-excursion
   3138        (goto-char beg)
   3139        (cond
   3140 	;; Case 1. Start at an item: de-itemize.  Note that it only
   3141 	;;         happens when a region is active: `org-ctrl-c-minus'
   3142 	;;         would call `org-cycle-list-bullet' otherwise.
   3143 	((org-at-item-p)
   3144 	 (while (< (point) end)
   3145 	   (when (org-at-item-p)
   3146 	     (skip-chars-forward " \t")
   3147 	     (delete-region (point) (match-end 0)))
   3148 	   (forward-line)))
   3149 	;; Case 2. Start at a heading: convert to items.
   3150 	((org-at-heading-p)
   3151 	 ;; Remove metadata
   3152 	 (let (org-loop-over-headlines-in-active-region)
   3153 	   (org-list--delete-metadata))
   3154 	 (let* ((bul (org-list-bullet-string "-"))
   3155 		(bul-len (length bul))
   3156 		;; Indentation of the first heading.  It should be
   3157 		;; relative to the indentation of its parent, if any.
   3158 		(start-ind (save-excursion
   3159 			     (cond
   3160 			      ((not org-adapt-indentation) 0)
   3161 			      ((not (outline-previous-heading)) 0)
   3162 			      (t (length (match-string 0))))))
   3163 		;; Level of first heading.  Further headings will be
   3164 		;; compared to it to determine hierarchy in the list.
   3165 		(ref-level (org-reduced-level (org-outline-level)))
   3166                 (footnote-definitions
   3167                  (funcall extract-footnote-definitions end)))
   3168 	   (while (< (point) end)
   3169 	     (let* ((level (org-reduced-level (org-outline-level)))
   3170 		    (delta (max 0 (- level ref-level)))
   3171 		    (todo-state (org-get-todo-state)))
   3172 	       ;; If current headline is less indented than the first
   3173 	       ;; one, set it as reference, in order to preserve
   3174 	       ;; subtrees.
   3175 	       (when (< level ref-level) (setq ref-level level))
   3176 	       ;; Remove metadata
   3177 	       (let (org-loop-over-headlines-in-active-region)
   3178 		 (org-list--delete-metadata))
   3179 	       ;; Remove stars and TODO keyword.
   3180 	       (let ((case-fold-search nil)) (looking-at org-todo-line-regexp))
   3181 	       (delete-region (point) (or (match-beginning 3)
   3182 					  (line-end-position)))
   3183 	       (insert bul)
   3184 	       (indent-line-to (+ start-ind (* delta bul-len)))
   3185 	       ;; Turn TODO keyword into a check box.
   3186 	       (when todo-state
   3187 		 (let* ((struct (org-list-struct))
   3188 			(old (copy-tree struct)))
   3189 		   (org-list-set-checkbox
   3190 		    (line-beginning-position)
   3191 		    struct
   3192 		    (if (member todo-state org-done-keywords)
   3193 			"[X]"
   3194 		      "[ ]"))
   3195 		   (org-list-write-struct struct
   3196 				          (org-list-parents-alist struct)
   3197 				          old)))
   3198 	       ;; Ensure all text down to END (or SECTION-END) belongs
   3199 	       ;; to the newly created item.
   3200 	       (let ((section-end (save-excursion
   3201 				    (or (outline-next-heading) (point)))))
   3202 		 (forward-line)
   3203 		 (funcall shift-text
   3204 			  (+ start-ind (* (1+ delta) bul-len))
   3205 			  (min end section-end)))))
   3206            (when footnote-definitions
   3207              (goto-char end)
   3208              ;; Insert footnote definitions after the list.
   3209              (unless (bolp) (forward-line 1))
   3210              ;; At (point-max).
   3211              (unless (bolp) (insert "\n"))
   3212              (dolist (def footnote-definitions)
   3213                (insert def)))))
   3214 	;; Case 3. Normal line with ARG: make the first line of region
   3215 	;;         an item, and shift indentation of others lines to
   3216 	;;         set them as item's body.
   3217 	(arg (let* ((bul (org-list-bullet-string "-"))
   3218 		    (bul-len (length bul))
   3219 		    (ref-ind (org-current-text-indentation))
   3220                     (footnote-definitions
   3221                      (funcall extract-footnote-definitions end)))
   3222 	       (skip-chars-forward " \t")
   3223 	       (insert bul)
   3224 	       (forward-line)
   3225 	       (while (< (point) end)
   3226 		 ;; Ensure that lines less indented than first one
   3227 		 ;; still get included in item body.
   3228 		 (funcall shift-text
   3229 			  (+ ref-ind bul-len)
   3230 			  (min end (save-excursion (or (outline-next-heading)
   3231 						       (point)))))
   3232 		 (forward-line))
   3233                (when footnote-definitions
   3234                  ;; If the new list is followed by same-level items,
   3235                  ;; move past them as well.
   3236                  (goto-char (org-element-end
   3237                              (org-element-lineage
   3238                               (org-element-at-point (1- end))
   3239                               'plain-list t)))
   3240                  ;; Insert footnote definitions after the list.
   3241                  (unless (bolp) (forward-line 1))
   3242                  ;; At (point-max).
   3243                  (unless (bolp) (insert "\n"))
   3244                  (dolist (def footnote-definitions)
   3245                    (insert def)))))
   3246 	;; Case 4. Normal line without ARG: turn each non-item line
   3247 	;;         into an item.
   3248 	(t
   3249 	 (while (< (point) end)
   3250 	   (unless (or (org-at-heading-p) (org-at-item-p))
   3251 	     (when (looking-at "\\([ \t]*\\)\\(\\S-\\)")
   3252 	       (replace-match
   3253 		(concat "\\1" (org-list-bullet-string "-") "\\2"))))
   3254 	   (forward-line))))))))
   3255 
   3256 
   3257 ;;; Send and receive lists
   3258 
   3259 (defun org-list-to-lisp (&optional delete)
   3260   "Parse the list at point and maybe DELETE it.
   3261 
   3262 Return a list whose car is a symbol of list type, among
   3263 `ordered', `unordered' and `descriptive'.  Then, each item is
   3264 a list of strings and other sub-lists.
   3265 
   3266 For example, the following list:
   3267 
   3268   1. first item
   3269      + sub-item one
   3270      + [X] sub-item two
   3271      more text in first item
   3272   2. [@3] last item
   3273 
   3274 is parsed as
   3275 
   3276  (ordered
   3277   (\"first item\"
   3278    (unordered
   3279     (\"sub-item one\")
   3280     (\"[X] sub-item two\"))
   3281    \"more text in first item\")
   3282   (\"[@3] last item\"))
   3283 
   3284 Point is left at list's end."
   3285   (letrec ((struct (org-list-struct))
   3286 	   (prevs (org-list-prevs-alist struct))
   3287 	   (parents (org-list-parents-alist struct))
   3288 	   (top (org-list-get-top-point struct))
   3289 	   (bottom (org-list-get-bottom-point struct))
   3290 	   (trim
   3291 	    (lambda (text)
   3292 	      ;; Remove indentation and final newline from TEXT.
   3293 	      (org-remove-indentation
   3294 	       (if (string-match-p "\n\\'" text)
   3295 		   (substring text 0 -1)
   3296 		 text))))
   3297 	   (parse-sublist
   3298 	    (lambda (e)
   3299 	      ;; Return a list whose car is list type and cdr a list
   3300 	      ;; of items' body.
   3301 	      (cons (org-list-get-list-type (car e) struct prevs)
   3302 		    (mapcar parse-item e))))
   3303 	   (parse-item
   3304 	    (lambda (e)
   3305 	      ;; Return a list containing counter of item, if any,
   3306 	      ;; text and any sublist inside it.
   3307 	      (let* ((end (org-list-get-item-end e struct))
   3308 		     (children (org-list-get-children e struct parents))
   3309 		     (body
   3310 		      (save-excursion
   3311 			(goto-char e)
   3312 			(looking-at "[ \t]*\\S-+[ \t]*")
   3313 			(list
   3314 			 (funcall
   3315 			  trim
   3316 			  (concat
   3317 			   (make-string (string-width (match-string 0)) ?\s)
   3318 			   (buffer-substring-no-properties
   3319 			    (match-end 0) (or (car children) end))))))))
   3320 		(while children
   3321 		  (let* ((child (car children))
   3322 			 (sub (org-list-get-all-items child struct prevs))
   3323 			 (last-in-sub (car (last sub))))
   3324 		    (push (funcall parse-sublist sub) body)
   3325 		    ;; Remove whole sub-list from children.
   3326 		    (setq children (cdr (memq last-in-sub children)))
   3327 		    ;; There is a chunk of text belonging to the item
   3328 		    ;; if last child doesn't end where next child
   3329 		    ;; starts or where item ends.
   3330 		    (let ((sub-end (org-list-get-item-end last-in-sub struct))
   3331 			  (next (or (car children) end)))
   3332 		      (when (/= sub-end next)
   3333 			(push (funcall
   3334 			       trim
   3335 			       (buffer-substring-no-properties sub-end next))
   3336 			      body)))))
   3337 		(nreverse body)))))
   3338     ;; Store output, take care of cursor position and deletion of
   3339     ;; list, then return output.
   3340     (prog1 (funcall parse-sublist (org-list-get-all-items top struct prevs))
   3341       (goto-char top)
   3342       (when delete
   3343 	(delete-region top bottom)
   3344 	(when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re))
   3345 	  (replace-match ""))))))
   3346 
   3347 (defun org-list-make-subtree ()
   3348   "Convert the plain list at point into a subtree."
   3349   (interactive)
   3350   (let ((item (org-in-item-p)))
   3351     (unless item (error "Not in a list"))
   3352     (goto-char item)
   3353     (let ((level (pcase (org-current-level)
   3354 		   (`nil 1)
   3355 		   (l (1+ (org-reduced-level l)))))
   3356 	  (list (save-excursion (org-list-to-lisp t))))
   3357       (insert (org-list-to-subtree list level) "\n"))))
   3358 
   3359 (defun org-list-to-generic (list params)
   3360   "Convert a LIST parsed through `org-list-to-lisp' to a custom format.
   3361 
   3362 LIST is a list as returned by `org-list-to-lisp', which see.
   3363 PARAMS is a property list of parameters used to tweak the output
   3364 format.
   3365 
   3366 Valid parameters are:
   3367 
   3368 :backend, :raw
   3369 
   3370   Export backend used as a basis to transcode elements of the
   3371   list, when no specific parameter applies to it.  It is also
   3372   used to translate its contents.  You can prevent this by
   3373   setting :raw property to a non-nil value.
   3374 
   3375 :splice
   3376 
   3377   When non-nil, only export the contents of the top most plain
   3378   list, effectively ignoring its opening and closing lines.
   3379 
   3380 :ustart, :uend
   3381 
   3382   Strings to start and end an unordered list.  They can also be
   3383   set to a function returning a string or nil, which will be
   3384   called with the depth of the list, counting from 1.
   3385 
   3386 :ostart, :oend
   3387 
   3388   Strings to start and end an ordered list.  They can also be set
   3389   to a function returning a string or nil, which will be called
   3390   with the depth of the list, counting from 1.
   3391 
   3392 :dstart, :dend
   3393 
   3394   Strings to start and end a descriptive list.  They can also be
   3395   set to a function returning a string or nil, which will be
   3396   called with the depth of the list, counting from 1.
   3397 
   3398 :dtstart, :dtend, :ddstart, :ddend
   3399 
   3400   Strings to start and end a descriptive term.
   3401 
   3402 :istart, :iend
   3403 
   3404   Strings to start or end a list item, and to start a list item
   3405   with a counter.  They can also be set to a function returning
   3406   a string or nil, which will be called with two arguments: the
   3407   type of list and the depth of the item, counting from 1.
   3408 
   3409 :icount
   3410 
   3411   Strings to start a list item with a counter.  It can also be
   3412   set to a function returning a string or nil, which will be
   3413   called with three arguments: the type of list, the depth of the
   3414   item, counting from 1, and the counter.  Its value, when
   3415   non-nil, has precedence over `:istart'.
   3416 
   3417 :isep
   3418 
   3419   String used to separate items.  It can also be set to
   3420   a function returning a string or nil, which will be called with
   3421   two arguments: the type of list and the depth of the item,
   3422   counting from 1.  It always start on a new line.
   3423 
   3424 :ifmt
   3425 
   3426   Function to be applied to the contents of every item.  It is
   3427   called with two arguments: the type of list and the contents.
   3428 
   3429 :cbon, :cboff, :cbtrans
   3430 
   3431   String to insert, respectively, an un-checked check-box,
   3432   a checked check-box and a check-box in transitional state."
   3433   (require 'ox)
   3434   (let* ((backend (plist-get params :backend))
   3435 	 (custom-backend
   3436 	  (org-export-create-backend
   3437 	   :parent (or backend 'org)
   3438 	   :transcoders
   3439 	   `((plain-list . ,(org-list--to-generic-plain-list params))
   3440 	     (item . ,(org-list--to-generic-item params))
   3441 	     (macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
   3442 	 data info)
   3443     ;; Write LIST back into Org syntax and parse it.
   3444     (with-temp-buffer
   3445       (let ((org-inhibit-startup t)) (org-mode))
   3446       (letrec ((insert-list
   3447 		(lambda (l)
   3448 		  (dolist (i (cdr l))
   3449 		    (funcall insert-item i (car l)))))
   3450 	       (insert-item
   3451 		(lambda (i type)
   3452 		  (let ((start (point)))
   3453 		    (insert (if (eq type 'ordered) "1. " "- "))
   3454 		    (dolist (e i)
   3455 		      (if (consp e) (funcall insert-list e)
   3456 			(insert e)
   3457 			(insert "\n")))
   3458 		    (forward-line 0)
   3459 		    (save-excursion
   3460 		      (let ((ind (if (eq type 'ordered) 3 2)))
   3461 			(while (> (point) start)
   3462 			  (unless (looking-at-p "[ \t]*$")
   3463 			    (indent-to ind))
   3464 			  (forward-line -1))))))))
   3465 	(funcall insert-list list))
   3466       (setf data
   3467 	    (org-element-map (org-element-parse-buffer) 'plain-list
   3468 	      #'identity nil t))
   3469       (setf info (org-export-get-environment backend nil params)))
   3470     (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
   3471       (user-error "Unknown :backend value"))
   3472     (unless backend (require 'ox-org))
   3473     ;; When ':raw' property has a non-nil value, turn all objects back
   3474     ;; into Org syntax.
   3475     (when (and backend (plist-get params :raw))
   3476       (org-element-map data org-element-all-objects
   3477 	(lambda (object)
   3478 	  (org-element-set
   3479 	   object (org-element-interpret-data object)))))
   3480     ;; We use a low-level mechanism to export DATA so as to skip all
   3481     ;; usual pre-processing and post-processing, i.e., hooks, filters,
   3482     ;; Babel code evaluation, include keywords and macro expansion,
   3483     ;; and filters.
   3484     (let ((output (org-export-data-with-backend data custom-backend info)))
   3485       ;; Remove final newline.
   3486       (if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
   3487 
   3488 (defun org-list--depth (element)
   3489   "Return the level of ELEMENT within current plain list.
   3490 ELEMENT is either an item or a plain list."
   3491   (cl-count-if (lambda (ancestor) (org-element-type-p ancestor 'plain-list))
   3492 	       (org-element-lineage element nil t)))
   3493 
   3494 (defun org-list--trailing-newlines (string)
   3495   "Return the number of trailing newlines in STRING."
   3496   (with-temp-buffer
   3497     (insert string)
   3498     (skip-chars-backward " \t\n")
   3499     (count-lines (line-beginning-position 2) (point-max))))
   3500 
   3501 (defun org-list--generic-eval (value &rest args)
   3502   "Evaluate VALUE according to its type.
   3503 VALUE is either nil, a string or a function.  In the latter case,
   3504 it is called with arguments ARGS."
   3505   (cond ((null value) nil)
   3506 	((stringp value) value)
   3507 	((functionp value) (apply value args))
   3508 	(t (error "Wrong value: %s" value))))
   3509 
   3510 (defun org-list--to-generic-plain-list (params)
   3511   "Return a transcoder for `plain-list' elements.
   3512 PARAMS is a plist used to tweak the behavior of the transcoder."
   3513   (let ((ustart (plist-get params :ustart))
   3514 	(uend (plist-get params :uend))
   3515 	(ostart (plist-get params :ostart))
   3516 	(oend (plist-get params :oend))
   3517 	(dstart (plist-get params :dstart))
   3518 	(dend (plist-get params :dend))
   3519 	(splice (plist-get params :splice))
   3520 	(backend (plist-get params :backend)))
   3521     (lambda (plain-list contents info)
   3522       (let* ((type (org-element-property :type plain-list))
   3523 	     (depth (org-list--depth plain-list))
   3524 	     (start (and (not splice)
   3525 			 (org-list--generic-eval
   3526 			  (pcase type
   3527 			    (`ordered ostart)
   3528 			    (`unordered ustart)
   3529 			    (_ dstart))
   3530 			  depth)))
   3531 	     (end (and (not splice)
   3532 		       (org-list--generic-eval
   3533 			(pcase type
   3534 			  (`ordered oend)
   3535 			  (`unordered uend)
   3536 			  (_ dend))
   3537 			depth))))
   3538 	;; Make sure trailing newlines in END appear in the output by
   3539 	;; setting `:post-blank' property to their number.
   3540 	(when end
   3541 	  (org-element-put-property
   3542 	   plain-list :post-blank (org-list--trailing-newlines end)))
   3543 	;; Build output.
   3544 	(concat (and start (concat start "\n"))
   3545 		(if (or start end splice (not backend))
   3546 		    contents
   3547 		  (org-export-with-backend backend plain-list contents info))
   3548 		end)))))
   3549 
   3550 (defun org-list--to-generic-item (params)
   3551   "Return a transcoder for `item' elements.
   3552 PARAMS is a plist used to tweak the behavior of the transcoder."
   3553   (let ((backend (plist-get params :backend))
   3554 	(istart (plist-get params :istart))
   3555 	(iend (plist-get params :iend))
   3556 	(isep (plist-get params :isep))
   3557 	(icount (plist-get params :icount))
   3558 	(ifmt (plist-get params :ifmt))
   3559 	(cboff (plist-get params :cboff))
   3560 	(cbon  (plist-get params :cbon))
   3561 	(cbtrans (plist-get params :cbtrans))
   3562 	(dtstart (plist-get params :dtstart))
   3563 	(dtend (plist-get params :dtend))
   3564 	(ddstart (plist-get params :ddstart))
   3565 	(ddend (plist-get params :ddend)))
   3566     (lambda (item contents info)
   3567       (let* ((type
   3568 	      (org-element-property :type (org-element-parent item)))
   3569 	     (tag (org-element-property :tag item))
   3570 	     (depth (org-list--depth item))
   3571 	     (separator (and (org-export-get-next-element item info)
   3572 			     (org-list--generic-eval isep type depth)))
   3573 	     (closing (pcase (org-list--generic-eval iend type depth)
   3574 			((or `nil "") "\n")
   3575 			((and (guard separator) s)
   3576 			 (if (equal (substring s -1) "\n") s (concat s "\n")))
   3577 			(s s))))
   3578 	;; When a closing line or a separator is provided, make sure
   3579 	;; its trailing newlines are taken into account when building
   3580 	;; output.  This is done by setting `:post-blank' property to
   3581 	;; the number of such lines in the last line to be added.
   3582 	(let ((last-string (or separator closing)))
   3583 	  (when last-string
   3584 	    (org-element-put-property
   3585 	     item
   3586 	     :post-blank
   3587 	     (max (1- (org-list--trailing-newlines last-string)) 0))))
   3588 	;; Build output.
   3589 	(concat
   3590 	 (let ((c (org-element-property :counter item)))
   3591 	   (if (and c icount) (org-list--generic-eval icount type depth c)
   3592 	     (org-list--generic-eval istart type depth)))
   3593 	 (let ((body
   3594 		(if (or istart iend icount ifmt cbon cboff cbtrans (not backend)
   3595 			(and (eq type 'descriptive)
   3596 			     (or dtstart dtend ddstart ddend)))
   3597 		    (concat
   3598 		     (pcase (org-element-property :checkbox item)
   3599 		       (`on cbon)
   3600 		       (`off cboff)
   3601 		       (`trans cbtrans))
   3602 		     (and tag
   3603 			  (concat dtstart
   3604 				  (if backend
   3605 				      (org-export-data-with-backend
   3606 				       tag backend info)
   3607 				    (org-element-interpret-data tag))
   3608 				  dtend))
   3609 		     (and tag ddstart)
   3610 		     (let ((contents
   3611 			    (if (= (length contents) 0) ""
   3612 			      (substring contents 0 -1))))
   3613 		       (if ifmt (org-list--generic-eval ifmt type contents)
   3614 			 contents))
   3615 		     (and tag ddend))
   3616 		  (org-export-with-backend backend item contents info))))
   3617 	   ;; Remove final newline.
   3618 	   (if (equal body "") ""
   3619 	     (substring (org-element-normalize-string body) 0 -1)))
   3620 	 closing
   3621 	 separator)))))
   3622 
   3623 (defun org-list-to-latex (list &optional params)
   3624   "Convert LIST into a LaTeX list.
   3625 LIST is a parsed plain list, as returned by `org-list-to-lisp'.
   3626 PARAMS is a property list with overruling parameters for
   3627 `org-list-to-generic'.  Return converted list as a string."
   3628   (require 'ox-latex)
   3629   (org-list-to-generic list (org-combine-plists '(:backend latex) params)))
   3630 
   3631 (defun org-list-to-html (list &optional params)
   3632   "Convert LIST into a HTML list.
   3633 LIST is a parsed plain list, as returned by `org-list-to-lisp'.
   3634 PARAMS is a property list with overruling parameters for
   3635 `org-list-to-generic'.  Return converted list as a string."
   3636   (require 'ox-html)
   3637   (org-list-to-generic list (org-combine-plists '(:backend html) params)))
   3638 
   3639 (defun org-list-to-texinfo (list &optional params)
   3640   "Convert LIST into a Texinfo list.
   3641 LIST is a parsed plain list, as returned by `org-list-to-lisp'.
   3642 PARAMS is a property list with overruling parameters for
   3643 `org-list-to-generic'.  Return converted list as a string."
   3644   (require 'ox-texinfo)
   3645   (org-list-to-generic list (org-combine-plists '(:backend texinfo) params)))
   3646 
   3647 (defun org-list-to-org (list &optional params)
   3648   "Convert LIST into an Org plain list.
   3649 LIST is as returned by `org-list-parse-list'.  PARAMS is a property list
   3650 with overruling parameters for `org-list-to-generic'."
   3651   (let* ((make-item
   3652 	  (lambda (type _depth &optional c)
   3653 	    (concat (if (eq type 'ordered) "1. " "- ")
   3654 		    (and c (format "[@%d] " c)))))
   3655 	 (defaults
   3656 	   (list :istart make-item
   3657 		 :icount make-item
   3658 		 :ifmt (lambda (_type contents)
   3659 			 (replace-regexp-in-string "\n" "\n  " contents))
   3660 		 :dtend " :: "
   3661 		 :cbon "[X] "
   3662 		 :cboff "[ ] "
   3663 		 :cbtrans "[-] ")))
   3664     (org-list-to-generic list (org-combine-plists defaults params))))
   3665 
   3666 (defun org-list-to-subtree (list &optional start-level params)
   3667   "Convert LIST into an Org subtree.
   3668 LIST is as returned by `org-list-to-lisp'.  Subtree starts at
   3669 START-LEVEL or level 1 if nil.  PARAMS is a property list with
   3670 overruling parameters for `org-list-to-generic'."
   3671   (let* ((blank (pcase (cdr (assq 'heading org-blank-before-new-entry))
   3672 		  (`t t)
   3673 		  (`auto (save-excursion
   3674 			   (org-with-limited-levels (outline-previous-heading))
   3675 			   (org-previous-line-empty-p)))))
   3676 	 (level (or start-level 1))
   3677 	 (make-stars
   3678 	  (lambda (_type depth &optional _count)
   3679 	    ;; Return the string for the heading, depending on DEPTH
   3680 	    ;; of current sub-list.
   3681 	    (let ((oddeven-level (+ level (1- depth))))
   3682 	      (concat (make-string (if org-odd-levels-only
   3683 				       (1- (* 2 oddeven-level))
   3684 				     oddeven-level)
   3685 				   ?*)
   3686 		      " ")))))
   3687     (org-list-to-generic
   3688      list
   3689      (org-combine-plists
   3690       (list :splice t
   3691 	    :istart make-stars
   3692 	    :icount make-stars
   3693 	    :dtstart " " :dtend " "
   3694 	    :isep (if blank "\n\n" "\n")
   3695 	    :cbon "DONE " :cboff "TODO " :cbtrans "TODO ")
   3696       params))))
   3697 
   3698 (provide 'org-list)
   3699 
   3700 ;; Local variables:
   3701 ;; generated-autoload-file: "org-loaddefs.el"
   3702 ;; End:
   3703 
   3704 ;;; org-list.el ends here