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