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