org-list.el 70 KB

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