org-list.el 70 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882
  1. ;;; org-list.el --- Plain lists for Org-mode
  2. ;;
  3. ;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
  4. ;; Free Software Foundation, Inc.
  5. ;;
  6. ;; Author: Carsten Dominik <carsten at orgmode dot org>
  7. ;; Bastien Guerry <bzg AT altern DOT org>
  8. ;; Keywords: outlines, hypermedia, calendar, wp
  9. ;; Homepage: http://orgmode.org
  10. ;; Version: 7.01trans
  11. ;;
  12. ;; This file is part of GNU Emacs.
  13. ;;
  14. ;; GNU Emacs is free software: you can redistribute it and/or modify
  15. ;; it under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation, either version 3 of the License, or
  17. ;; (at your option) any later version.
  18. ;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. ;; GNU General Public License for more details.
  22. ;; 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. ;; This file contains the code dealing with plain lists in Org-mode.
  28. ;;; Code:
  29. (eval-when-compile
  30. (require 'cl))
  31. (require 'org-macs)
  32. (require 'org-compat)
  33. (defvar org-blank-before-new-entry)
  34. (defvar org-M-RET-may-split-line)
  35. (defvar org-complex-heading-regexp)
  36. (defvar org-odd-levels-only)
  37. (declare-function org-invisible-p "org" ())
  38. (declare-function org-on-heading-p "org" (&optional invisible-ok))
  39. (declare-function outline-next-heading "outline" ())
  40. (declare-function org-back-to-heading "org" (&optional invisible-ok))
  41. (declare-function org-back-over-empty-lines "org" ())
  42. (declare-function org-skip-whitespace "org" ())
  43. (declare-function org-trim "org" (s))
  44. (declare-function org-get-indentation "org" (&optional line))
  45. (declare-function org-timer-item "org-timer" (&optional arg))
  46. (declare-function org-combine-plists "org" (&rest plists))
  47. (declare-function org-entry-get "org"
  48. (pom property &optional inherit literal-nil))
  49. (declare-function org-narrow-to-subtree "org" ())
  50. (declare-function org-show-subtree "org" ())
  51. (defgroup org-plain-lists nil
  52. "Options concerning plain lists in Org-mode."
  53. :tag "Org Plain lists"
  54. :group 'org-structure)
  55. (defcustom org-cycle-include-plain-lists t
  56. "When t, make TAB cycle visibility on plain list items.
  57. Cycling plain lists works only when the cursor is on a plain list
  58. item. When the cursor is on an outline heading, plain lists are
  59. treated as text. This is the most stable way of handling this,
  60. which is why it is the default.
  61. When this is the symbol `integrate', then during cycling, plain
  62. list items will *temporarily* be interpreted as outline headlines
  63. with a level given by 1000+i where i is the indentation of the
  64. bullet. This setting can lead to strange effects when switching
  65. visibility to `children', because the first \"child\" in a
  66. subtree decides what children should be listed. If that first
  67. \"child\" is a plain list item with an implied large level
  68. number, all true children and grand children of the outline
  69. heading will be exposed in a children' view."
  70. :group 'org-plain-lists
  71. :type '(choice
  72. (const :tag "Never" nil)
  73. (const :tag "With cursor in plain list (recommended)" t)
  74. (const :tag "As children of outline headings" integrate)))
  75. (defcustom org-list-demote-modify-bullet nil
  76. "Default bullet type installed when demoting an item.
  77. This is an association list, for each bullet type, this alist will point
  78. to the bullet that should be used when this item is demoted.
  79. For example,
  80. (setq org-list-demote-modify-bullet
  81. '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\")))
  82. will make
  83. + Movies
  84. + Silence of the Lambs
  85. + My Cousin Vinny
  86. + Books
  87. + The Hunt for Red October
  88. + The Road to Omaha
  89. into
  90. + Movies
  91. - Silence of the Lambs
  92. - My Cousin Vinny
  93. + Books
  94. - The Hunt for Red October
  95. - The Road to Omaha"
  96. :group 'org-plain-lists
  97. :type '(repeat
  98. (cons
  99. (choice :tag "If the current bullet is "
  100. (const "-")
  101. (const "+")
  102. (const "*")
  103. (const "1.")
  104. (const "1)"))
  105. (choice :tag "demotion will change it to"
  106. (const "-")
  107. (const "+")
  108. (const "*")
  109. (const "1.")
  110. (const "1)")))))
  111. (defcustom org-plain-list-ordered-item-terminator t
  112. "The character that makes a line with leading number an ordered list item.
  113. Valid values are ?. and ?\). To get both terminators, use t. While
  114. ?. may look nicer, it creates the danger that a line with leading
  115. number may be incorrectly interpreted as an item. ?\) therefore is
  116. the safe choice."
  117. :group 'org-plain-lists
  118. :type '(choice (const :tag "dot like in \"2.\"" ?.)
  119. (const :tag "paren like in \"2)\"" ?\))
  120. (const :tab "both" t)))
  121. (defcustom org-list-two-spaces-after-bullet-regexp nil
  122. "A regular expression matching bullets that should have 2 spaces after them.
  123. When nil, no bullet will have two spaces after them.
  124. When a string, it will be used as a regular expression. When the
  125. bullet type of a list is changed, the new bullet type will be
  126. matched against this regexp. If it matches, there will be two
  127. spaces instead of one after the bullet in each item of the list."
  128. :group 'org-plain-lists
  129. :type '(choice
  130. (const :tag "never" nil)
  131. (regexp)))
  132. (defcustom org-empty-line-terminates-plain-lists nil
  133. "Non-nil means an empty line ends all plain list levels.
  134. Otherwise, look for `org-list-end-regexp'."
  135. :group 'org-plain-lists
  136. :type 'boolean)
  137. (defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
  138. "Regexp matching the end of all plain list levels.
  139. It must start with \"^\" and end with \"\\n\". It defaults to 2
  140. blank lines. `org-empty-line-terminates-plain-lists' has
  141. precedence over it."
  142. :group 'org-plain-lists
  143. :type 'string)
  144. (defcustom org-list-automatic-rules '((bullet . t)
  145. (checkbox . t)
  146. (indent . t)
  147. (insert . t)
  148. (renumber . t))
  149. "Non-nil means apply set of rules when acting on lists.
  150. By default, automatic actions are taken when using
  151. \\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return],
  152. \\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright],
  153. \\[org-shiftmetaleft], \\[org-ctrl-c-minus],
  154. \\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can
  155. disable individually these rules by setting them to nil. Valid
  156. rules are:
  157. bullet when non-nil, cycling bullet do not allow lists at
  158. column 0 to have * as a bullet and descriptions lists
  159. to be numbered.
  160. checkbox when non-nil, checkbox statistics is updated each time
  161. you either insert a new checkbox or toggle a checkbox.
  162. It also prevents from inserting a checkbox in a
  163. description item.
  164. indent when non-nil indenting or outdenting list top-item with
  165. its subtree will move the whole list and outdenting a
  166. list whose bullet is * to column 0 will change that
  167. bullet to -.
  168. insert when non-nil, trying to insert an item inside a block
  169. will insert it right before the block instead of
  170. throwing an error.
  171. renumber when non-nil, renumber ordered plain lists whenever it
  172. is modified. You can always use \\[org-ctrl-c-ctrl-c]
  173. to trigger renumbering."
  174. :group 'org-plain-lists
  175. :type '(alist :tag "Sets of rules"
  176. :key-type
  177. (choice
  178. (const :tag "Bullet" bullet)
  179. (const :tag "Checkbox" checkbox)
  180. (const :tag "Indent" indent)
  181. (const :tag "Insert" insert)
  182. (const :tag "Renumber" renumber))
  183. :value-type
  184. (boolean :tag "Activate" :value t)))
  185. (defcustom org-hierarchical-checkbox-statistics t
  186. "Non-nil means checkbox statistics counts only the state of direct children.
  187. When nil, all boxes below the cookie are counted.
  188. This can be set to nil on a per-node basis using a COOKIE_DATA property
  189. with the word \"recursive\" in the value."
  190. :group 'org-plain-lists
  191. :type 'boolean)
  192. (defcustom org-description-max-indent 20
  193. "Maximum indentation for the second line of a description list.
  194. When the indentation would be larger than this, it will become
  195. 5 characters instead."
  196. :group 'org-plain-lists
  197. :type 'integer)
  198. (defcustom org-list-radio-list-templates
  199. '((latex-mode "% BEGIN RECEIVE ORGLST %n
  200. % END RECEIVE ORGLST %n
  201. \\begin{comment}
  202. #+ORGLST: SEND %n org-list-to-latex
  203. -
  204. \\end{comment}\n")
  205. (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
  206. @c END RECEIVE ORGLST %n
  207. @ignore
  208. #+ORGLST: SEND %n org-list-to-texinfo
  209. -
  210. @end ignore\n")
  211. (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
  212. <!-- END RECEIVE ORGLST %n -->
  213. <!--
  214. #+ORGLST: SEND %n org-list-to-html
  215. -
  216. -->\n"))
  217. "Templates for radio lists in different major modes.
  218. All occurrences of %n in a template will be replaced with the name of the
  219. list, obtained by prompting the user."
  220. :group 'org-plain-lists
  221. :type '(repeat
  222. (list (symbol :tag "Major mode")
  223. (string :tag "Format"))))
  224. ;;; Internal functions
  225. (defun org-list-end-re ()
  226. "Return the regex corresponding to the end of a list.
  227. It depends on `org-empty-line-terminates-plain-lists'."
  228. (if org-empty-line-terminates-plain-lists
  229. "^[ \t]*\n"
  230. org-list-end-regexp))
  231. (defun org-item-re (&optional general)
  232. "Return the correct regular expression for plain lists.
  233. If GENERAL is non-nil, return the general regexp independent of the value
  234. of `org-plain-list-ordered-item-terminator'."
  235. (cond
  236. ((or general (eq org-plain-list-ordered-item-terminator t))
  237. "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  238. ((= org-plain-list-ordered-item-terminator ?.)
  239. "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  240. ((= org-plain-list-ordered-item-terminator ?\))
  241. "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  242. (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
  243. (defconst org-item-beginning-re (concat "^" (org-item-re))
  244. "Regexp matching the beginning of a plain list item.")
  245. (defun org-list-terminator-between (min max &optional firstp)
  246. "Find the position of a list ender between MIN and MAX, or nil.
  247. This function looks for `org-list-end-re' outside a block.
  248. If FIRSTP in non-nil, return the point at the beginning of the
  249. nearest valid terminator from min. Otherwise, return the point at
  250. the end of the nearest terminator from max."
  251. (save-excursion
  252. (let* ((start (if firstp min max))
  253. (end (if firstp max min))
  254. (search-fun (if firstp
  255. #'org-search-forward-unenclosed
  256. #'org-search-backward-unenclosed))
  257. (list-end-p (progn
  258. (goto-char start)
  259. (funcall search-fun (org-list-end-re) end t))))
  260. ;; Is there a valid list terminator somewhere ?
  261. (and list-end-p
  262. ;; we want to be on the first line of the list ender
  263. (match-beginning 0)))))
  264. (defun org-list-search-unenclosed-generic (search-fun regexp bound noerror count)
  265. "Search for REGEXP with SEARCH-FUN but don't stop inside blocks or at protected places."
  266. (let ((origin (point)))
  267. (cond
  268. ;; nothing found: return nil
  269. ((not (funcall search-fun regexp bound noerror count)) nil)
  270. ((or (save-match-data
  271. (org-in-regexps-block-p "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  272. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2))))
  273. (get-text-property (match-beginning 0) 'org-protected))
  274. ;; match is enclosed or protected: start again, searching one
  275. ;; occurrence away.
  276. (goto-char origin)
  277. (org-list-search-unenclosed-generic search-fun regexp bound noerror (1+ count)))
  278. ;; else return point.
  279. (t (point)))))
  280. (defun org-search-backward-unenclosed (regexp &optional bound noerror)
  281. "Like `re-search-backward' but don't stop inside blocks or at protected places."
  282. (org-list-search-unenclosed-generic #'re-search-backward regexp bound noerror 1))
  283. (defun org-search-forward-unenclosed (regexp &optional bound noerror)
  284. "Like `re-search-forward' but don't stop inside blocks or at protected places."
  285. (org-list-search-unenclosed-generic #'re-search-forward regexp bound noerror 1))
  286. (defun org-list-at-regexp-after-bullet-p (regexp)
  287. "Is point at a list item with REGEXP after bullet?"
  288. (and (org-at-item-p)
  289. (save-excursion
  290. (goto-char (match-end 0))
  291. ;; Ignore counter if any
  292. (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?")
  293. (goto-char (match-end 0)))
  294. (looking-at regexp))))
  295. (defun org-list-get-item-same-level (search-fun pos limit pre-move)
  296. "Return point at the beginning of next item at the same level.
  297. Search items using function SEARCH-FUN, from POS to LIMIT. It
  298. uses PRE-MOVE before search. Return nil if no item was found."
  299. (save-excursion
  300. (goto-char pos)
  301. (let ((ind (progn
  302. (org-beginning-of-item)
  303. (org-get-indentation)))
  304. (start (point-at-bol)))
  305. ;; We don't want to match the current line.
  306. (funcall pre-move)
  307. ;; Skip any sublist on the way
  308. (while (and (funcall search-fun org-item-beginning-re limit t)
  309. (> (org-get-indentation) ind)))
  310. (when (and (/= (point-at-bol) start) ; Have we moved ?
  311. (= (org-get-indentation) ind))
  312. (point-at-bol)))))
  313. (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
  314. "Insert a new list item at POS.
  315. If POS is before first character after bullet of the item, the
  316. new item will be created before the current one.
  317. Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
  318. after the bullet. Cursor will be after this text once the
  319. function ends."
  320. (goto-char pos)
  321. ;; Is point in a special block?
  322. (when (org-in-regexps-block-p
  323. "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  324. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
  325. (if (not (cdr (assq 'insert org-list-automatic-rules)))
  326. ;; Rule in `org-list-automatic-rules' forbids insertion.
  327. (error "Cannot insert item inside a block.")
  328. ;; Else, move before it prior to add a new item.
  329. (end-of-line)
  330. (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
  331. (end-of-line 0)))
  332. (let* ((true-pos (point))
  333. (bullet (and (org-beginning-of-item)
  334. (org-list-bullet-string (org-get-bullet))))
  335. (ind (org-get-indentation))
  336. (before-p (progn
  337. ;; Description item: text starts after colons.
  338. (or (org-at-item-description-p)
  339. ;; At a checkbox: text starts after it.
  340. (org-at-item-checkbox-p)
  341. ;; Otherwise, text starts after bullet.
  342. (org-at-item-p))
  343. (<= true-pos (match-end 0))))
  344. ;; Guess number of blank lines used to separate items.
  345. (blank-lines-nb
  346. (let ((insert-blank-p
  347. (cdr (assq 'plain-list-item org-blank-before-new-entry)))
  348. usr-blank)
  349. (cond
  350. ;; Trivial cases where there should be none.
  351. ((or org-empty-line-terminates-plain-lists
  352. (not insert-blank-p)) 0)
  353. ;; When `org-blank-before-new-entry' says so, it is 1.
  354. ((eq insert-blank-p t) 1)
  355. ;; plain-list-item is 'auto. Count blank lines separating
  356. ;; neighbours items in list.
  357. (t (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  358. (cond
  359. ;; Is there a next item?
  360. (next-p (goto-char next-p)
  361. (org-back-over-empty-lines))
  362. ;; Is there a previous item?
  363. ((not (org-list-first-item-p)) (org-back-over-empty-lines))
  364. ;; User inserted blank lines, trust him
  365. ((and (> true-pos (org-end-of-item-before-blank))
  366. (> (save-excursion
  367. (goto-char true-pos)
  368. (skip-chars-backward " \t")
  369. (setq usr-blank (org-back-over-empty-lines))) 0))
  370. usr-blank)
  371. ;; Item alone: count lines separating it from parent, if any
  372. ((/= (org-list-top-point) (point-at-bol))
  373. (org-back-over-empty-lines))
  374. ;; Are there blank lines inside the item ?
  375. ((save-excursion
  376. (org-search-forward-unenclosed
  377. "^[ \t]*$" (org-end-of-item-before-blank) t)) 1)
  378. ;; No parent: no blank line.
  379. (t 0)))))))
  380. (insert-fun
  381. (lambda (text)
  382. ;; insert bullet above item in order to avoid bothering
  383. ;; with possible blank lines ending last item.
  384. (org-beginning-of-item)
  385. (indent-to-column ind)
  386. (insert (concat bullet (when checkbox "[ ] ") after-bullet))
  387. ;; Stay between after-bullet and before text.
  388. (save-excursion
  389. (insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
  390. (unless before-p (org-move-item-down))
  391. (when checkbox (org-update-checkbox-count-maybe)))))
  392. (goto-char true-pos)
  393. (cond
  394. (before-p (funcall insert-fun nil)
  395. ;; Not taking advantage of renumbering while moving
  396. ;; down. Need to call it directly.
  397. (org-maybe-renumber-ordered-list) t)
  398. ;; Can't split item: insert bullet at the end of item.
  399. ((not (org-get-alist-option org-M-RET-may-split-line 'item))
  400. (funcall insert-fun nil) t)
  401. ;; else, insert a new bullet along with everything from point
  402. ;; down to last non-blank line of item.
  403. (t
  404. (delete-horizontal-space)
  405. ;; Get pos again in case previous command modified line.
  406. (let* ((pos (point))
  407. (end-before-blank (org-end-of-item-before-blank))
  408. (after-text
  409. (when (< pos end-before-blank)
  410. (prog1
  411. (delete-and-extract-region pos end-before-blank)
  412. ;; delete any blank line at and before point.
  413. (beginning-of-line)
  414. (while (looking-at "^[ \t]*$")
  415. (delete-region (point-at-bol) (1+ (point-at-eol)))
  416. (beginning-of-line 0))))))
  417. (funcall insert-fun after-text) t)))))
  418. ;;; Predicates
  419. (defun org-in-item-p ()
  420. "Is the cursor inside a plain list ?"
  421. (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p))
  422. (save-excursion
  423. (let* ((limit (save-excursion (outline-previous-heading)))
  424. ;; Move to eol so current line can be matched by `org-item-re'.
  425. (actual-pos (goto-char (point-at-eol)))
  426. (last-item-start (save-excursion
  427. (org-search-backward-unenclosed org-item-beginning-re limit t)))
  428. (list-ender (org-list-terminator-between last-item-start actual-pos)))
  429. ;; We are in a list when we are on an item line or when we can
  430. ;; find an item before point and there is no valid list ender
  431. ;; between it and the point.
  432. (and last-item-start
  433. (not list-ender))))))
  434. (defun org-list-first-item-p ()
  435. "Is this item the first item in a plain list?"
  436. (save-excursion
  437. (= (org-beginning-of-item) (org-beginning-of-item-list))))
  438. (defun org-at-item-p ()
  439. "Is point in a line starting a hand-formatted item?"
  440. (save-excursion
  441. (beginning-of-line) (looking-at org-item-beginning-re)))
  442. (defun org-at-item-bullet-p ()
  443. "Is point at the bullet of a plain list item?"
  444. (and (org-at-item-p)
  445. (not (member (char-after) '(?\ ?\t)))
  446. (< (point) (match-end 0))))
  447. (defun org-at-item-timer-p ()
  448. "Is point at a line starting a plain list item with a timer?"
  449. (org-list-at-regexp-after-bullet-p "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
  450. (defun org-at-item-description-p ()
  451. "Is point at a description list item?"
  452. (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
  453. (defun org-at-item-checkbox-p ()
  454. "Is point at a line starting a plain-list item with a checklet?"
  455. (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
  456. (defun org-checkbox-blocked-p ()
  457. "Is the current checkbox blocked from for being checked now?
  458. A checkbox is blocked if all of the following conditions are fulfilled:
  459. 1. The checkbox is not checked already.
  460. 2. The current entry has the ORDERED property set.
  461. 3. There is an unchecked checkbox in this entry before the current line."
  462. (catch 'exit
  463. (save-match-data
  464. (save-excursion
  465. (unless (org-at-item-checkbox-p) (throw 'exit nil))
  466. (when (equal (match-string 1) "[X]")
  467. ;; the box is already checked!
  468. (throw 'exit nil))
  469. (let ((end (point-at-bol)))
  470. (condition-case nil (org-back-to-heading t)
  471. (error (throw 'exit nil)))
  472. (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
  473. (when (org-search-forward-unenclosed
  474. "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@start:[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t)
  475. (org-current-line)))))))
  476. ;;; Navigate
  477. (defun org-list-top-point ()
  478. "Return point at the top level item in a list, or nil if not in a list."
  479. (save-excursion
  480. (and (org-in-item-p)
  481. (let ((pos (point-at-eol))
  482. (bound (or (outline-previous-heading) (point-min))))
  483. ;; Is there some list above this one ? If so, go to its ending.
  484. ;; Otherwise, go back to the heading above or bob.
  485. (goto-char (or (org-list-terminator-between bound pos) bound))
  486. ;; From there, search down our list.
  487. (org-search-forward-unenclosed org-item-beginning-re pos t)
  488. (point-at-bol)))))
  489. (defun org-list-bottom-point ()
  490. "Return point just before list ending or nil if not in a list."
  491. (save-excursion
  492. (and (org-in-item-p)
  493. (let ((pos (org-beginning-of-item))
  494. (bound (or (and (let ((outline-regexp org-outline-regexp))
  495. ;; Use default regexp because folding
  496. ;; changes OUTLINE-REGEXP.
  497. (outline-next-heading))
  498. (skip-chars-backward " \t\r\n")
  499. (1+ (point-at-eol)))
  500. (point-max))))
  501. ;; The list ending is either first point matching
  502. ;; `org-list-end-re', point at first white-line before next
  503. ;; heading, or eob.
  504. (or (org-list-terminator-between pos bound t) bound)))))
  505. (defun org-beginning-of-item ()
  506. "Go to the beginning of the current hand-formatted item.
  507. If the cursor is not in an item, throw an error. Return point."
  508. (interactive)
  509. (if (not (org-in-item-p))
  510. (error "Not in an item")
  511. ;; Possibly match the current line.
  512. (end-of-line)
  513. (org-search-backward-unenclosed org-item-beginning-re nil t)
  514. (goto-char (point-at-bol))))
  515. (defun org-end-of-item ()
  516. "Go to the end of the current hand-formatted item.
  517. If the cursor is not in an item, throw an error."
  518. (interactive)
  519. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  520. (cond ((not (org-in-item-p)) (error "Not in an item"))
  521. (next-p (goto-char next-p))
  522. (t (org-end-of-item-list)))))
  523. (defun org-end-of-item-or-at-child ()
  524. "Move to the end of the item text, stops before the first child if any."
  525. (let ((limit (org-list-bottom-point)))
  526. (end-of-line)
  527. (goto-char
  528. (if (org-search-forward-unenclosed org-item-beginning-re limit t)
  529. (point-at-bol)
  530. limit))))
  531. (defun org-end-of-item-before-blank ()
  532. "Return point at end of item, before any blank line.
  533. Point returned is at eol."
  534. (save-excursion
  535. (org-end-of-item)
  536. (skip-chars-backward " \r\t\n")
  537. (point-at-eol)))
  538. (defun org-get-next-item (pos limit)
  539. "Get the point of the next item at the same level as POS.
  540. Stop searching at LIMIT. Return nil if no item is found. This
  541. function does not move point."
  542. (org-list-get-item-same-level
  543. #'org-search-forward-unenclosed pos limit #'end-of-line))
  544. (defun org-get-previous-item (pos limit)
  545. "Get the point of the previous item at the same level as POS.
  546. Stop searching at LIMIT. Return nil if no item is found. This
  547. function does not move point."
  548. (org-list-get-item-same-level
  549. #'org-search-backward-unenclosed pos limit #'beginning-of-line))
  550. (defun org-next-item ()
  551. "Move to the beginning of the next item.
  552. Item is at the same level in the current plain list. Error if not
  553. in a plain list, or if this is the last item in the list."
  554. (interactive)
  555. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  556. (if next-p
  557. (goto-char next-p)
  558. (error "On last item"))))
  559. (defun org-previous-item ()
  560. "Move to the beginning of the previous item.
  561. Item is at the same level in the current plain list. Error if not
  562. in a plain list, or if this is the first item in the list."
  563. (interactive)
  564. (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
  565. (if prev-p
  566. (goto-char prev-p)
  567. (error "On first item"))))
  568. (defun org-beginning-of-item-list ()
  569. "Go to the beginning item of the current list or sublist.
  570. Return point."
  571. (interactive)
  572. (org-beginning-of-item)
  573. (let ((limit (org-list-top-point))
  574. (move-up (lambda (pos bound)
  575. ;; prev-p: any item of same level before ?
  576. (let ((prev-p (org-get-previous-item pos bound)))
  577. ;; recurse until no more item of the same level
  578. ;; can be found.
  579. (if (not prev-p) pos (funcall move-up prev-p bound))))))
  580. ;; Go to the last item found and at bol in case we didn't move
  581. (goto-char (funcall move-up (point) limit))
  582. (goto-char (point-at-bol))))
  583. (defun org-end-of-item-list ()
  584. "Go to the end of the current list or sublist.
  585. Return point."
  586. (interactive)
  587. (org-beginning-of-item)
  588. (let ((limit (org-list-bottom-point))
  589. (ind (org-get-indentation))
  590. (get-last-item (lambda (pos bound)
  591. ;; next-p: any item of same level after ?
  592. (let ((next-p (org-get-next-item pos bound)))
  593. ;; recurse until no more item of the same level
  594. ;; can be found.
  595. (if (not next-p) pos (funcall get-last-item next-p bound))))))
  596. ;; Move to the last item of every list or sublist encountered, and
  597. ;; down to bol of a higher-level item, or limit.
  598. (while (and (/= (point) limit)
  599. (>= (org-get-indentation) ind))
  600. (goto-char (funcall get-last-item (point) limit))
  601. (end-of-line)
  602. (when (org-search-forward-unenclosed org-item-beginning-re limit 'move)
  603. (beginning-of-line)))
  604. (point)))
  605. ;;; Manipulate
  606. (defun org-list-exchange-items (beg-A beg-B)
  607. "Swap item starting at BEG-A with item starting at BEG-B.
  608. Blank lines at the end of items are left in place. Assumes
  609. BEG-A is lesser than BEG-B."
  610. (save-excursion
  611. (let* ((end-of-item-no-blank (lambda (pos)
  612. (goto-char pos)
  613. (goto-char (org-end-of-item-before-blank))))
  614. (end-A-no-blank (funcall end-of-item-no-blank beg-A))
  615. (end-B-no-blank (funcall end-of-item-no-blank beg-B))
  616. (body-A (buffer-substring beg-A end-A-no-blank))
  617. (body-B (buffer-substring beg-B end-B-no-blank))
  618. (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
  619. (goto-char beg-A)
  620. (delete-region beg-A end-B-no-blank)
  621. (insert (concat body-B between-A-no-blank-and-B body-A)))))
  622. (defun org-move-item-down ()
  623. "Move the plain list item at point down, i.e. swap with following item.
  624. Subitems (items with larger indentation) are considered part of the item,
  625. so this really moves item trees."
  626. (interactive)
  627. (let ((pos (point))
  628. (col (current-column))
  629. (actual-item (org-beginning-of-item))
  630. (next-item (org-get-next-item (point) (save-excursion (org-end-of-item-list)))))
  631. (if (not next-item)
  632. (progn
  633. (goto-char pos)
  634. (error "Cannot move this item further down"))
  635. (org-list-exchange-items actual-item next-item)
  636. (org-maybe-renumber-ordered-list)
  637. (org-next-item)
  638. (move-to-column col))))
  639. (defun org-move-item-up ()
  640. "Move the plain list item at point up, i.e. swap with previous item.
  641. Subitems (items with larger indentation) are considered part of the item,
  642. so this really moves item trees."
  643. (interactive)
  644. (let ((pos (point))
  645. (col (current-column))
  646. (actual-item (org-beginning-of-item))
  647. (prev-item (org-get-previous-item (point) (save-excursion (org-beginning-of-item-list)))))
  648. (if (not prev-item)
  649. (progn
  650. (goto-char pos)
  651. (error "Cannot move this item further up"))
  652. (org-list-exchange-items prev-item actual-item)
  653. (org-maybe-renumber-ordered-list)
  654. (move-to-column col))))
  655. (defun org-insert-item (&optional checkbox)
  656. "Insert a new item at the current level.
  657. If cursor is before first character after bullet of the item, the
  658. new item will be created before the current one. Return t when
  659. things worked, nil when we are not in an item, or item is
  660. invisible."
  661. (unless (or (not (org-in-item-p))
  662. (org-invisible-p))
  663. (if (save-excursion
  664. (org-beginning-of-item)
  665. (org-at-item-timer-p))
  666. ;; Timer list: delegate to `org-timer-item'.
  667. (progn (org-timer-item) t)
  668. ;; if we're in a description list, ask for the new term.
  669. (let ((desc-text (when (save-excursion
  670. (and (org-beginning-of-item)
  671. (org-at-item-description-p)))
  672. (concat (read-string "Term: ") " :: "))))
  673. ;; Don't insert a checkbox if checkbox rule is applied and it
  674. ;; is a description item.
  675. (org-list-insert-item-generic
  676. (point) (and checkbox
  677. (or (not desc-text)
  678. (not (cdr (assq 'checkbox org-list-automatic-rules)))))
  679. desc-text)))))
  680. ;;; Structures
  681. ;; The idea behind structures is to avoid moving back and forth in the
  682. ;; buffer on costly operations like indenting or fixing bullets.
  683. ;; It achieves this by taking a snapshot of an interesting part of the
  684. ;; list, in the shape of an alist, with `org-list-struct'.
  685. ;; It then proceeds to changes directly on the alist. When those are
  686. ;; done, `org-list-struct-apply-struct' applies the changes in the
  687. ;; buffer.
  688. (defun org-list-struct-assoc-at-point ()
  689. "Return the structure association at point.
  690. It is a cons-cell whose key is point and values are indentation,
  691. bullet string and bullet counter, if any."
  692. (save-excursion
  693. (beginning-of-line)
  694. (list (point-at-bol)
  695. (org-get-indentation)
  696. (progn
  697. (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
  698. (match-string 1))
  699. (progn
  700. (goto-char (match-end 0))
  701. (and (looking-at "\\[@start:\\([0-9]+\\)\\]")
  702. (match-string 1))))))
  703. (defun org-list-struct (begin end &optional outdent)
  704. "Return the structure containing the list between BEGIN and END.
  705. A structure is an alist where key is point of item and values
  706. are, in that order, indentation, bullet string and value of
  707. counter, if any. A structure contains every list and sublist that
  708. has items between BEGIN and END along with their common ancestor.
  709. If no such ancestor can be found, the function will add a virtual
  710. ancestor at position 0.
  711. If OUTDENT is non-nil, it will also grab all of the parent list
  712. and the grand-parent. Setting OUTDENT to t is mandatory when next
  713. change is an outdent."
  714. (save-excursion
  715. (let* ((top (org-list-top-point))
  716. (bottom (org-list-bottom-point))
  717. struct
  718. (extend
  719. (lambda (struct)
  720. (let* ((ind-min (apply 'min (mapcar 'cadr struct)))
  721. (begin (caar struct))
  722. (end (caar (last struct)))
  723. pre-list post-list)
  724. (goto-char begin)
  725. ;; Find beginning of most outdented list (min list)
  726. (while (and (org-search-backward-unenclosed org-item-beginning-re top t)
  727. (>= (org-get-indentation) ind-min))
  728. (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list)))
  729. ;; Now get the parent. If none, add a virtual ancestor
  730. (if (< (org-get-indentation) ind-min)
  731. (setq pre-list (cons (org-list-struct-assoc-at-point) pre-list))
  732. (setq pre-list (cons (list 0 (org-get-indentation) "" nil) pre-list)))
  733. ;; Find end of min list
  734. (goto-char end)
  735. (end-of-line)
  736. (while (and (org-search-forward-unenclosed org-item-beginning-re bottom t)
  737. (>= (org-get-indentation) ind-min))
  738. (setq post-list (cons (org-list-struct-assoc-at-point) post-list)))
  739. (append pre-list struct (reverse post-list))))))
  740. ;; Here we start: first get the core zone...
  741. (goto-char end)
  742. (while (org-search-backward-unenclosed org-item-beginning-re begin t)
  743. (setq struct (cons (org-list-struct-assoc-at-point) struct)))
  744. ;; ... then, extend it to make it a structure...
  745. (let ((extended (funcall extend struct)))
  746. ;; ... twice when OUTDENT is non-nil and struct still can be
  747. ;; extended
  748. (if (and outdent (> (caar extended) 0))
  749. (funcall extend extended)
  750. extended)))))
  751. (defun org-list-struct-origins (struct)
  752. "Return an alist where key is item's position and value parent's."
  753. (let* ((struct-rev (reverse struct))
  754. (prev-item (lambda (item) (car (nth 1 (member (assq item struct) struct-rev)))))
  755. (get-origins
  756. (lambda (item)
  757. (let* ((item-pos (car item))
  758. (ind (nth 1 item))
  759. (prev-ind (caar acc)))
  760. (cond
  761. ;; List closing.
  762. ((> prev-ind ind)
  763. (setq acc (member (assq ind acc) acc))
  764. (cons item-pos (cdar acc)))
  765. ;; New list
  766. ((< prev-ind ind)
  767. (let ((origin (funcall prev-item item-pos)))
  768. (setq acc (cons (cons ind origin) acc))
  769. (cons item-pos origin)))
  770. ;; Current list going on
  771. (t (cons item-pos (cdar acc)))))))
  772. (acc (list (cons (nth 1 (car struct)) 0))))
  773. (cons '(0 . 0) (mapcar get-origins (cdr struct)))))
  774. (defun org-list-struct-get-parent (item struct origins)
  775. "Return parent association of ITEM in STRUCT or nil."
  776. (let* ((parent-pos (cdr (assq (car item) origins))))
  777. (when (> parent-pos 0) (assq parent-pos struct))))
  778. (defun org-list-struct-get-child (item struct)
  779. "Return child association of ITEM in STRUCT or nil."
  780. (let ((ind (nth 1 item))
  781. (next-item (cadr (member item struct))))
  782. (when (and next-item (> (nth 1 next-item) ind)) next-item)))
  783. (defun org-list-struct-fix-bul (struct origins)
  784. "Verify and correct bullets for every association in STRUCT.
  785. This function modifies STRUCT."
  786. (let* ((init-bul (lambda (item)
  787. (let ((counter (nth 3 item))
  788. (bullet (org-list-bullet-string (nth 2 item))))
  789. (cond
  790. ((and (string-match "[0-9]+" bullet) counter)
  791. (replace-match counter nil nil bullet))
  792. ((string-match "[0-9]+" bullet)
  793. (replace-match "1" nil nil bullet))
  794. (t bullet)))))
  795. (set-bul (lambda (item bullet)
  796. (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
  797. (get-bul (lambda (item bullet)
  798. (let* ((counter (nth 3 item)))
  799. (if (and counter (string-match "[0-9]+" bullet))
  800. (replace-match counter nil nil bullet)
  801. bullet))))
  802. (fix-bul
  803. (lambda (item) struct
  804. (let* ((parent (cdr (assq (car item) origins)))
  805. (orig-ref (assq parent acc)))
  806. (if orig-ref
  807. ;; Continuing previous list
  808. (let* ((prev-bul (cdr orig-ref))
  809. (new-bul (funcall get-bul item prev-bul)))
  810. (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
  811. (funcall set-bul item new-bul))
  812. ;; A new list is starting
  813. (let ((new-bul (funcall init-bul item)))
  814. (funcall set-bul item new-bul)
  815. (setq acc (cons (cons parent (org-list-inc-bullet-maybe new-bul)) acc)))))))
  816. acc)
  817. (mapc fix-bul (cdr struct))))
  818. (defun org-list-struct-fix-ind (struct origins)
  819. "Verify and correct indentation for every association in STRUCT.
  820. This function modifies STRUCT."
  821. (let* ((headless (cdr struct))
  822. (ancestor (car struct))
  823. (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
  824. (new-ind
  825. (lambda (item)
  826. (let* ((parent (org-list-struct-get-parent item headless origins)))
  827. (if parent
  828. ;; Indent like parent + length of parent's bullet
  829. (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent)) (cddr item)))
  830. ;; If no parent, indent like top-point
  831. (setcdr item (cons top-ind (cddr item))))))))
  832. (mapc new-ind headless)))
  833. (defun org-list-struct-fix-struct (struct origins)
  834. "Return STRUCT with correct bullets and indentation.
  835. Only elements of STRUCT that have changed are returned."
  836. (let ((before (copy-alist struct))
  837. (set-diff (lambda (setA setB result)
  838. (cond
  839. ((null setA) result)
  840. ((equal (car setA) (car setB))
  841. (funcall set-diff (cdr setA) (cdr setB) result))
  842. (t (funcall set-diff (cdr setA) (cdr setB) (cons (car setA) result)))))))
  843. (org-list-struct-fix-bul struct origins)
  844. (org-list-struct-fix-ind struct origins)
  845. (nreverse (funcall set-diff struct before nil))))
  846. (defun org-list-struct-outdent (start end origins)
  847. "Outdent items in ORIGINS between BEGIN and END.
  848. BEGIN is included and END excluded."
  849. (let ((out (lambda (cell)
  850. (let* ((item (car cell))
  851. (parent (cdr cell)))
  852. (cond
  853. ;; Item not yet in zone: keep association
  854. ((< item start) cell)
  855. ;; Item out of zone: follow associations in acc
  856. ((>= item end)
  857. (let ((convert (assq parent acc)))
  858. (if convert (cons item (cdr convert)) cell)))
  859. ;; Item has no parent: error
  860. ((<= parent 0)
  861. (error "Cannot outdent top-level items"))
  862. ;; Parent is outdented: keep association
  863. ((>= parent start)
  864. (setq acc (cons (cons parent item) acc)) cell)
  865. (t
  866. ;; Parent isn't outdented: reparent to grand-parent
  867. (let ((grand-parent (cdr (assq parent origins))))
  868. (setq acc (cons (cons parent item) acc))
  869. (cons item grand-parent)))))))
  870. acc)
  871. (mapcar out origins)))
  872. (defun org-list-struct-indent (start end origins)
  873. "Indent items in ORIGINS between BEGIN and END.
  874. BEGIN is included and END excluded."
  875. (let* ((orig-rev (reverse origins))
  876. (get-prev-item (lambda (cell parent)
  877. (car (rassq parent (cdr (memq cell orig-rev))))))
  878. (set-assoc (lambda (cell)
  879. (setq acc (cons cell acc)) cell))
  880. (ind
  881. (lambda (cell)
  882. (let* ((item (car cell))
  883. (parent (cdr cell)))
  884. (cond
  885. ;; Item not yet in zone: keep association
  886. ((< item start) cell)
  887. ((>= item end)
  888. ;; Item out of zone: follow associations in acc
  889. (let ((convert (assq parent acc)))
  890. (if convert (cons item (cdr convert)) cell)))
  891. (t
  892. ;; Item is in zone...
  893. (let ((prev (funcall get-prev-item cell parent)))
  894. (cond
  895. ;; First item indented but not parent: error
  896. ((and (or (not prev) (= prev 0)) (< parent start))
  897. (error "Cannot indent the first item of a list"))
  898. ;; First item and parent indented: keep same parent
  899. ((or (not prev) (= prev 0))
  900. (funcall set-assoc cell))
  901. ;; Previous item not indented: reparent to it
  902. ((< prev start)
  903. (funcall set-assoc (cons item prev)))
  904. ;; Previous item indented: reparent like it
  905. (t
  906. (funcall set-assoc (cons item (cdr (assq prev acc))))))))))))
  907. acc)
  908. (mapcar ind origins)))
  909. (defun org-list-struct-apply-struct (struct)
  910. "Apply modifications to list so it mirrors STRUCT.
  911. Initial position is restored after the changes."
  912. (let* ((pos (copy-marker (point)))
  913. (ancestor (caar struct))
  914. (modify
  915. (lambda (item)
  916. (goto-char (car item))
  917. (org-list-indent-item (nth 1 item))
  918. (org-list-replace-bullet (org-list-bullet-string (nth 2 item)))))
  919. ;; Remove ancestor if it is left.
  920. (struct-to-apply (if (or (not ancestor) (= 0 ancestor)) (cdr struct) struct)))
  921. ;; Apply changes from bottom to top
  922. (mapc modify (nreverse struct-to-apply))
  923. (goto-char pos)))
  924. ;;; Indentation
  925. (defun org-get-string-indentation (s)
  926. "What indentation has S due to SPACE and TAB at the beginning of the string?"
  927. (let ((n -1) (i 0) (w tab-width) c)
  928. (catch 'exit
  929. (while (< (setq n (1+ n)) (length s))
  930. (setq c (aref s n))
  931. (cond ((= c ?\ ) (setq i (1+ i)))
  932. ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
  933. (t (throw 'exit t)))))
  934. i))
  935. (defun org-shift-item-indentation (delta)
  936. "Shift the indentation in current item by DELTA.
  937. Sub-items are not moved."
  938. (save-excursion
  939. (let ((beg (point-at-bol))
  940. (end (org-end-of-item-or-at-child)))
  941. (beginning-of-line (unless (eolp) 0))
  942. (while (> (point) beg)
  943. (when (looking-at "[ \t]*\\S-")
  944. ;; this is not an empty line
  945. (let ((i (org-get-indentation)))
  946. (when (and (> i 0) (> (+ i delta) 0))
  947. (indent-line-to (+ i delta)))))
  948. (beginning-of-line 0)))))
  949. (defun org-list-indent-item (ind)
  950. "Change indentation of item at point to IND.
  951. It does not move sub-lists."
  952. (save-excursion
  953. (beginning-of-line)
  954. (let ((old-ind (org-get-indentation)))
  955. (unless (= ind old-ind)
  956. (org-shift-item-indentation (- ind old-ind))
  957. (skip-chars-forward " \t")
  958. (delete-region (point-at-bol) (point))
  959. (org-indent-to-column ind)))))
  960. (defun org-outdent-item (arg)
  961. "Outdent a local list item, but not its children."
  962. (interactive "p")
  963. (org-indent-item-tree (- arg) t))
  964. (defun org-indent-item (arg)
  965. "Indent a local list item, but not its children."
  966. (interactive "p")
  967. (org-indent-item-tree arg t))
  968. (defun org-outdent-item-tree (arg &optional no-subtree)
  969. "Outdent a local list item including its children.
  970. If NO-SUBTREE is set, only outdent the item itself, not its children."
  971. (interactive "p")
  972. (org-indent-item-tree (- arg) no-subtree))
  973. (defvar org-last-indent-begin-marker (make-marker))
  974. (defvar org-last-indent-end-marker (make-marker))
  975. (defun org-indent-item-tree (arg &optional no-subtree)
  976. "Indent a local list item including its children.
  977. If NO-SUBTREE is set, only indent the item itself, not its
  978. children. Return t if successful."
  979. (interactive "p")
  980. (unless (org-at-item-p)
  981. (error "Not on an item"))
  982. ;; Determine begin and end points of zone to indent. If moving by
  983. ;; subtrees, ensure we don't drag additional items on subsequent
  984. ;; moves.
  985. (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
  986. (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
  987. (if (org-region-active-p)
  988. (progn
  989. (set-marker org-last-indent-begin-marker (region-beginning))
  990. (set-marker org-last-indent-end-marker (region-end)))
  991. (set-marker org-last-indent-begin-marker (save-excursion (org-beginning-of-item)))
  992. (set-marker org-last-indent-end-marker
  993. (save-excursion
  994. (if no-subtree (org-end-of-item-or-at-child) (org-end-of-item))))))
  995. ;; Get everything ready
  996. (let* ((beg (marker-position org-last-indent-begin-marker))
  997. (end (marker-position org-last-indent-end-marker))
  998. (struct (org-list-struct beg end (< arg 0)))
  999. (origins (org-list-struct-origins struct))
  1000. (beg-item (assq beg struct))
  1001. (end-item (save-excursion
  1002. (goto-char end)
  1003. (skip-chars-backward " \r\t\n")
  1004. (org-beginning-of-item)
  1005. (org-list-struct-assoc-at-point)))
  1006. (top (org-list-top-point)))
  1007. (cond
  1008. ;; Special case: moving top-item with indent rule
  1009. ((and (= top beg) (cdr (assq 'indent org-list-automatic-rules)))
  1010. (let ((offset (if (< arg 0) -2 2))
  1011. (top-ind (nth 1 beg-item)))
  1012. (if (< (+ top-ind offset) 0)
  1013. (error "Cannot outdent beyond margin")
  1014. ;; Change bullet if necessary
  1015. (when (and (= (+ top-ind offset) 0) (string-match "*" (nth 2 beg-item)))
  1016. (setcdr beg-item (list (nth 1 beg-item) (org-list-bullet-string "-"))))
  1017. ;; Shift ancestor
  1018. (let ((anc (car struct))) (setcdr anc (list (+ (nth 1 anc) offset) "" nil)))
  1019. (org-list-struct-fix-struct struct origins)
  1020. (org-list-struct-apply-struct struct))))
  1021. ;; Forbidden move
  1022. ((and (< arg 0)
  1023. (or (and no-subtree
  1024. (not (org-region-active-p))
  1025. (org-list-struct-get-child beg-item struct))
  1026. (org-list-struct-get-child end-item struct)))
  1027. (error "Cannot outdent an item without its children"))
  1028. ;; Normal shifting
  1029. (t
  1030. (let* ((shifted-ori (if (< arg 0)
  1031. (org-list-struct-outdent beg end origins)
  1032. (org-list-struct-indent beg end origins))))
  1033. (org-list-struct-fix-struct struct shifted-ori)
  1034. (org-list-struct-apply-struct struct)))))
  1035. ;; Return value
  1036. t)
  1037. (defvar org-tab-ind-state)
  1038. (defun org-cycle-item-indentation ()
  1039. (let ((org-adapt-indentation nil))
  1040. (when (and (or (org-at-item-description-p) (org-at-item-checkbox-p) (org-at-item-p))
  1041. (>= (match-end 0) (save-excursion
  1042. (org-end-of-item-or-at-child)
  1043. (skip-chars-backward " \r\t\n")
  1044. (point))))
  1045. (setq this-command 'org-cycle-item-indentation)
  1046. ;; When in the middle of the cycle, try to outdent first. If it
  1047. ;; fails, and point is still at initial position, indent. Else,
  1048. ;; go back to original position.
  1049. (if (eq last-command 'org-cycle-item-indentation)
  1050. (cond
  1051. ((ignore-errors (org-indent-item -1)))
  1052. ((and (= (org-get-indentation) (car org-tab-ind-state))
  1053. (ignore-errors (org-indent-item 1))))
  1054. (t (back-to-indentation)
  1055. (indent-to-column (car org-tab-ind-state))
  1056. (end-of-line)
  1057. (org-fix-bullet-type (nth 1 org-tab-ind-state))
  1058. ;; Break cycle
  1059. (setq this-command 'identity)))
  1060. ;; If a cycle is starting, remember indentation and bullet,
  1061. ;; then try to indent. If it fails, try to outdent.
  1062. (setq org-tab-ind-state
  1063. (list (org-get-indentation) (org-get-bullet)))
  1064. (cond
  1065. ((ignore-errors (org-indent-item 1)))
  1066. ((ignore-errors (org-indent-item -1)))
  1067. (t (error "Cannot move item"))))
  1068. t)))
  1069. ;;; Bullets
  1070. (defun org-get-bullet ()
  1071. "Return the bullet of the item at point.
  1072. Assume cursor is at an item."
  1073. (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1)))
  1074. (defun org-list-bullet-string (bullet)
  1075. "Return BULLET with the correct number of whitespaces.
  1076. It determines the number of whitespaces to append by looking at
  1077. `org-list-two-spaces-after-bullet-regexp'."
  1078. (save-match-data
  1079. (string-match "\\S-+\\([ \t]*\\)" bullet)
  1080. (replace-match
  1081. (save-match-data
  1082. (concat
  1083. " "
  1084. ;; Do we need to concat another white space ?
  1085. (when (and org-list-two-spaces-after-bullet-regexp
  1086. (string-match org-list-two-spaces-after-bullet-regexp bullet))
  1087. " ")))
  1088. nil nil bullet 1)))
  1089. (defun org-list-inc-bullet-maybe (bullet)
  1090. "Increment numbered bullets."
  1091. (if (string-match "[0-9]+" bullet)
  1092. (replace-match
  1093. (number-to-string (1+ (string-to-number (match-string 0 bullet)))) nil nil bullet)
  1094. bullet))
  1095. (defun org-list-replace-bullet (new-bullet)
  1096. "Replace current item's bullet with NEW-BULLET.
  1097. Item body is re-indented, but sub-lists are not moved. Assume
  1098. point is at item."
  1099. (save-excursion
  1100. (beginning-of-line)
  1101. (let ((old (progn
  1102. (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
  1103. (match-string 1))))
  1104. (unless (equal new-bullet old)
  1105. (replace-match new-bullet nil nil nil 1)
  1106. ;; When bullet lengths are differents, move the whole
  1107. ;; sublist accordingly
  1108. (org-shift-item-indentation
  1109. (- (length new-bullet) (length old)))))))
  1110. (defun org-fix-bullet-type (&optional force-bullet)
  1111. "Make sure all items in this list have the same bullet as the first item.
  1112. Also, fix the indentation."
  1113. (interactive)
  1114. (unless (org-at-item-p) (error "This is not a list"))
  1115. (let* ((struct (org-list-struct (point-at-bol) (point-at-eol)))
  1116. (origins (org-list-struct-origins struct))
  1117. fixed-struct)
  1118. (if force-bullet
  1119. (let ((begin (nth 1 struct)))
  1120. (setcdr begin (list (nth 1 begin) (org-list-bullet-string force-bullet) (nth 3 begin)))
  1121. (setq fixed-struct (cons begin (org-list-struct-fix-struct struct origins))))
  1122. (setq fixed-struct (org-list-struct-fix-struct struct origins)))
  1123. (org-list-struct-apply-struct fixed-struct)))
  1124. (defun org-renumber-ordered-list ()
  1125. "Renumber an ordered plain list.
  1126. Cursor needs to be in the first line of an item."
  1127. (interactive)
  1128. (unless (and (org-at-item-p)
  1129. (match-beginning 3))
  1130. (error "This is not an ordered list"))
  1131. (let* ((struct (org-list-struct (point-at-bol) (point-at-eol)))
  1132. (origins (org-list-struct-origins struct)))
  1133. (org-list-struct-apply-struct (org-list-struct-fix-struct struct origins))))
  1134. (defun org-maybe-renumber-ordered-list ()
  1135. "Renumber the ordered list at point if setup allows it.
  1136. This tests the if 'renumber rule is set in
  1137. `org-list-automatic-rules' before doing the renumbering.
  1138. Do not throw error on failure."
  1139. (interactive)
  1140. (when (cdr (assq 'renumber org-list-automatic-rules))
  1141. (ignore-errors (org-renumber-ordered-list))))
  1142. (defun org-cycle-list-bullet (&optional which)
  1143. "Cycle through the different itemize/enumerate bullets.
  1144. This cycle the entire list level through the sequence:
  1145. `-' -> `+' -> `*' -> `1.' -> `1)'
  1146. If WHICH is a valid string, use that as the new bullet. If WHICH
  1147. is an integer, 0 means `-', 1 means `+' etc. If WHICH is
  1148. 'previous, cycle backwards."
  1149. (interactive "P")
  1150. (org-preserve-lc
  1151. (let* ((bullet (progn (org-beginning-of-item-list)
  1152. (org-get-bullet)))
  1153. (current (cond
  1154. ((string-match "\\." bullet) "1.")
  1155. ((string-match ")" bullet) "1)")
  1156. (t bullet)))
  1157. (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
  1158. (bullet-list (append '("-" "+" )
  1159. ;; *-bullets are not allowed at column 0
  1160. (unless (and bullet-rule-p
  1161. (looking-at "\\S-")) '("*"))
  1162. ;; Description items cannot be numbered
  1163. (unless (and bullet-rule-p
  1164. (or (eq org-plain-list-ordered-item-terminator ?.)
  1165. (org-at-item-description-p))) '("1)"))
  1166. (unless (and bullet-rule-p
  1167. (or (eq org-plain-list-ordered-item-terminator ?\))
  1168. (org-at-item-description-p))) '("1."))))
  1169. (len (length bullet-list))
  1170. (item-index (- len (length (member current bullet-list))))
  1171. (get-value (lambda (index) (nth (mod index len) bullet-list)))
  1172. (new (cond
  1173. ((member which bullet-list) which)
  1174. ((numberp which) (funcall get-value which))
  1175. ((eq 'previous which) (funcall get-value (1- item-index)))
  1176. (t (funcall get-value (1+ item-index))))))
  1177. (org-fix-bullet-type new))))
  1178. ;;; Checkboxes
  1179. (defun org-toggle-checkbox (&optional toggle-presence)
  1180. "Toggle the checkbox in the current line.
  1181. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
  1182. double prefix, set checkbox to [-].
  1183. When there is an active region, toggle status or presence of the
  1184. checkbox in the first line, and make every item in the region
  1185. have the same status or presence, respectively.
  1186. If the cursor is in a headline, apply this to all checkbox items
  1187. in the text below the heading, taking as reference the first item
  1188. in subtree."
  1189. (interactive "P")
  1190. ;; Bounds is a list of type (beg end single-p) where single-p is t
  1191. ;; when `org-toggle-checkbox' is applied to a single item. Only
  1192. ;; toggles on single items will return errors.
  1193. (let* ((bounds
  1194. (cond
  1195. ((org-region-active-p)
  1196. (list (region-beginning) (region-end) nil))
  1197. ((org-on-heading-p)
  1198. ;; In this case, reference line is the first item in subtree
  1199. (let ((limit (save-excursion (outline-next-heading) (point))))
  1200. (save-excursion
  1201. (org-search-forward-unenclosed org-item-beginning-re limit 'move)
  1202. (list (point) limit nil))))
  1203. ((org-at-item-p)
  1204. (list (point-at-bol) (point-at-eol) t))
  1205. (t (error "Not at an item or heading, and no active region"))))
  1206. ;; marker is needed because deleting checkboxes will change END
  1207. (end (copy-marker (nth 1 bounds)))
  1208. (single-p (nth 2 bounds))
  1209. (ref-presence (save-excursion (goto-char (car bounds)) (org-at-item-checkbox-p)))
  1210. (ref-status (equal (match-string 1) "[X]"))
  1211. (act-on-item
  1212. (lambda (ref-pres ref-stat)
  1213. (if (equal toggle-presence '(4))
  1214. (cond
  1215. ((and ref-pres (org-at-item-checkbox-p))
  1216. (replace-match ""))
  1217. ((and (not ref-pres)
  1218. (not (org-at-item-checkbox-p))
  1219. (org-at-item-p))
  1220. (goto-char (match-end 0))
  1221. ;; Ignore counter, if any
  1222. (when (looking-at "\\(?:\\[@start:[0-9]+\\][ \t]*\\)?")
  1223. (goto-char (match-end 0)))
  1224. (let ((desc-p (and (org-at-item-description-p)
  1225. (cdr (assq 'checkbox org-list-automatic-rules)))))
  1226. (cond
  1227. ((and single-p desc-p)
  1228. (error "Cannot add a checkbox in a description list"))
  1229. ((not desc-p) (insert "[ ] "))))))
  1230. (let ((blocked (org-checkbox-blocked-p)))
  1231. (cond
  1232. ((and blocked single-p)
  1233. (error "Checkbox blocked because of unchecked box in line %d" blocked))
  1234. (blocked nil)
  1235. ((org-at-item-checkbox-p)
  1236. (replace-match
  1237. (cond ((equal toggle-presence '(16)) "[-]")
  1238. (ref-stat "[ ]")
  1239. (t "[X]"))
  1240. t t nil 1))))))))
  1241. (save-excursion
  1242. (beginning-of-line)
  1243. (while (< (point) end)
  1244. (funcall act-on-item ref-presence ref-status)
  1245. (org-search-forward-unenclosed org-item-beginning-re end 'move)))
  1246. (org-update-checkbox-count-maybe)))
  1247. (defun org-reset-checkbox-state-subtree ()
  1248. "Reset all checkboxes in an entry subtree."
  1249. (interactive "*")
  1250. (save-restriction
  1251. (save-excursion
  1252. (org-narrow-to-subtree)
  1253. (org-show-subtree)
  1254. (goto-char (point-min))
  1255. (let ((end (point-max)))
  1256. (while (< (point) end)
  1257. (when (org-at-item-checkbox-p)
  1258. (replace-match "[ ]" t t nil 1))
  1259. (beginning-of-line 2))))
  1260. (org-update-checkbox-count-maybe)))
  1261. (defvar org-checkbox-statistics-hook nil
  1262. "Hook that is run whenever Org thinks checkbox statistics should be updated.
  1263. This hook runs even if 'checkbox rules in
  1264. `org-list-automatic-rules' do not apply, so it can be used to
  1265. implement alternative ways of collecting statistics
  1266. information.")
  1267. (defun org-update-checkbox-count-maybe ()
  1268. "Update checkbox statistics unless turned off by user."
  1269. (when (cdr (assq 'checkbox org-list-automatic-rules))
  1270. (org-update-checkbox-count))
  1271. (run-hooks 'org-checkbox-statistics-hook))
  1272. (defun org-update-checkbox-count (&optional all)
  1273. "Update the checkbox statistics in the current section.
  1274. This will find all statistic cookies like [57%] and [6/12] and update them
  1275. with the current numbers. With optional prefix argument ALL, do this for
  1276. the whole buffer."
  1277. (interactive "P")
  1278. (save-excursion
  1279. (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
  1280. (beg (condition-case nil
  1281. (progn (org-back-to-heading) (point))
  1282. (error (point-min))))
  1283. (end (move-marker (make-marker)
  1284. (progn (outline-next-heading) (point))))
  1285. (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
  1286. (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)")
  1287. (re-find (concat re "\\|" re-box))
  1288. beg-cookie end-cookie is-percent c-on c-off lim new
  1289. eline curr-ind next-ind continue-from startsearch
  1290. (recursive
  1291. (or (not org-hierarchical-checkbox-statistics)
  1292. (string-match "\\<recursive\\>"
  1293. (or (ignore-errors
  1294. (org-entry-get nil "COOKIE_DATA"))
  1295. ""))))
  1296. (cstat 0))
  1297. (when all
  1298. (goto-char (point-min))
  1299. (outline-next-heading)
  1300. (setq beg (point) end (point-max)))
  1301. (goto-char end)
  1302. ;; find each statistics cookie
  1303. (while (and (org-search-backward-unenclosed re-find beg t)
  1304. (not (save-match-data
  1305. (and (org-on-heading-p)
  1306. (string-match "\\<todo\\>"
  1307. (downcase
  1308. (or (org-entry-get
  1309. nil "COOKIE_DATA")
  1310. "")))))))
  1311. (setq beg-cookie (match-beginning 1)
  1312. end-cookie (match-end 1)
  1313. cstat (+ cstat (if end-cookie 1 0))
  1314. startsearch (point-at-eol)
  1315. continue-from (match-beginning 0)
  1316. is-percent (match-beginning 2)
  1317. lim (cond
  1318. ((org-on-heading-p) (outline-next-heading) (point))
  1319. ((org-at-item-p) (org-end-of-item) (point))
  1320. (t nil))
  1321. c-on 0
  1322. c-off 0)
  1323. (when lim
  1324. ;; find first checkbox for this cookie and gather
  1325. ;; statistics from all that are at this indentation level
  1326. (goto-char startsearch)
  1327. (if (org-search-forward-unenclosed re-box lim t)
  1328. (progn
  1329. (org-beginning-of-item)
  1330. (setq curr-ind (org-get-indentation))
  1331. (setq next-ind curr-ind)
  1332. (while (and (bolp) (org-at-item-p)
  1333. (if recursive
  1334. (<= curr-ind next-ind)
  1335. (= curr-ind next-ind)))
  1336. (setq eline (point-at-eol))
  1337. (if (org-search-forward-unenclosed re-box eline t)
  1338. (if (member (match-string 2) '("[ ]" "[-]"))
  1339. (setq c-off (1+ c-off))
  1340. (setq c-on (1+ c-on))))
  1341. (if (not recursive)
  1342. ;; org-get-next-item goes through list-enders
  1343. ;; with proper limit.
  1344. (goto-char (or (org-get-next-item (point) lim) lim))
  1345. (end-of-line)
  1346. (when (org-search-forward-unenclosed org-item-beginning-re lim t)
  1347. (beginning-of-line)))
  1348. (setq next-ind (org-get-indentation)))))
  1349. (goto-char continue-from)
  1350. ;; update cookie
  1351. (when end-cookie
  1352. (setq new (if is-percent
  1353. (format "[%d%%]" (/ (* 100 c-on) (max 1 (+ c-on c-off))))
  1354. (format "[%d/%d]" c-on (+ c-on c-off))))
  1355. (goto-char beg-cookie)
  1356. (insert new)
  1357. (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
  1358. ;; update items checkbox if it has one
  1359. (when (org-at-item-p)
  1360. (org-beginning-of-item)
  1361. (when (and (> (+ c-on c-off) 0)
  1362. (org-search-forward-unenclosed re-box (point-at-eol) t))
  1363. (setq beg-cookie (match-beginning 2)
  1364. end-cookie (match-end 2))
  1365. (delete-region beg-cookie end-cookie)
  1366. (goto-char beg-cookie)
  1367. (cond ((= c-off 0) (insert "[X]"))
  1368. ((= c-on 0) (insert "[ ]"))
  1369. (t (insert "[-]")))
  1370. )))
  1371. (goto-char continue-from))
  1372. (when (interactive-p)
  1373. (message "Checkbox statistics updated %s (%d places)"
  1374. (if all "in entire file" "in current outline entry") cstat)))))
  1375. (defun org-get-checkbox-statistics-face ()
  1376. "Select the face for checkbox statistics.
  1377. The face will be `org-done' when all relevant boxes are checked.
  1378. Otherwise it will be `org-todo'."
  1379. (if (match-end 1)
  1380. (if (equal (match-string 1) "100%")
  1381. 'org-checkbox-statistics-done
  1382. 'org-checkbox-statistics-todo)
  1383. (if (and (> (match-end 2) (match-beginning 2))
  1384. (equal (match-string 2) (match-string 3)))
  1385. 'org-checkbox-statistics-done
  1386. 'org-checkbox-statistics-todo)))
  1387. ;;; Misc Tools
  1388. (defun org-apply-on-list (function init-value &rest args)
  1389. "Call FUNCTION for each item of a the list under point.
  1390. FUNCTION must be called with at least one argument: a return
  1391. value that will contain the value returned by the function at the
  1392. previous item, plus ARGS extra arguments. INIT-VALUE will be the
  1393. value passed to the function at the first item of the list.
  1394. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
  1395. will return the number of items in the current list.
  1396. Sublists of the list are skipped. Cursor is always at the
  1397. beginning of the item."
  1398. (save-excursion
  1399. (let ((end (copy-marker (save-excursion (org-end-of-item-list))))
  1400. (next-p (make-marker))
  1401. (move-down-action
  1402. (lambda (pos value &rest args)
  1403. (goto-char pos)
  1404. (set-marker next-p (org-get-next-item pos end))
  1405. (let ((return-value (apply function value args)))
  1406. (if (marker-position next-p)
  1407. (apply move-down-action next-p return-value args)
  1408. return-value)))))
  1409. (apply move-down-action (org-beginning-of-item-list) init-value args))))
  1410. (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
  1411. "Sort plain list items.
  1412. The cursor may be at any item of the list that should be sorted.
  1413. Sublists are not sorted. Checkboxes, if any, are ignored.
  1414. Sorting can be alphabetically, numerically, by date/time as given by
  1415. a time stamp, by a property or by priority.
  1416. The command prompts for the sorting type unless it has been given
  1417. to the function through the SORTING-TYPE argument, which needs to
  1418. be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
  1419. meaning of each character:
  1420. n Numerically, by converting the beginning of the item to a number.
  1421. a Alphabetically. Only the first line of item is checked.
  1422. t By date/time, either the first active time stamp in the entry, if
  1423. any, or by the first inactive one. In a timer list, sort the timers.
  1424. Capital letters will reverse the sort order.
  1425. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
  1426. function to be called with point at the beginning of the record.
  1427. It must return either a string or a number that should serve as
  1428. the sorting key for that record.
  1429. Comparing entries ignores case by default. However, with an
  1430. optional argument WITH-CASE, the sorting considers case as well."
  1431. (interactive "P")
  1432. (let* ((case-func (if with-case 'identity 'downcase))
  1433. (start (org-beginning-of-item-list))
  1434. (end (save-excursion (org-end-of-item-list)))
  1435. (sorting-type
  1436. (progn
  1437. (message
  1438. "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
  1439. (read-char-exclusive)))
  1440. (getkey-func (and (= (downcase sorting-type) ?f)
  1441. (org-icompleting-read "Sort using function: "
  1442. obarray 'fboundp t nil nil)
  1443. (intern getkey-func))))
  1444. (message "Sorting items...")
  1445. (save-restriction
  1446. (narrow-to-region start end)
  1447. (let* ((dcst (downcase sorting-type))
  1448. (case-fold-search nil)
  1449. (now (current-time))
  1450. (sort-func (cond
  1451. ((= dcst ?a) 'string<)
  1452. ((= dcst ?f) compare-func)
  1453. ((= dcst ?t) '<)
  1454. (t nil)))
  1455. (begin-record (lambda ()
  1456. (skip-chars-forward " \r\t\n")
  1457. (beginning-of-line)))
  1458. (end-record (lambda ()
  1459. (goto-char (org-end-of-item-before-blank))))
  1460. (value-to-sort
  1461. (lambda ()
  1462. (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
  1463. (cond
  1464. ((= dcst ?n)
  1465. (string-to-number (buffer-substring (match-end 0)
  1466. (point-at-eol))))
  1467. ((= dcst ?a)
  1468. (buffer-substring (match-end 0) (point-at-eol)))
  1469. ((= dcst ?t)
  1470. (cond
  1471. ;; If it is a timer list, convert timer to seconds
  1472. ((org-at-item-timer-p)
  1473. (org-timer-hms-to-secs (match-string 1)))
  1474. ((or (org-search-forward-unenclosed org-ts-regexp
  1475. (point-at-eol) t)
  1476. (org-search-forward-unenclosed org-ts-regexp-both
  1477. (point-at-eol) t))
  1478. (org-time-string-to-seconds (match-string 0)))
  1479. (t (org-float-time now))))
  1480. ((= dcst ?f)
  1481. (if getkey-func
  1482. (let ((value (funcall getkey-func)))
  1483. (if (stringp value)
  1484. (funcall case-func value)
  1485. value))
  1486. (error "Invalid key function `%s'" getkey-func)))
  1487. (t (error "Invalid sorting type `%c'" sorting-type)))))))
  1488. (sort-subr (/= dcst sorting-type) begin-record end-record value-to-sort nil sort-func)
  1489. (org-maybe-renumber-ordered-list)
  1490. (run-hooks 'org-after-sorting-entries-or-items-hook)
  1491. (message "Sorting items...done")))))
  1492. ;;; Send and receive lists
  1493. (defun org-list-parse-list (&optional delete)
  1494. "Parse the list at point and maybe DELETE it.
  1495. Return a list containing first level items as strings and
  1496. sublevels as a list of strings."
  1497. (let* ((start (goto-char (org-list-top-point)))
  1498. (end (org-list-bottom-point))
  1499. output itemsep ltype)
  1500. (while (org-search-forward-unenclosed org-item-beginning-re end t)
  1501. (save-excursion
  1502. (beginning-of-line)
  1503. (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
  1504. ((org-at-item-description-p) 'descriptive)
  1505. (t 'unordered))))
  1506. (let* ((indent1 (org-get-indentation))
  1507. (nextitem (or (org-get-next-item (point) end) end))
  1508. (item (org-trim (buffer-substring (point) (org-end-of-item-or-at-child))))
  1509. (nextindent (if (= (point) end) 0 (org-get-indentation)))
  1510. (item (if (string-match "^\\(?:\\[@start:[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]" item)
  1511. (replace-match (if (equal (match-string 1 item) " ")
  1512. "CBOFF"
  1513. "CBON")
  1514. t nil item 1)
  1515. item)))
  1516. (push item output)
  1517. (when (> nextindent indent1)
  1518. (save-restriction
  1519. (narrow-to-region (point) nextitem)
  1520. (push (org-list-parse-list) output)))))
  1521. (when delete
  1522. (delete-region start end)
  1523. (save-match-data
  1524. (when (looking-at (org-list-end-re))
  1525. (replace-match "\n"))))
  1526. (setq output (nreverse output))
  1527. (push ltype output)))
  1528. (defun org-list-make-subtree ()
  1529. "Convert the plain list at point into a subtree."
  1530. (interactive)
  1531. (if (not (org-in-item-p))
  1532. (error "Not in a list.")
  1533. (goto-char (org-list-top-point))
  1534. (let ((list (org-list-parse-list t)) nstars)
  1535. (save-excursion
  1536. (if (ignore-errors
  1537. (org-back-to-heading))
  1538. (progn (org-search-forward-unenclosed org-complex-heading-regexp nil t)
  1539. (setq nstars (length (match-string 1))))
  1540. (setq nstars 0)))
  1541. (org-list-make-subtrees list (1+ nstars)))))
  1542. (defun org-list-make-subtrees (list level)
  1543. "Convert LIST into subtrees starting at LEVEL."
  1544. (if (symbolp (car list))
  1545. (org-list-make-subtrees (cdr list) level)
  1546. (mapcar (lambda (item)
  1547. (if (stringp item)
  1548. (insert (make-string
  1549. (if org-odd-levels-only
  1550. (1- (* 2 level)) level) ?*) " " item "\n")
  1551. (org-list-make-subtrees item (1+ level))))
  1552. list)))
  1553. (defun org-list-insert-radio-list ()
  1554. "Insert a radio list template appropriate for this major mode."
  1555. (interactive)
  1556. (let* ((e (assq major-mode org-list-radio-list-templates))
  1557. (txt (nth 1 e))
  1558. name pos)
  1559. (unless e (error "No radio list setup defined for %s" major-mode))
  1560. (setq name (read-string "List name: "))
  1561. (while (string-match "%n" txt)
  1562. (setq txt (replace-match name t t txt)))
  1563. (or (bolp) (insert "\n"))
  1564. (setq pos (point))
  1565. (insert txt)
  1566. (goto-char pos)))
  1567. (defun org-list-send-list (&optional maybe)
  1568. "Send a transformed version of this list to the receiver position.
  1569. With argument MAYBE, fail quietly if no transformation is defined for
  1570. this list."
  1571. (interactive)
  1572. (catch 'exit
  1573. (unless (org-at-item-p) (error "Not at a list"))
  1574. (save-excursion
  1575. (re-search-backward "#\\+ORGLST" nil t)
  1576. (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
  1577. (if maybe
  1578. (throw 'exit nil)
  1579. (error "Don't know how to transform this list"))))
  1580. (let* ((name (match-string 1))
  1581. (transform (intern (match-string 2)))
  1582. (bottom-point
  1583. (save-excursion
  1584. (re-search-forward "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
  1585. (match-beginning 0)))
  1586. (top-point
  1587. (progn
  1588. (re-search-backward "#\\+ORGLST" nil t)
  1589. (re-search-forward org-item-beginning-re bottom-point t)
  1590. (match-beginning 0)))
  1591. (list (save-restriction
  1592. (narrow-to-region top-point bottom-point)
  1593. (org-list-parse-list)))
  1594. beg txt)
  1595. (unless (fboundp transform)
  1596. (error "No such transformation function %s" transform))
  1597. (let ((txt (funcall transform list)))
  1598. ;; Find the insertion place
  1599. (save-excursion
  1600. (goto-char (point-min))
  1601. (unless (re-search-forward
  1602. (concat "BEGIN RECEIVE ORGLST +" name "\\([ \t]\\|$\\)") nil t)
  1603. (error "Don't know where to insert translated list"))
  1604. (goto-char (match-beginning 0))
  1605. (beginning-of-line 2)
  1606. (setq beg (point))
  1607. (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
  1608. (error "Cannot find end of insertion region"))
  1609. (delete-region beg (point-at-bol))
  1610. (goto-char beg)
  1611. (insert txt "\n")))
  1612. (message "List converted and installed at receiver location"))))
  1613. (defun org-list-to-generic (list params)
  1614. "Convert a LIST parsed through `org-list-parse-list' to other formats.
  1615. Valid parameters PARAMS are
  1616. :ustart String to start an unordered list
  1617. :uend String to end an unordered list
  1618. :ostart String to start an ordered list
  1619. :oend String to end an ordered list
  1620. :dstart String to start a descriptive list
  1621. :dend String to end a descriptive list
  1622. :dtstart String to start a descriptive term
  1623. :dtend String to end a descriptive term
  1624. :ddstart String to start a description
  1625. :ddend String to end a description
  1626. :splice When set to t, return only list body lines, don't wrap
  1627. them into :[u/o]start and :[u/o]end. Default is nil.
  1628. :istart String to start a list item
  1629. :iend String to end a list item
  1630. :isep String to separate items
  1631. :lsep String to separate sublists
  1632. :cboff String to insert for an unchecked checkbox
  1633. :cbon String to insert for a checked checkbox"
  1634. (interactive)
  1635. (let* ((p params) sublist
  1636. (splicep (plist-get p :splice))
  1637. (ostart (plist-get p :ostart))
  1638. (oend (plist-get p :oend))
  1639. (ustart (plist-get p :ustart))
  1640. (uend (plist-get p :uend))
  1641. (dstart (plist-get p :dstart))
  1642. (dend (plist-get p :dend))
  1643. (dtstart (plist-get p :dtstart))
  1644. (dtend (plist-get p :dtend))
  1645. (ddstart (plist-get p :ddstart))
  1646. (ddend (plist-get p :ddend))
  1647. (istart (plist-get p :istart))
  1648. (iend (plist-get p :iend))
  1649. (isep (plist-get p :isep))
  1650. (lsep (plist-get p :lsep))
  1651. (cbon (plist-get p :cbon))
  1652. (cboff (plist-get p :cboff)))
  1653. (let ((wrapper
  1654. (cond ((eq (car list) 'ordered)
  1655. (concat ostart "\n%s" oend "\n"))
  1656. ((eq (car list) 'unordered)
  1657. (concat ustart "\n%s" uend "\n"))
  1658. ((eq (car list) 'descriptive)
  1659. (concat dstart "\n%s" dend "\n"))))
  1660. rtn term defstart defend)
  1661. (while (setq sublist (pop list))
  1662. (cond ((symbolp sublist) nil)
  1663. ((stringp sublist)
  1664. (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
  1665. (setq term (org-trim (format (concat dtstart "%s" dtend)
  1666. (match-string 1 sublist))))
  1667. (setq sublist (concat ddstart
  1668. (org-trim (substring sublist (match-end 0)))
  1669. ddend)))
  1670. (if (string-match "\\[CBON\\]" sublist)
  1671. (setq sublist (replace-match cbon t t sublist)))
  1672. (if (string-match "\\[CBOFF\\]" sublist)
  1673. (setq sublist (replace-match cboff t t sublist)))
  1674. (if (string-match "\\[-\\]" sublist)
  1675. (setq sublist (replace-match "$\\boxminus$" t t sublist)))
  1676. (setq rtn (concat rtn istart term sublist iend isep)))
  1677. (t (setq rtn (concat rtn ;; previous list
  1678. lsep ;; list separator
  1679. (org-list-to-generic sublist p)
  1680. lsep ;; list separator
  1681. )))))
  1682. (format wrapper rtn))))
  1683. (defun org-list-to-latex (list &optional params)
  1684. "Convert LIST into a LaTeX list.
  1685. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1686. with overruling parameters for `org-list-to-generic'."
  1687. (org-list-to-generic
  1688. list
  1689. (org-combine-plists
  1690. '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
  1691. :ustart "\\begin{itemize}" :uend "\\end{itemize}"
  1692. :dstart "\\begin{description}" :dend "\\end{description}"
  1693. :dtstart "[" :dtend "]"
  1694. :ddstart "" :ddend ""
  1695. :istart "\\item " :iend ""
  1696. :isep "\n" :lsep "\n"
  1697. :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
  1698. params)))
  1699. (defun org-list-to-html (list &optional params)
  1700. "Convert LIST into a HTML list.
  1701. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1702. with overruling parameters for `org-list-to-generic'."
  1703. (org-list-to-generic
  1704. list
  1705. (org-combine-plists
  1706. '(:splicep nil :ostart "<ol>" :oend "</ol>"
  1707. :ustart "<ul>" :uend "</ul>"
  1708. :dstart "<dl>" :dend "</dl>"
  1709. :dtstart "<dt>" :dtend "</dt>"
  1710. :ddstart "<dd>" :ddend "</dd>"
  1711. :istart "<li>" :iend "</li>"
  1712. :isep "\n" :lsep "\n"
  1713. :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
  1714. params)))
  1715. (defun org-list-to-texinfo (list &optional params)
  1716. "Convert LIST into a Texinfo list.
  1717. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  1718. with overruling parameters for `org-list-to-generic'."
  1719. (org-list-to-generic
  1720. list
  1721. (org-combine-plists
  1722. '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
  1723. :ustart "@enumerate" :uend "@end enumerate"
  1724. :dstart "@table" :dend "@end table"
  1725. :dtstart "@item " :dtend "\n"
  1726. :ddstart "" :ddend ""
  1727. :istart "@item\n" :iend ""
  1728. :isep "\n" :lsep "\n"
  1729. :cbon "@code{[X]}" :cboff "@code{[ ]}")
  1730. params)))
  1731. (provide 'org-list)
  1732. ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
  1733. ;;; org-list.el ends here