org-list.el 82 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309
  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-list-ending-method 'both
  133. "Determine where plain lists should end.
  134. Valid values are: `regexp', `indent' or `both'.
  135. When set to `regexp', Org will look into two variables,
  136. `org-empty-line-terminates-plain-lists' and the more general
  137. `org-list-end-regexp', to determine what will end lists. This is
  138. the fastest method.
  139. When set to `indent', a list will end whenever a line following
  140. an item, but not starting one, is less or equally indented than
  141. it.
  142. When set to `both', each of the preceding methods is applied to
  143. determine lists endings. This is the default method."
  144. :group 'org-plain-lists
  145. :type '(choice
  146. (const :tag "With a regexp defining ending" regexp)
  147. (const :tag "With indentation of regular (no bullet) text" indent)
  148. (const :tag "With both methods" both)))
  149. (defcustom org-empty-line-terminates-plain-lists nil
  150. "Non-nil means an empty line ends all plain list levels.
  151. This variable only makes sense if `org-list-ending-method' is set
  152. to `regexp' or `both'. This is then equivalent to set
  153. `org-list-end-regexp' to \"^[ \\t]*$\"."
  154. :group 'org-plain-lists
  155. :type 'boolean)
  156. (defcustom org-list-end-regexp "^[ \t]*\n[ \t]*\n"
  157. "Regexp matching the end of all plain list levels.
  158. It must start with \"^\" and end with \"\\n\". It defaults to 2
  159. blank lines. `org-empty-line-terminates-plain-lists' has
  160. precedence over it."
  161. :group 'org-plain-lists
  162. :type 'string)
  163. (defcustom org-list-automatic-rules '((bullet . t)
  164. (checkbox . t)
  165. (indent . t)
  166. (insert . t))
  167. "Non-nil means apply set of rules when acting on lists.
  168. By default, automatic actions are taken when using
  169. \\[org-shiftmetaup], \\[org-shiftmetadown], \\[org-meta-return],
  170. \\[org-metaright], \\[org-metaleft], \\[org-shiftmetaright],
  171. \\[org-shiftmetaleft], \\[org-ctrl-c-minus],
  172. \\[org-toggle-checkbox] or \\[org-insert-todo-heading]. You can
  173. disable individually these rules by setting them to nil. Valid
  174. rules are:
  175. bullet when non-nil, cycling bullet do not allow lists at
  176. column 0 to have * as a bullet and descriptions lists
  177. to be numbered.
  178. checkbox when non-nil, checkbox statistics is updated each time
  179. you either insert a new checkbox or toggle a checkbox.
  180. It also prevents from inserting a checkbox in a
  181. description item.
  182. indent when non-nil, indenting or outdenting list top-item
  183. with its subtree will move the whole list and
  184. outdenting a list whose bullet is * to column 0 will
  185. change that bullet to -
  186. insert when non-nil, trying to insert an item inside a block
  187. will insert it right before the block instead of
  188. throwing an error."
  189. :group 'org-plain-lists
  190. :type '(alist :tag "Sets of rules"
  191. :key-type
  192. (choice
  193. (const :tag "Bullet" bullet)
  194. (const :tag "Checkbox" checkbox)
  195. (const :tag "Indent" indent)
  196. (const :tag "Insert" insert))
  197. :value-type
  198. (boolean :tag "Activate" :value t)))
  199. (defcustom org-hierarchical-checkbox-statistics t
  200. "Non-nil means checkbox statistics counts only the state of direct children.
  201. When nil, all boxes below the cookie are counted.
  202. This can be set to nil on a per-node basis using a COOKIE_DATA property
  203. with the word \"recursive\" in the value."
  204. :group 'org-plain-lists
  205. :type 'boolean)
  206. (defcustom org-description-max-indent 20
  207. "Maximum indentation for the second line of a description list.
  208. When the indentation would be larger than this, it will become
  209. 5 characters instead."
  210. :group 'org-plain-lists
  211. :type 'integer)
  212. (defcustom org-list-radio-list-templates
  213. '((latex-mode "% BEGIN RECEIVE ORGLST %n
  214. % END RECEIVE ORGLST %n
  215. \\begin{comment}
  216. #+ORGLST: SEND %n org-list-to-latex
  217. -
  218. \\end{comment}\n")
  219. (texinfo-mode "@c BEGIN RECEIVE ORGLST %n
  220. @c END RECEIVE ORGLST %n
  221. @ignore
  222. #+ORGLST: SEND %n org-list-to-texinfo
  223. -
  224. @end ignore\n")
  225. (html-mode "<!-- BEGIN RECEIVE ORGLST %n -->
  226. <!-- END RECEIVE ORGLST %n -->
  227. <!--
  228. #+ORGLST: SEND %n org-list-to-html
  229. -
  230. -->\n"))
  231. "Templates for radio lists in different major modes.
  232. All occurrences of %n in a template will be replaced with the name of the
  233. list, obtained by prompting the user."
  234. :group 'org-plain-lists
  235. :type '(repeat
  236. (list (symbol :tag "Major mode")
  237. (string :tag "Format"))))
  238. ;;; Internal functions
  239. (defun org-list-end-re ()
  240. "Return the regex corresponding to the end of a list.
  241. It depends on `org-empty-line-terminates-plain-lists'."
  242. (if org-empty-line-terminates-plain-lists
  243. "^[ \t]*\n"
  244. org-list-end-regexp))
  245. (defun org-item-re (&optional general)
  246. "Return the correct regular expression for plain lists.
  247. If GENERAL is non-nil, return the general regexp independent of the value
  248. of `org-plain-list-ordered-item-terminator'."
  249. (cond
  250. ((or general (eq org-plain-list-ordered-item-terminator t))
  251. "\\([ \t]*\\([-+]\\|\\([0-9]+[.)]\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  252. ((= org-plain-list-ordered-item-terminator ?.)
  253. "\\([ \t]*\\([-+]\\|\\([0-9]+\\.\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  254. ((= org-plain-list-ordered-item-terminator ?\))
  255. "\\([ \t]*\\([-+]\\|\\([0-9]+)\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)")
  256. (t (error "Invalid value of `org-plain-list-ordered-item-terminator'"))))
  257. (defconst org-item-beginning-re (concat "^" (org-item-re))
  258. "Regexp matching the beginning of a plain list item.")
  259. (defun org-list-ending-between (min max &optional firstp)
  260. "Find the position of a list ending between MIN and MAX, or nil.
  261. This function looks for `org-list-end-re' outside a block.
  262. If FIRSTP in non-nil, return the point at the beginning of the
  263. nearest valid terminator from MIN. Otherwise, return the point at
  264. the end of the nearest terminator from MAX."
  265. (save-excursion
  266. (let* ((start (if firstp min max))
  267. (end (if firstp max min))
  268. (search-fun (if firstp
  269. #'org-search-forward-unenclosed
  270. #'org-search-backward-unenclosed))
  271. (list-end-p (progn
  272. (goto-char start)
  273. (funcall search-fun (org-list-end-re) end t))))
  274. ;; Is there a valid list ending somewhere ?
  275. (and list-end-p
  276. ;; we want to be on the first line of the list ender
  277. (match-beginning 0)))))
  278. (defun org-list-maybe-skip-block (search limit)
  279. "Return non-nil value if point is in a block, skipping it on the way.
  280. It looks for the boundary of the block in SEARCH direction,
  281. stopping at LIMIT."
  282. (save-match-data
  283. (let ((case-fold-search t)
  284. (boundary (if (eq search 're-search-forward) 3 5)))
  285. (when (save-excursion
  286. (and (funcall search "^[ \t]*#\\+\\(begin\\|end\\)_" limit t)
  287. (= (length (match-string 1)) boundary)))
  288. ;; We're in a block: get out of it
  289. (goto-char (match-beginning 0))))))
  290. (defun org-list-search-unenclosed-generic (search re bound noerr)
  291. "Search a string outside blocks and protected places.
  292. Arguments SEARCH, RE, BOUND and NOERR are similar to those in
  293. `search-forward', `search-backward', `re-search-forward' and
  294. `re-search-backward'."
  295. (catch 'exit
  296. (let ((origin (point)))
  297. (while t
  298. ;; 1. No match: return to origin or bound, depending on NOERR.
  299. (unless (funcall search re bound noerr)
  300. (throw 'exit (and (goto-char (if (booleanp noerr) origin bound))
  301. nil)))
  302. ;; 2. Match not in block or protected: return point. Else
  303. ;; skip the block and carry on.
  304. (unless (or (get-text-property (match-beginning 0) 'org-protected)
  305. (org-list-maybe-skip-block search bound))
  306. (throw 'exit (point)))))))
  307. (defun org-search-backward-unenclosed (regexp &optional bound noerror)
  308. "Like `re-search-backward' but don't stop inside blocks or protected places.
  309. Arguments REGEXP, BOUND and NOERROR are similar to those used in
  310. `re-search-backward'."
  311. (org-list-search-unenclosed-generic
  312. #'re-search-backward regexp (or bound (point-min)) noerror))
  313. (defun org-search-forward-unenclosed (regexp &optional bound noerror)
  314. "Like `re-search-forward' but don't stop inside blocks or protected places.
  315. Arguments REGEXP, BOUND and NOERROR are similar to those used in
  316. `re-search-forward'."
  317. (org-list-search-unenclosed-generic
  318. #'re-search-forward regexp (or bound (point-max)) noerror))
  319. (defun org-list-in-item-p-with-indent (limit)
  320. "Is the cursor inside a plain list?
  321. Plain lists are considered ending when a non-blank line is less
  322. indented than the previous item within LIMIT."
  323. (save-excursion
  324. (beginning-of-line)
  325. (cond
  326. ;; do not start searching inside a block...
  327. ((org-list-maybe-skip-block #'re-search-backward limit))
  328. ;; ... or at a blank line
  329. ((looking-at "^[ \t]*$")
  330. (skip-chars-backward " \r\t\n")
  331. (beginning-of-line)))
  332. (beginning-of-line)
  333. (or (org-at-item-p)
  334. (let* ((case-fold-search t)
  335. (ind-ref (org-get-indentation))
  336. ;; Ensure there is at least an item above
  337. (up-item-p (save-excursion
  338. (org-search-backward-unenclosed
  339. org-item-beginning-re limit t))))
  340. (and up-item-p
  341. (catch 'exit
  342. (while t
  343. (cond
  344. ((org-at-item-p)
  345. (throw 'exit (< (org-get-indentation) ind-ref)))
  346. ((looking-at "^[ \t]*$")
  347. (skip-chars-backward " \r\t\n")
  348. (beginning-of-line))
  349. ((looking-at "^[ \t]*#\\+end_")
  350. (re-search-backward "^[ \t]*#\\+begin_"))
  351. (t
  352. (setq ind-ref (min (org-get-indentation) ind-ref))
  353. (forward-line -1))))))))))
  354. (defun org-list-in-item-p-with-regexp (limit)
  355. "Is the cursor inside a plain list?
  356. Plain lists end when `org-list-end-regexp' is matched, or at a
  357. blank line if `org-empty-line-terminates-plain-lists' is true.
  358. Argument LIMIT specifies the upper-bound of the search."
  359. (save-excursion
  360. (let* ((actual-pos (goto-char (point-at-eol)))
  361. ;; Moved to eol so current line can be matched by
  362. ;; `org-item-re'.
  363. (last-item-start (save-excursion
  364. (org-search-backward-unenclosed
  365. org-item-beginning-re limit t)))
  366. (list-ender (org-list-ending-between
  367. last-item-start actual-pos)))
  368. ;; We are in a list when we are on an item line or when we can
  369. ;; find an item before point and there is no valid list ender
  370. ;; between it and the point.
  371. (and last-item-start (not list-ender)))))
  372. (defun org-list-top-point-with-regexp (limit)
  373. "Return point at the top level item in a list.
  374. Argument LIMIT specifies the upper-bound of the search.
  375. List ending is determined by regexp. See
  376. `org-list-ending-method'. for more information."
  377. (save-excursion
  378. (let ((pos (point-at-eol)))
  379. ;; Is there some list above this one ? If so, go to its ending.
  380. ;; Otherwise, go back to the heading above or bob.
  381. (goto-char (or (org-list-ending-between limit pos) limit))
  382. ;; From there, search down our list.
  383. (org-search-forward-unenclosed org-item-beginning-re pos t)
  384. (point-at-bol))))
  385. (defun org-list-bottom-point-with-regexp (limit)
  386. "Return point just before list ending.
  387. Argument LIMIT specifies the lower-bound of the search.
  388. List ending is determined by regexp. See
  389. `org-list-ending-method'. for more information."
  390. (save-excursion
  391. (let ((pos (org-get-item-beginning)))
  392. ;; The list ending is either first point matching
  393. ;; `org-list-end-re', point at first white-line before next
  394. ;; heading, or eob.
  395. (or (org-list-ending-between (min pos limit) limit t) limit))))
  396. (defun org-list-top-point-with-indent (limit)
  397. "Return point at the top level in a list.
  398. Argument LIMIT specifies the upper-bound of the search.
  399. List ending is determined by indentation of text. See
  400. `org-list-ending-method'. for more information."
  401. (save-excursion
  402. (let ((case-fold-search t))
  403. (let ((item-ref (goto-char (org-get-item-beginning)))
  404. (ind-ref 10000))
  405. (forward-line -1)
  406. (catch 'exit
  407. (while t
  408. (let ((ind (org-get-indentation)))
  409. (cond
  410. ((looking-at "^[ \t]*:END:")
  411. (throw 'exit item-ref))
  412. ((<= (point) limit)
  413. (throw 'exit
  414. (if (and (org-at-item-p) (< ind ind-ref))
  415. (point-at-bol)
  416. item-ref)))
  417. ((looking-at "^[ \t]*$")
  418. (skip-chars-backward " \r\t\n")
  419. (beginning-of-line))
  420. ((looking-at "^[ \t]*#\\+end_")
  421. (re-search-backward "^[ \t]*#\\+begin_"))
  422. ((not (org-at-item-p))
  423. (setq ind-ref (min ind ind-ref))
  424. (forward-line -1))
  425. ((>= ind ind-ref)
  426. (throw 'exit item-ref))
  427. (t
  428. (setq item-ref (point-at-bol) ind-ref 10000)
  429. (forward-line -1))))))))))
  430. (defun org-list-bottom-point-with-indent (limit)
  431. "Return point just before list ending or nil if not in a list.
  432. Argument LIMIT specifies the lower-bound of the search.
  433. List ending is determined by the indentation of text. See
  434. `org-list-ending-method' for more information."
  435. (save-excursion
  436. (let ((ind-ref (progn
  437. (goto-char (org-get-item-beginning))
  438. (org-get-indentation)))
  439. (case-fold-search t))
  440. ;; do not start inside a block
  441. (org-list-maybe-skip-block #'re-search-forward limit)
  442. (beginning-of-line)
  443. (catch 'exit
  444. (skip-chars-forward " \t")
  445. (while t
  446. (let ((ind (org-get-indentation)))
  447. (cond
  448. ((or (>= (point) limit)
  449. (looking-at ":END:"))
  450. (throw 'exit (progn
  451. ;; Ensure bottom is just after a
  452. ;; non-blank line.
  453. (skip-chars-backward " \r\t\n")
  454. (min (point-max) (1+ (point-at-eol))))))
  455. ((= (point) (point-at-eol))
  456. (skip-chars-forward " \r\t\n")
  457. (beginning-of-line))
  458. ((org-at-item-p)
  459. (setq ind-ref (min ind ind-ref))
  460. (forward-line 1))
  461. ((<= ind ind-ref)
  462. (throw 'exit (point-at-bol)))
  463. ((looking-at "#\\+begin_")
  464. (re-search-forward "[ \t]*#\\+end_")
  465. (forward-line 1))
  466. (t (forward-line 1)))))))))
  467. (defun org-list-at-regexp-after-bullet-p (regexp)
  468. "Is point at a list item with REGEXP after bullet?"
  469. (and (org-at-item-p)
  470. (save-excursion
  471. (goto-char (match-end 0))
  472. ;; Ignore counter if any
  473. (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
  474. (goto-char (match-end 0)))
  475. (looking-at regexp))))
  476. (defun org-list-get-item-same-level (search-fun pos limit pre-move)
  477. "Return point at the beginning of next item at the same level.
  478. Search items using function SEARCH-FUN, from POS to LIMIT. It
  479. uses PRE-MOVE before search. Return nil if no item was found."
  480. (save-excursion
  481. (goto-char pos)
  482. (let* ((start (org-get-item-beginning))
  483. (ind (progn (goto-char start) (org-get-indentation))))
  484. ;; We don't want to match the current line.
  485. (funcall pre-move)
  486. ;; Skip any sublist on the way
  487. (while (and (funcall search-fun org-item-beginning-re limit t)
  488. (> (org-get-indentation) ind)))
  489. (when (and (/= (point-at-bol) start) ; Have we moved ?
  490. (= (org-get-indentation) ind))
  491. (point-at-bol)))))
  492. (defun org-list-separating-blank-lines-number (pos top bottom)
  493. "Return number of blank lines that should separate items in list.
  494. POS is the position of point to be considered.
  495. TOP and BOTTOM are respectively position of list beginning and
  496. list ending.
  497. Assume point is at item's beginning. If the item is alone, apply
  498. some heuristics to guess the result."
  499. (save-excursion
  500. (let ((insert-blank-p
  501. (cdr (assq 'plain-list-item org-blank-before-new-entry)))
  502. usr-blank)
  503. (cond
  504. ;; Trivial cases where there should be none.
  505. ((or (and (not (eq org-list-ending-method 'indent))
  506. org-empty-line-terminates-plain-lists)
  507. (not insert-blank-p)) 0)
  508. ;; When `org-blank-before-new-entry' says so, it is 1.
  509. ((eq insert-blank-p t) 1)
  510. ;; plain-list-item is 'auto. Count blank lines separating
  511. ;; neighbours items in list.
  512. (t (let ((next-p (org-get-next-item (point) bottom)))
  513. (cond
  514. ;; Is there a next item?
  515. (next-p (goto-char next-p)
  516. (org-back-over-empty-lines))
  517. ;; Is there a previous item?
  518. ((org-get-previous-item (point) top)
  519. (org-back-over-empty-lines))
  520. ;; User inserted blank lines, trust him
  521. ((and (> pos (org-end-of-item-before-blank bottom))
  522. (> (save-excursion
  523. (goto-char pos)
  524. (skip-chars-backward " \t")
  525. (setq usr-blank (org-back-over-empty-lines))) 0))
  526. usr-blank)
  527. ;; Are there blank lines inside the item ?
  528. ((save-excursion
  529. (org-search-forward-unenclosed
  530. "^[ \t]*$" (org-end-of-item-before-blank bottom) t)) 1)
  531. ;; No parent: no blank line.
  532. (t 0))))))))
  533. (defun org-list-insert-item-generic (pos &optional checkbox after-bullet)
  534. "Insert a new list item at POS.
  535. If POS is before first character after bullet of the item, the
  536. new item will be created before the current one.
  537. Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET
  538. after the bullet. Cursor will be after this text once the
  539. function ends."
  540. (goto-char pos)
  541. ;; Is point in a special block?
  542. (when (org-in-regexps-block-p
  543. "^[ \t]*#\\+\\(begin\\|BEGIN\\)_\\([a-zA-Z0-9_]+\\)"
  544. '(concat "^[ \t]*#\\+\\(end\\|END\\)_" (match-string 2)))
  545. (if (not (cdr (assq 'insert org-list-automatic-rules)))
  546. ;; Rule in `org-list-automatic-rules' forbids insertion.
  547. (error "Cannot insert item inside a block")
  548. ;; Else, move before it prior to add a new item.
  549. (end-of-line)
  550. (re-search-backward "^[ \t]*#\\+\\(begin\\|BEGIN\\)_" nil t)
  551. (end-of-line 0)))
  552. (let* ((true-pos (point))
  553. (top (org-list-top-point))
  554. (bottom (copy-marker (org-list-bottom-point)))
  555. (bullet (and (goto-char (org-get-item-beginning))
  556. (org-list-bullet-string (org-get-bullet))))
  557. (ind (org-get-indentation))
  558. (before-p (progn
  559. ;; Description item: text starts after colons.
  560. (or (org-at-item-description-p)
  561. ;; At a checkbox: text starts after it.
  562. (org-at-item-checkbox-p)
  563. ;; Otherwise, text starts after bullet.
  564. (org-at-item-p))
  565. (<= true-pos (match-end 0))))
  566. (blank-lines-nb (org-list-separating-blank-lines-number
  567. true-pos top bottom))
  568. (insert-fun
  569. (lambda (text)
  570. ;; insert bullet above item in order to avoid bothering
  571. ;; with possible blank lines ending last item.
  572. (goto-char (org-get-item-beginning))
  573. (indent-to-column ind)
  574. (insert (concat bullet (when checkbox "[ ] ") after-bullet))
  575. ;; Stay between after-bullet and before text.
  576. (save-excursion
  577. (insert (concat text (make-string (1+ blank-lines-nb) ?\n))))
  578. (unless before-p
  579. ;; store bottom: exchanging items doesn't change list
  580. ;; bottom point but will modify marker anyway
  581. (setq bottom (marker-position bottom))
  582. (let ((col (current-column)))
  583. (org-list-exchange-items
  584. (org-get-item-beginning) (org-get-next-item (point) bottom)
  585. bottom)
  586. ;; recompute next-item: last sexp modified list
  587. (goto-char (org-get-next-item (point) bottom))
  588. (org-move-to-column col)))
  589. (when checkbox (org-update-checkbox-count-maybe))
  590. (org-list-repair nil top bottom))))
  591. (goto-char true-pos)
  592. (cond
  593. (before-p (funcall insert-fun nil) t)
  594. ;; Can't split item: insert bullet at the end of item.
  595. ((not (org-get-alist-option org-M-RET-may-split-line 'item))
  596. (funcall insert-fun nil) t)
  597. ;; else, insert a new bullet along with everything from point
  598. ;; down to last non-blank line of item.
  599. (t
  600. (delete-horizontal-space)
  601. ;; Get pos again in case previous command modified line.
  602. (let* ((pos (point))
  603. (end-before-blank (org-end-of-item-before-blank bottom))
  604. (after-text
  605. (when (< pos end-before-blank)
  606. (prog1
  607. (delete-and-extract-region pos end-before-blank)
  608. ;; delete any blank line at and before point.
  609. (beginning-of-line)
  610. (while (looking-at "^[ \t]*$")
  611. (delete-region (point-at-bol) (1+ (point-at-eol)))
  612. (beginning-of-line 0))))))
  613. (funcall insert-fun after-text) t)))))
  614. (defvar org-last-indent-begin-marker (make-marker))
  615. (defvar org-last-indent-end-marker (make-marker))
  616. (defun org-list-indent-item-generic (arg no-subtree top bottom)
  617. "Indent a local list item including its children.
  618. When number ARG is a negative, item will be outdented, otherwise
  619. it will be indented.
  620. If a region is active, all items inside will be moved.
  621. If NO-SUBTREE is non-nil, only indent the item itself, not its
  622. children.
  623. TOP and BOTTOM are respectively position at item beginning and at
  624. item ending.
  625. Return t if successful."
  626. (let* ((regionp (org-region-active-p))
  627. (rbeg (and regionp (region-beginning)))
  628. (rend (and regionp (region-end))))
  629. (cond
  630. ((and regionp
  631. (goto-char rbeg)
  632. (not (org-search-forward-unenclosed org-item-beginning-re rend t)))
  633. (error "No item in region"))
  634. ((not (org-at-item-p))
  635. (error "Not on an item"))
  636. (t
  637. ;; Are we going to move the whole list?
  638. (let* ((specialp (and (cdr (assq 'indent org-list-automatic-rules))
  639. (not no-subtree)
  640. (= top (point-at-bol)))))
  641. ;; Determine begin and end points of zone to indent. If moving
  642. ;; more than one item, ensure we keep them on subsequent moves.
  643. (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft))
  644. (memq this-command '(org-shiftmetaright org-shiftmetaleft)))
  645. (if regionp
  646. (progn
  647. (set-marker org-last-indent-begin-marker rbeg)
  648. (set-marker org-last-indent-end-marker rend))
  649. (set-marker org-last-indent-begin-marker (point-at-bol))
  650. (set-marker org-last-indent-end-marker
  651. (save-excursion
  652. (cond
  653. (specialp bottom)
  654. (no-subtree (org-end-of-item-or-at-child bottom))
  655. (t (org-get-end-of-item bottom)))))))
  656. ;; Get everything ready
  657. (let* ((beg (marker-position org-last-indent-begin-marker))
  658. (end (marker-position org-last-indent-end-marker))
  659. (struct (org-list-struct
  660. beg end top (if specialp end bottom) (< arg 0)))
  661. (origins (org-list-struct-origins struct))
  662. (beg-item (assq beg struct)))
  663. (cond
  664. ;; Special case: moving top-item with indent rule
  665. (specialp
  666. (let* ((level-skip (org-level-increment))
  667. (offset (if (< arg 0) (- level-skip) level-skip))
  668. (top-ind (nth 1 beg-item)))
  669. (if (< (+ top-ind offset) 0)
  670. (error "Cannot outdent beyond margin")
  671. ;; Change bullet if necessary
  672. (when (and (= (+ top-ind offset) 0)
  673. (string-match "*" (nth 2 beg-item)))
  674. (setcdr beg-item (list (nth 1 beg-item)
  675. (org-list-bullet-string "-"))))
  676. ;; Shift ancestor
  677. (let ((anc (car struct)))
  678. (setcdr anc (list (+ (nth 1 anc) offset) "" nil)))
  679. (org-list-struct-fix-struct struct origins)
  680. (org-list-struct-apply-struct struct end))))
  681. ;; Forbidden move
  682. ((and (< arg 0)
  683. (or (and no-subtree
  684. (not regionp)
  685. (org-list-struct-get-child beg-item struct))
  686. (let ((last-item (save-excursion
  687. (goto-char end)
  688. (skip-chars-backward " \r\t\n")
  689. (goto-char (org-get-item-beginning))
  690. (org-list-struct-assoc-at-point))))
  691. (org-list-struct-get-child last-item struct))))
  692. (error "Cannot outdent an item without its children"))
  693. ;; Normal shifting
  694. (t
  695. (let* ((shifted-ori (if (< arg 0)
  696. (org-list-struct-outdent beg end origins)
  697. (org-list-struct-indent beg end origins struct))))
  698. (org-list-struct-fix-struct struct shifted-ori)
  699. (org-list-struct-apply-struct struct bottom))))))))))
  700. ;;; Predicates
  701. (defun org-in-item-p ()
  702. "Is the cursor inside a plain list?
  703. This checks `org-list-ending-method'."
  704. (unless (let ((outline-regexp org-outline-regexp)) (org-at-heading-p))
  705. (let* ((prev-head (save-excursion (outline-previous-heading)))
  706. (bound (if prev-head
  707. (or (save-excursion
  708. (let ((case-fold-search t))
  709. (re-search-backward "^[ \t]*:END:" prev-head t)))
  710. prev-head)
  711. (point-min))))
  712. (cond
  713. ((eq org-list-ending-method 'regexp)
  714. (org-list-in-item-p-with-regexp bound))
  715. ((eq org-list-ending-method 'indent)
  716. (org-list-in-item-p-with-indent bound))
  717. (t (and (org-list-in-item-p-with-regexp bound)
  718. (org-list-in-item-p-with-indent bound)))))))
  719. (defun org-list-first-item-p (top)
  720. "Is this item the first item in a plain list?
  721. Assume point is at an item.
  722. TOP is the position of list's top-item."
  723. (save-excursion
  724. (beginning-of-line)
  725. (let ((ind (org-get-indentation)))
  726. (or (not (org-search-backward-unenclosed org-item-beginning-re top t))
  727. (< (org-get-indentation) ind)))))
  728. (defun org-at-item-p ()
  729. "Is point in a line starting a hand-formatted item?"
  730. (save-excursion
  731. (beginning-of-line) (looking-at org-item-beginning-re)))
  732. (defun org-at-item-bullet-p ()
  733. "Is point at the bullet of a plain list item?"
  734. (and (org-at-item-p)
  735. (not (member (char-after) '(?\ ?\t)))
  736. (< (point) (match-end 0))))
  737. (defun org-at-item-timer-p ()
  738. "Is point at a line starting a plain list item with a timer?"
  739. (org-list-at-regexp-after-bullet-p
  740. "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+"))
  741. (defun org-at-item-description-p ()
  742. "Is point at a description list item?"
  743. (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::[ \t]+"))
  744. (defun org-at-item-checkbox-p ()
  745. "Is point at a line starting a plain-list item with a checklet?"
  746. (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+"))
  747. (defun org-checkbox-blocked-p ()
  748. "Is the current checkbox blocked from for being checked now?
  749. A checkbox is blocked if all of the following conditions are fulfilled:
  750. 1. The checkbox is not checked already.
  751. 2. The current entry has the ORDERED property set.
  752. 3. There is an unchecked checkbox in this entry before the current line."
  753. (catch 'exit
  754. (save-match-data
  755. (save-excursion
  756. (unless (org-at-item-checkbox-p) (throw 'exit nil))
  757. (when (equal (match-string 1) "[X]")
  758. ;; the box is already checked!
  759. (throw 'exit nil))
  760. (let ((end (point-at-bol)))
  761. (condition-case nil (org-back-to-heading t)
  762. (error (throw 'exit nil)))
  763. (unless (org-entry-get nil "ORDERED") (throw 'exit nil))
  764. (when (org-search-forward-unenclosed
  765. "^[ \t]*[-+*0-9.)]+[ \t]+\\(\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[[- ]\\]" end t)
  766. (org-current-line)))))))
  767. ;;; Navigate
  768. ;; Every interactive navigation function is derived from a
  769. ;; non-interactive one, which doesn't move point, assumes point is
  770. ;; already in a list and doesn't compute list boundaries.
  771. ;; If you plan to use more than one org-list function is some code,
  772. ;; you should therefore first compute list boundaries, and then make
  773. ;; use of non-interactive forms.
  774. (defun org-list-top-point ()
  775. "Return point at the top level in a list.
  776. Assume point is in a list."
  777. (let* ((prev-head (save-excursion (outline-previous-heading)))
  778. (bound (if prev-head
  779. (or (save-excursion
  780. (let ((case-fold-search t))
  781. (re-search-backward "^[ \t]*:END:" prev-head t)))
  782. prev-head)
  783. (point-min))))
  784. (cond
  785. ((eq org-list-ending-method 'regexp)
  786. (org-list-top-point-with-regexp bound))
  787. ((eq org-list-ending-method 'indent)
  788. (org-list-top-point-with-indent bound))
  789. (t (let ((top-re (org-list-top-point-with-regexp bound)))
  790. (org-list-top-point-with-indent (or top-re bound)))))))
  791. (defun org-list-bottom-point ()
  792. "Return point just before list ending.
  793. Assume point is in a list."
  794. (let* ((next-head (save-excursion
  795. (and (let ((outline-regexp org-outline-regexp))
  796. ;; Use default regexp because folding
  797. ;; changes OUTLINE-REGEXP.
  798. (outline-next-heading)))))
  799. (limit (or (save-excursion
  800. (and (re-search-forward "^[ \t]*:END:" next-head t)
  801. (point-at-bol)))
  802. next-head
  803. (point-max))))
  804. (cond
  805. ((eq org-list-ending-method 'regexp)
  806. (org-list-bottom-point-with-regexp limit))
  807. ((eq org-list-ending-method 'indent)
  808. (org-list-bottom-point-with-indent limit))
  809. (t (let ((bottom-re (org-list-bottom-point-with-regexp limit)))
  810. (org-list-bottom-point-with-indent (or bottom-re limit)))))))
  811. (defun org-get-item-beginning ()
  812. "Return position of current item beginning."
  813. (save-excursion
  814. ;; possibly match current line
  815. (end-of-line)
  816. (org-search-backward-unenclosed org-item-beginning-re nil t)
  817. (point-at-bol)))
  818. (defun org-beginning-of-item ()
  819. "Go to the beginning of the current hand-formatted item.
  820. If the cursor is not in an item, throw an error."
  821. (interactive)
  822. (if (org-in-item-p)
  823. (goto-char (org-get-item-beginning))
  824. (error "Not in an item")))
  825. (defun org-get-beginning-of-list (top)
  826. "Return position of the first item of the current list or sublist.
  827. TOP is the position at list beginning."
  828. (save-excursion
  829. (let (prev-p)
  830. (while (setq prev-p (org-get-previous-item (point) top))
  831. (goto-char prev-p))
  832. (point-at-bol))))
  833. (defun org-beginning-of-item-list ()
  834. "Go to the beginning item of the current list or sublist.
  835. Return an error if not in a list."
  836. (interactive)
  837. (if (org-in-item-p)
  838. (goto-char (org-get-beginning-of-list (org-list-top-point)))
  839. (error "Not in an item")))
  840. (defun org-get-end-of-list (bottom)
  841. "Return position at the end of the current list or sublist.
  842. BOTTOM is the position at list ending."
  843. (save-excursion
  844. (goto-char (org-get-item-beginning))
  845. (let ((ind (org-get-indentation)))
  846. (while (and (/= (point) bottom)
  847. (>= (org-get-indentation) ind))
  848. (org-search-forward-unenclosed org-item-beginning-re bottom 'move))
  849. (if (= (point) bottom) bottom (point-at-bol)))))
  850. (defun org-end-of-item-list ()
  851. "Go to the end of the current list or sublist.
  852. If the cursor in not in an item, throw an error."
  853. (interactive)
  854. (if (org-in-item-p)
  855. (goto-char (org-get-end-of-list (org-list-bottom-point)))
  856. (error "Not in an item")))
  857. (defun org-get-end-of-item (bottom)
  858. "Return position at the end of the current item.
  859. BOTTOM is the position at list ending."
  860. (let* ((next-p (org-get-next-item (point) bottom)))
  861. (or next-p (org-get-end-of-list bottom))))
  862. (defun org-end-of-item ()
  863. "Go to the end of the current hand-formatted item.
  864. If the cursor is not in an item, throw an error."
  865. (interactive)
  866. (if (org-in-item-p)
  867. (goto-char (org-get-end-of-item (org-list-bottom-point)))
  868. (error "Not in an item")))
  869. (defun org-end-of-item-or-at-child (bottom)
  870. "Move to the end of the item, stops before the first child if any.
  871. BOTTOM is the position at list ending."
  872. (end-of-line)
  873. (goto-char
  874. (if (org-search-forward-unenclosed org-item-beginning-re bottom t)
  875. (point-at-bol)
  876. (org-get-end-of-item bottom))))
  877. (defun org-end-of-item-before-blank (bottom)
  878. "Return point at end of item, before any blank line.
  879. Point returned is at eol.
  880. BOTTOM is the position at list ending."
  881. (save-excursion
  882. (goto-char (org-get-end-of-item bottom))
  883. (skip-chars-backward " \r\t\n")
  884. (point-at-eol)))
  885. (defun org-get-previous-item (pos limit)
  886. "Return point of the previous item at the same level as POS.
  887. Stop searching at LIMIT. Return nil if no item is found."
  888. (org-list-get-item-same-level
  889. #'org-search-backward-unenclosed pos limit #'beginning-of-line))
  890. (defun org-previous-item ()
  891. "Move to the beginning of the previous item.
  892. Item is at the same level in the current plain list. Error if not
  893. in a plain list, or if this is the first item in the list."
  894. (interactive)
  895. (if (not (org-in-item-p))
  896. (error "Not in an item")
  897. (let ((prev-p (org-get-previous-item (point) (org-list-top-point))))
  898. (if prev-p (goto-char prev-p) (error "On first item")))))
  899. (defun org-get-next-item (pos limit)
  900. "Return point of the next item at the same level as POS.
  901. Stop searching at LIMIT. Return nil if no item is found."
  902. (org-list-get-item-same-level
  903. #'org-search-forward-unenclosed pos limit #'end-of-line))
  904. (defun org-next-item ()
  905. "Move to the beginning of the next item.
  906. Item is at the same level in the current plain list. Error if not
  907. in a plain list, or if this is the last item in the list."
  908. (interactive)
  909. (if (not (org-in-item-p))
  910. (error "Not in an item")
  911. (let ((next-p (org-get-next-item (point) (org-list-bottom-point))))
  912. (if next-p (goto-char next-p) (error "On last item")))))
  913. ;;; Manipulate
  914. (defun org-list-exchange-items (beg-A beg-B bottom)
  915. "Swap item starting at BEG-A with item starting at BEG-B.
  916. Blank lines at the end of items are left in place. Assume BEG-A
  917. is lesser than BEG-B.
  918. BOTTOM is the position at list ending."
  919. (save-excursion
  920. (let* ((end-of-item-no-blank
  921. (lambda (pos)
  922. (goto-char pos)
  923. (goto-char (org-end-of-item-before-blank bottom))))
  924. (end-A-no-blank (funcall end-of-item-no-blank beg-A))
  925. (end-B-no-blank (funcall end-of-item-no-blank beg-B))
  926. (body-A (buffer-substring beg-A end-A-no-blank))
  927. (body-B (buffer-substring beg-B end-B-no-blank))
  928. (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)))
  929. (goto-char beg-A)
  930. (delete-region beg-A end-B-no-blank)
  931. (insert (concat body-B between-A-no-blank-and-B body-A)))))
  932. (defun org-move-item-down ()
  933. "Move the plain list item at point down, i.e. swap with following item.
  934. Subitems (items with larger indentation) are considered part of the item,
  935. so this really moves item trees."
  936. (interactive)
  937. (if (not (org-at-item-p))
  938. (error "Not at an item")
  939. (let* ((pos (point))
  940. (col (current-column))
  941. (bottom (org-list-bottom-point))
  942. (actual-item (goto-char (org-get-item-beginning)))
  943. (next-item (org-get-next-item (point) bottom)))
  944. (if (not next-item)
  945. (progn
  946. (goto-char pos)
  947. (error "Cannot move this item further down"))
  948. (org-list-exchange-items actual-item next-item bottom)
  949. (org-list-repair nil nil bottom)
  950. (goto-char (org-get-next-item (point) bottom))
  951. (move-to-column col)))))
  952. (defun org-move-item-up ()
  953. "Move the plain list item at point up, i.e. swap with previous item.
  954. Subitems (items with larger indentation) are considered part of the item,
  955. so this really moves item trees."
  956. (interactive)
  957. (if (not (org-at-item-p))
  958. (error "Not at an item")
  959. (let* ((pos (point))
  960. (col (current-column))
  961. (top (org-list-top-point))
  962. (bottom (org-list-bottom-point))
  963. (actual-item (goto-char (org-get-item-beginning)))
  964. (prev-item (org-get-previous-item (point) top)))
  965. (if (not prev-item)
  966. (progn
  967. (goto-char pos)
  968. (error "Cannot move this item further up"))
  969. (org-list-exchange-items prev-item actual-item bottom)
  970. (org-list-repair nil top bottom)
  971. (move-to-column col)))))
  972. (defun org-insert-item (&optional checkbox)
  973. "Insert a new item at the current level.
  974. If cursor is before first character after bullet of the item, the
  975. new item will be created before the current one.
  976. If CHECKBOX is non-nil, add a checkbox next to the bullet.
  977. Return t when things worked, nil when we are not in an item, or
  978. item is invisible."
  979. (unless (or (not (org-in-item-p))
  980. (org-invisible-p))
  981. (if (save-excursion
  982. (goto-char (org-get-item-beginning))
  983. (org-at-item-timer-p))
  984. ;; Timer list: delegate to `org-timer-item'.
  985. (progn (org-timer-item) t)
  986. ;; if we're in a description list, ask for the new term.
  987. (let ((desc-text (when (save-excursion
  988. (and (goto-char (org-get-item-beginning))
  989. (org-at-item-description-p)))
  990. (concat (read-string "Term: ") " :: "))))
  991. ;; Don't insert a checkbox if checkbox rule is applied and it
  992. ;; is a description item.
  993. (org-list-insert-item-generic
  994. (point) (and checkbox
  995. (or (not desc-text)
  996. (not (cdr (assq 'checkbox org-list-automatic-rules)))))
  997. desc-text)))))
  998. ;;; Structures
  999. ;; The idea behind structures is to avoid moving back and forth in the
  1000. ;; buffer on costly operations like indenting or fixing bullets.
  1001. ;; It achieves this by taking a snapshot of an interesting part of the
  1002. ;; list, in the shape of an alist, using `org-list-struct'.
  1003. ;; It then proceeds to changes directly on the alist, with the help of
  1004. ;; and `org-list-struct-origins'. When those are done,
  1005. ;; `org-list-struct-apply-struct' applies the changes to the buffer.
  1006. (defun org-list-struct-assoc-at-point ()
  1007. "Return the structure association at point.
  1008. It is a cons-cell whose key is point and values are indentation,
  1009. bullet string and bullet counter, if any."
  1010. (save-excursion
  1011. (beginning-of-line)
  1012. (list (point-at-bol)
  1013. (org-get-indentation)
  1014. (progn
  1015. (looking-at "^[ \t]*\\([-+*0-9.)]+[ \t]+\\)")
  1016. (match-string 1))
  1017. (progn
  1018. (goto-char (match-end 0))
  1019. (and (looking-at "\\[@\\(?:start:\\)?\\([0-9]+\\)\\]")
  1020. (match-string 1))))))
  1021. (defun org-list-struct (begin end top bottom &optional outdent)
  1022. "Return the structure containing the list between BEGIN and END.
  1023. A structure is an alist where key is point of item and values
  1024. are, in that order, indentation, bullet string and value of
  1025. counter, if any. A structure contains every list and sublist that
  1026. has items between BEGIN and END along with their common ancestor.
  1027. If no such ancestor can be found, the function will add a virtual
  1028. ancestor at position 0.
  1029. TOP and BOTTOM are respectively the position of list beginning
  1030. and list ending.
  1031. If OUTDENT is non-nil, it will also grab all of the parent list
  1032. and the grand-parent. Setting OUTDENT to t is mandatory when next
  1033. change is an outdent."
  1034. (save-excursion
  1035. (let* (struct
  1036. (extend
  1037. (lambda (struct)
  1038. (let* ((ind-min (apply 'min (mapcar 'cadr struct)))
  1039. (begin (caar struct))
  1040. (end (caar (last struct)))
  1041. pre-list post-list)
  1042. (goto-char begin)
  1043. ;; Find beginning of most outdented list (min list)
  1044. (while (and (org-search-backward-unenclosed
  1045. org-item-beginning-re top t)
  1046. (>= (org-get-indentation) ind-min))
  1047. (setq pre-list (cons (org-list-struct-assoc-at-point)
  1048. pre-list)))
  1049. ;; Now get the parent. If none, add a virtual ancestor
  1050. (if (< (org-get-indentation) ind-min)
  1051. (setq pre-list (cons (org-list-struct-assoc-at-point)
  1052. pre-list))
  1053. (setq pre-list (cons (list 0 (org-get-indentation) "" nil)
  1054. pre-list)))
  1055. ;; Find end of min list
  1056. (goto-char end)
  1057. (end-of-line)
  1058. (while (and (org-search-forward-unenclosed
  1059. org-item-beginning-re bottom 'move)
  1060. (>= (org-get-indentation) ind-min))
  1061. (setq post-list (cons (org-list-struct-assoc-at-point)
  1062. post-list)))
  1063. ;; Is list is malformed? If some items are less
  1064. ;; indented that top-item, add them anyhow.
  1065. (when (and (= (caar pre-list) 0) (< (point) bottom))
  1066. (beginning-of-line)
  1067. (while (org-search-forward-unenclosed
  1068. org-item-beginning-re bottom t)
  1069. (setq post-list (cons (org-list-struct-assoc-at-point)
  1070. post-list))))
  1071. (append pre-list struct (reverse post-list))))))
  1072. ;; Here we start: first get the core zone...
  1073. (goto-char end)
  1074. (while (org-search-backward-unenclosed org-item-beginning-re begin t)
  1075. (setq struct (cons (org-list-struct-assoc-at-point) struct)))
  1076. ;; ... then, extend it to make it a structure...
  1077. (let ((extended (funcall extend struct)))
  1078. ;; ... twice when OUTDENT is non-nil and struct still can be
  1079. ;; extended
  1080. (if (and outdent (> (caar extended) 0))
  1081. (funcall extend extended)
  1082. extended)))))
  1083. (defun org-list-struct-origins (struct)
  1084. "Return an alist where key is item's position and value parent's.
  1085. STRUCT is the list's structure looked up."
  1086. (let* ((struct-rev (reverse struct))
  1087. (acc (list (cons (nth 1 (car struct)) 0)))
  1088. (prev-item (lambda (item)
  1089. (car (nth 1 (member (assq item struct) struct-rev)))))
  1090. (get-origins
  1091. (lambda (item)
  1092. (let* ((item-pos (car item))
  1093. (ind (nth 1 item))
  1094. (prev-ind (caar acc)))
  1095. (cond
  1096. ;; List closing.
  1097. ((> prev-ind ind)
  1098. (let ((current-origin (or (member (assq ind acc) acc)
  1099. ;; needed if top-point is
  1100. ;; not the most outdented
  1101. (last acc))))
  1102. (setq acc current-origin)
  1103. (cons item-pos (cdar acc))))
  1104. ;; New list
  1105. ((< prev-ind ind)
  1106. (let ((origin (funcall prev-item item-pos)))
  1107. (setq acc (cons (cons ind origin) acc))
  1108. (cons item-pos origin)))
  1109. ;; Current list going on
  1110. (t (cons item-pos (cdar acc))))))))
  1111. (cons '(0 . 0) (mapcar get-origins (cdr struct)))))
  1112. (defun org-list-struct-get-parent (item struct origins)
  1113. "Return parent association of ITEM in STRUCT or nil.
  1114. ORIGINS is the alist of parents. See `org-list-struct-origins'."
  1115. (let* ((parent-pos (cdr (assq (car item) origins))))
  1116. (when (> parent-pos 0) (assq parent-pos struct))))
  1117. (defun org-list-struct-get-child (item struct)
  1118. "Return child association of ITEM in STRUCT or nil."
  1119. (let ((ind (nth 1 item))
  1120. (next-item (cadr (member item struct))))
  1121. (when (and next-item (> (nth 1 next-item) ind)) next-item)))
  1122. (defun org-list-struct-fix-bul (struct origins)
  1123. "Verify and correct bullets for every association in STRUCT.
  1124. ORIGINS is the alist of parents. See `org-list-struct-origins'.
  1125. This function modifies STRUCT."
  1126. (let* (acc
  1127. (init-bul (lambda (item)
  1128. (let ((counter (nth 3 item))
  1129. (bullet (org-list-bullet-string (nth 2 item))))
  1130. (cond
  1131. ((and (string-match "[0-9]+" bullet) counter)
  1132. (replace-match counter nil nil bullet))
  1133. ((string-match "[0-9]+" bullet)
  1134. (replace-match "1" nil nil bullet))
  1135. (t bullet)))))
  1136. (set-bul (lambda (item bullet)
  1137. (setcdr item (list (nth 1 item) bullet (nth 3 item)))))
  1138. (get-bul (lambda (item bullet)
  1139. (let* ((counter (nth 3 item)))
  1140. (if (and counter (string-match "[0-9]+" bullet))
  1141. (replace-match counter nil nil bullet)
  1142. bullet))))
  1143. (fix-bul
  1144. (lambda (item) struct
  1145. (let* ((parent (cdr (assq (car item) origins)))
  1146. (orig-ref (assq parent acc)))
  1147. (if orig-ref
  1148. ;; Continuing previous list
  1149. (let* ((prev-bul (cdr orig-ref))
  1150. (new-bul (funcall get-bul item prev-bul)))
  1151. (setcdr orig-ref (org-list-inc-bullet-maybe new-bul))
  1152. (funcall set-bul item new-bul))
  1153. ;; A new list is starting
  1154. (let ((new-bul (funcall init-bul item)))
  1155. (funcall set-bul item new-bul)
  1156. (setq acc (cons (cons parent
  1157. (org-list-inc-bullet-maybe new-bul))
  1158. acc))))))))
  1159. (mapc fix-bul (cdr struct))))
  1160. (defun org-list-struct-fix-ind (struct origins)
  1161. "Verify and correct indentation for every association in STRUCT.
  1162. ORIGINS is the alist of parents. See `org-list-struct-origins'.
  1163. This function modifies STRUCT."
  1164. (let* ((headless (cdr struct))
  1165. (ancestor (car struct))
  1166. (top-ind (+ (nth 1 ancestor) (length (nth 2 ancestor))))
  1167. (new-ind
  1168. (lambda (item)
  1169. (let* ((parent (org-list-struct-get-parent item headless origins)))
  1170. (if parent
  1171. ;; Indent like parent + length of parent's bullet
  1172. (setcdr item (cons (+ (length (nth 2 parent)) (nth 1 parent))
  1173. (cddr item)))
  1174. ;; If no parent, indent like top-point
  1175. (setcdr item (cons top-ind (cddr item))))))))
  1176. (mapc new-ind headless)))
  1177. (defun org-list-struct-fix-struct (struct origins)
  1178. "Return STRUCT with correct bullets and indentation.
  1179. ORIGINS is the alist of parents. See `org-list-struct-origins'.
  1180. Only elements of STRUCT that have changed are returned."
  1181. (let ((old (copy-alist struct)))
  1182. (org-list-struct-fix-bul struct origins)
  1183. (org-list-struct-fix-ind struct origins)
  1184. (delq nil (mapcar (lambda (e) (when (not (equal (pop old) e)) e)) struct))))
  1185. (defun org-list-struct-outdent (start end origins)
  1186. "Outdent items in a structure.
  1187. Items are indented when their key is between START, included, and
  1188. END, excluded.
  1189. ORIGINS is the alist of parents. See `org-list-struct-origins'.
  1190. STRUCT is the concerned structure."
  1191. (let* (acc
  1192. (out (lambda (cell)
  1193. (let* ((item (car cell))
  1194. (parent (cdr cell)))
  1195. (cond
  1196. ;; Item not yet in zone: keep association
  1197. ((< item start) cell)
  1198. ;; Item out of zone: follow associations in acc
  1199. ((>= item end)
  1200. (let ((convert (assq parent acc)))
  1201. (if convert (cons item (cdr convert)) cell)))
  1202. ;; Item has no parent: error
  1203. ((<= parent 0)
  1204. (error "Cannot outdent top-level items"))
  1205. ;; Parent is outdented: keep association
  1206. ((>= parent start)
  1207. (setq acc (cons (cons parent item) acc)) cell)
  1208. (t
  1209. ;; Parent isn't outdented: reparent to grand-parent
  1210. (let ((grand-parent (cdr (assq parent origins))))
  1211. (setq acc (cons (cons parent item) acc))
  1212. (cons item grand-parent))))))))
  1213. (mapcar out origins)))
  1214. (defun org-list-struct-indent (start end origins struct)
  1215. "Indent items in a structure.
  1216. Items are indented when their key is between START, included, and
  1217. END, excluded.
  1218. ORIGINS is the alist of parents. See `org-list-struct-origins'.
  1219. STRUCT is the concerned structure. It may be modified if
  1220. `org-list-demote-modify-bullet' matches bullets between START and
  1221. END."
  1222. (let* (acc
  1223. (orig-rev (reverse origins))
  1224. (get-prev-item
  1225. (lambda (cell parent)
  1226. (car (rassq parent (cdr (memq cell orig-rev))))))
  1227. (set-assoc
  1228. (lambda (cell)
  1229. (setq acc (cons cell acc)) cell))
  1230. (change-bullet-maybe
  1231. (lambda (item)
  1232. (let* ((full-item (assq item struct))
  1233. (item-bul (org-trim (nth 2 full-item)))
  1234. (new-bul-p (cdr (assoc item-bul org-list-demote-modify-bullet))))
  1235. (when new-bul-p
  1236. ;; new bullet is stored without space to ensure item
  1237. ;; will be modified
  1238. (setcdr full-item
  1239. (list (nth 1 full-item)
  1240. new-bul-p
  1241. (nth 3 full-item)))))))
  1242. (ind
  1243. (lambda (cell)
  1244. (let* ((item (car cell))
  1245. (parent (cdr cell)))
  1246. (cond
  1247. ;; Item not yet in zone: keep association
  1248. ((< item start) cell)
  1249. ((>= item end)
  1250. ;; Item out of zone: follow associations in acc
  1251. (let ((convert (assq parent acc)))
  1252. (if convert (cons item (cdr convert)) cell)))
  1253. (t
  1254. ;; Item is in zone...
  1255. (let ((prev (funcall get-prev-item cell parent)))
  1256. ;; Check if bullet needs to be changed
  1257. (funcall change-bullet-maybe item)
  1258. (cond
  1259. ;; First item indented but not parent: error
  1260. ((and (or (not prev) (= prev 0)) (< parent start))
  1261. (error "Cannot indent the first item of a list"))
  1262. ;; First item and parent indented: keep same parent
  1263. ((or (not prev) (= prev 0))
  1264. (funcall set-assoc cell))
  1265. ;; Previous item not indented: reparent to it
  1266. ((< prev start)
  1267. (funcall set-assoc (cons item prev)))
  1268. ;; Previous item indented: reparent like it
  1269. (t
  1270. (funcall set-assoc (cons item
  1271. (cdr (assq prev acc)))))))))))))
  1272. (mapcar ind origins)))
  1273. (defun org-list-struct-apply-struct (struct bottom)
  1274. "Apply modifications to list so it mirrors STRUCT.
  1275. BOTTOM is position at list ending.
  1276. Initial position is restored after the changes."
  1277. (let* ((pos (copy-marker (point)))
  1278. (ancestor (caar struct))
  1279. (modify
  1280. (lambda (item)
  1281. (goto-char (car item))
  1282. (let* ((new-ind (nth 1 item))
  1283. (new-bul (org-list-bullet-string (nth 2 item)))
  1284. (old-ind (org-get-indentation))
  1285. (old-bul (progn
  1286. (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
  1287. (match-string 1)))
  1288. (old-body-ind (+ (length old-bul) old-ind))
  1289. (new-body-ind (+ (length new-bul) new-ind)))
  1290. ;; 1. Shift item's body
  1291. (unless (= old-body-ind new-body-ind)
  1292. (org-shift-item-indentation
  1293. (- new-body-ind old-body-ind) bottom))
  1294. ;; 2. Replace bullet
  1295. (unless (equal new-bul old-bul)
  1296. (save-excursion
  1297. (looking-at "[ \t]*\\(\\S-+[ \t]*\\)")
  1298. (replace-match new-bul nil nil nil 1)))
  1299. ;; 3. Indent item to appropriate column
  1300. (unless (= new-ind old-ind)
  1301. (delete-region (point-at-bol)
  1302. (progn
  1303. (skip-chars-forward " \t")
  1304. (point)))
  1305. (indent-to new-ind)))))
  1306. ;; Remove ancestor if it is left.
  1307. (struct-to-apply (if (or (not ancestor) (= 0 ancestor))
  1308. (cdr struct)
  1309. struct)))
  1310. ;; Apply changes from bottom to top
  1311. (mapc modify (nreverse struct-to-apply))
  1312. (goto-char pos)))
  1313. ;;; Indentation
  1314. (defun org-get-string-indentation (s)
  1315. "What indentation has S due to SPACE and TAB at the beginning of the string?"
  1316. (let ((n -1) (i 0) (w tab-width) c)
  1317. (catch 'exit
  1318. (while (< (setq n (1+ n)) (length s))
  1319. (setq c (aref s n))
  1320. (cond ((= c ?\ ) (setq i (1+ i)))
  1321. ((= c ?\t) (setq i (* (/ (+ w i) w) w)))
  1322. (t (throw 'exit t)))))
  1323. i))
  1324. (defun org-shift-item-indentation (delta bottom)
  1325. "Shift the indentation in current item by DELTA.
  1326. Sub-items are not moved.
  1327. BOTTOM is position at list ending."
  1328. (save-excursion
  1329. (let ((beg (point-at-bol))
  1330. (end (org-end-of-item-or-at-child bottom)))
  1331. (beginning-of-line (unless (eolp) 0))
  1332. (while (> (point) beg)
  1333. (when (looking-at "[ \t]*\\S-")
  1334. ;; this is not an empty line
  1335. (let ((i (org-get-indentation)))
  1336. (when (and (> i 0) (> (+ i delta) 0))
  1337. (indent-line-to (+ i delta)))))
  1338. (beginning-of-line 0)))))
  1339. (defun org-outdent-item ()
  1340. "Outdent a local list item, but not its children.
  1341. If a region is active, all items inside will be moved."
  1342. (interactive)
  1343. (org-list-indent-item-generic
  1344. -1 t (org-list-top-point) (org-list-bottom-point)))
  1345. (defun org-indent-item ()
  1346. "Indent a local list item, but not its children.
  1347. If a region is active, all items inside will be moved."
  1348. (interactive)
  1349. (org-list-indent-item-generic
  1350. 1 t (org-list-top-point) (org-list-bottom-point)))
  1351. (defun org-outdent-item-tree ()
  1352. "Outdent a local list item including its children.
  1353. If a region is active, all items inside will be moved."
  1354. (interactive)
  1355. (org-list-indent-item-generic
  1356. -1 nil (org-list-top-point) (org-list-bottom-point)))
  1357. (defun org-indent-item-tree ()
  1358. "Indent a local list item including its children.
  1359. If a region is active, all items inside will be moved."
  1360. (interactive)
  1361. (org-list-indent-item-generic
  1362. 1 nil (org-list-top-point) (org-list-bottom-point)))
  1363. (defvar org-tab-ind-state)
  1364. (defun org-cycle-item-indentation ()
  1365. "Cycle levels of indentation of an empty item.
  1366. The first run indent the item, if applicable. Subsequents runs
  1367. outdent it at meaningful levels in the list. When done, item is
  1368. put back at its original position with its original bullet.
  1369. Return t at each successful move."
  1370. (let ((org-adapt-indentation nil)
  1371. (ind (org-get-indentation))
  1372. (bottom (and (org-at-item-p) (org-list-bottom-point))))
  1373. (when (and (or (org-at-item-description-p)
  1374. (org-at-item-checkbox-p)
  1375. (org-at-item-p))
  1376. ;; Check that item is really empty
  1377. (>= (match-end 0) (save-excursion
  1378. (org-end-of-item-or-at-child bottom)
  1379. (skip-chars-backward " \r\t\n")
  1380. (point))))
  1381. (setq this-command 'org-cycle-item-indentation)
  1382. (let ((top (org-list-top-point)))
  1383. ;; When in the middle of the cycle, try to outdent first. If it
  1384. ;; fails, and point is still at initial position, indent. Else,
  1385. ;; go back to original position.
  1386. (if (eq last-command 'org-cycle-item-indentation)
  1387. (cond
  1388. ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
  1389. ((and (= (org-get-indentation) (car org-tab-ind-state))
  1390. (ignore-errors
  1391. (org-list-indent-item-generic 1 t top bottom))))
  1392. (t (back-to-indentation)
  1393. (indent-to-column (car org-tab-ind-state))
  1394. (end-of-line)
  1395. (org-list-repair (cdr org-tab-ind-state))
  1396. ;; Break cycle
  1397. (setq this-command 'identity)))
  1398. ;; If a cycle is starting, remember indentation and bullet,
  1399. ;; then try to indent. If it fails, try to outdent.
  1400. (setq org-tab-ind-state (cons ind (org-get-bullet)))
  1401. (cond
  1402. ((ignore-errors (org-list-indent-item-generic 1 t top bottom)))
  1403. ((ignore-errors (org-list-indent-item-generic -1 t top bottom)))
  1404. (t (error "Cannot move item")))))
  1405. t)))
  1406. ;;; Bullets
  1407. (defun org-get-bullet ()
  1408. "Return the bullet of the item at point.
  1409. Assume cursor is at an item."
  1410. (save-excursion
  1411. (beginning-of-line)
  1412. (and (looking-at "[ \t]*\\(\\S-+\\)") (match-string 1))))
  1413. (defun org-list-bullet-string (bullet)
  1414. "Return BULLET with the correct number of whitespaces.
  1415. It determines the number of whitespaces to append by looking at
  1416. `org-list-two-spaces-after-bullet-regexp'."
  1417. (save-match-data
  1418. (string-match "\\S-+\\([ \t]*\\)" bullet)
  1419. (replace-match
  1420. (save-match-data
  1421. (concat
  1422. " "
  1423. ;; Do we need to concat another white space ?
  1424. (when (and org-list-two-spaces-after-bullet-regexp
  1425. (string-match org-list-two-spaces-after-bullet-regexp bullet))
  1426. " ")))
  1427. nil nil bullet 1)))
  1428. (defun org-list-inc-bullet-maybe (bullet)
  1429. "Increment BULLET if applicable."
  1430. (if (string-match "[0-9]+" bullet)
  1431. (replace-match
  1432. (number-to-string (1+ (string-to-number (match-string 0 bullet))))
  1433. nil nil bullet)
  1434. bullet))
  1435. (defun org-list-repair (&optional force-bullet top bottom)
  1436. "Make sure all items are correctly indented, with the right bullet.
  1437. This function scans the list at point, along with any sublist.
  1438. If FORCE-BULLET is a string, ensure all items in list share this
  1439. bullet, or a logical successor in the case of an ordered list.
  1440. When non-nil, TOP and BOTTOM specify respectively position of
  1441. list beginning and list ending.
  1442. Item's body is not indented, only shifted with the bullet."
  1443. (interactive)
  1444. (unless (org-at-item-p) (error "This is not a list"))
  1445. (let* ((bottom (or bottom (org-list-bottom-point)))
  1446. (struct (org-list-struct
  1447. (point-at-bol) (point-at-eol)
  1448. (or top (org-list-top-point)) bottom))
  1449. (origins (org-list-struct-origins struct))
  1450. fixed-struct)
  1451. (if (stringp force-bullet)
  1452. (let ((begin (nth 1 struct)))
  1453. (setcdr begin (list (nth 1 begin)
  1454. (org-list-bullet-string force-bullet)
  1455. (nth 3 begin)))
  1456. (setq fixed-struct
  1457. (cons begin (org-list-struct-fix-struct struct origins))))
  1458. (setq fixed-struct (org-list-struct-fix-struct struct origins)))
  1459. (org-list-struct-apply-struct fixed-struct bottom)))
  1460. (defun org-cycle-list-bullet (&optional which)
  1461. "Cycle through the different itemize/enumerate bullets.
  1462. This cycle the entire list level through the sequence:
  1463. `-' -> `+' -> `*' -> `1.' -> `1)'
  1464. If WHICH is a valid string, use that as the new bullet. If WHICH
  1465. is an integer, 0 means `-', 1 means `+' etc. If WHICH is
  1466. 'previous, cycle backwards."
  1467. (interactive "P")
  1468. (let* ((top (org-list-top-point))
  1469. (bullet (save-excursion
  1470. (goto-char (org-get-beginning-of-list top))
  1471. (org-get-bullet)))
  1472. (current (cond
  1473. ((string-match "\\." bullet) "1.")
  1474. ((string-match ")" bullet) "1)")
  1475. (t bullet)))
  1476. (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules)))
  1477. (bullet-list (append '("-" "+" )
  1478. ;; *-bullets are not allowed at column 0
  1479. (unless (and bullet-rule-p
  1480. (looking-at "\\S-")) '("*"))
  1481. ;; Description items cannot be numbered
  1482. (unless (and bullet-rule-p
  1483. (or (eq org-plain-list-ordered-item-terminator ?.)
  1484. (org-at-item-description-p))) '("1)"))
  1485. (unless (and bullet-rule-p
  1486. (or (eq org-plain-list-ordered-item-terminator ?\))
  1487. (org-at-item-description-p))) '("1."))))
  1488. (len (length bullet-list))
  1489. (item-index (- len (length (member current bullet-list))))
  1490. (get-value (lambda (index) (nth (mod index len) bullet-list)))
  1491. (new (cond
  1492. ((member which bullet-list) which)
  1493. ((numberp which) (funcall get-value which))
  1494. ((eq 'previous which) (funcall get-value (1- item-index)))
  1495. (t (funcall get-value (1+ item-index))))))
  1496. (org-list-repair new top)))
  1497. ;;; Checkboxes
  1498. (defun org-toggle-checkbox (&optional toggle-presence)
  1499. "Toggle the checkbox in the current line.
  1500. With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With
  1501. double prefix, set checkbox to [-].
  1502. When there is an active region, toggle status or presence of the
  1503. first checkbox there, and make every item inside have the
  1504. same status or presence, respectively.
  1505. If the cursor is in a headline, apply this to all checkbox items
  1506. in the text below the heading, taking as reference the first item
  1507. in subtree, ignoring drawers."
  1508. (interactive "P")
  1509. ;; Bounds is a list of type (beg end single-p) where single-p is t
  1510. ;; when `org-toggle-checkbox' is applied to a single item. Only
  1511. ;; toggles on single items will return errors.
  1512. (let* ((bounds
  1513. (cond
  1514. ((org-region-active-p)
  1515. (let ((rbeg (region-beginning))
  1516. (rend (region-end)))
  1517. (save-excursion
  1518. (goto-char rbeg)
  1519. (if (org-search-forward-unenclosed org-item-beginning-re rend 'move)
  1520. (list (point-at-bol) rend nil)
  1521. (error "No item in region")))))
  1522. ((org-on-heading-p)
  1523. ;; In this case, reference line is the first item in
  1524. ;; subtree outside drawers
  1525. (let ((pos (point))
  1526. (limit (save-excursion (outline-next-heading) (point))))
  1527. (save-excursion
  1528. (goto-char limit)
  1529. (org-search-backward-unenclosed ":END:" pos 'move)
  1530. (org-search-forward-unenclosed
  1531. org-item-beginning-re limit 'move)
  1532. (list (point) limit nil))))
  1533. ((org-at-item-p)
  1534. (list (point-at-bol) (point-at-eol) t))
  1535. (t (error "Not at an item or heading, and no active region"))))
  1536. (beg (car bounds))
  1537. ;; marker is needed because deleting or inserting checkboxes
  1538. ;; will change bottom point
  1539. (end (copy-marker (nth 1 bounds)))
  1540. (single-p (nth 2 bounds))
  1541. (ref-presence (save-excursion
  1542. (goto-char beg)
  1543. (org-at-item-checkbox-p)))
  1544. (ref-status (equal (match-string 1) "[X]"))
  1545. (act-on-item
  1546. (lambda (ref-pres ref-stat)
  1547. (if (equal toggle-presence '(4))
  1548. (cond
  1549. ((and ref-pres (org-at-item-checkbox-p))
  1550. (replace-match ""))
  1551. ((and (not ref-pres)
  1552. (not (org-at-item-checkbox-p))
  1553. (org-at-item-p))
  1554. (goto-char (match-end 0))
  1555. ;; Ignore counter, if any
  1556. (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
  1557. (goto-char (match-end 0)))
  1558. (let ((desc-p (and (org-at-item-description-p)
  1559. (cdr (assq 'checkbox org-list-automatic-rules)))))
  1560. (cond
  1561. ((and single-p desc-p)
  1562. (error "Cannot add a checkbox in a description list"))
  1563. ((not desc-p) (insert "[ ] "))))))
  1564. (let ((blocked (org-checkbox-blocked-p)))
  1565. (cond
  1566. ((and blocked single-p)
  1567. (error "Checkbox blocked because of unchecked box in line %d" blocked))
  1568. (blocked nil)
  1569. ((org-at-item-checkbox-p)
  1570. (replace-match
  1571. (cond ((equal toggle-presence '(16)) "[-]")
  1572. (ref-stat "[ ]")
  1573. (t "[X]"))
  1574. t t nil 1))))))))
  1575. (save-excursion
  1576. (goto-char beg)
  1577. (while (< (point) end)
  1578. (funcall act-on-item ref-presence ref-status)
  1579. (org-search-forward-unenclosed org-item-beginning-re end 'move)))
  1580. (org-update-checkbox-count-maybe)))
  1581. (defun org-reset-checkbox-state-subtree ()
  1582. "Reset all checkboxes in an entry subtree."
  1583. (interactive "*")
  1584. (save-restriction
  1585. (save-excursion
  1586. (org-narrow-to-subtree)
  1587. (org-show-subtree)
  1588. (goto-char (point-min))
  1589. (let ((end (point-max)))
  1590. (while (< (point) end)
  1591. (when (org-at-item-checkbox-p)
  1592. (replace-match "[ ]" t t nil 1))
  1593. (beginning-of-line 2))))
  1594. (org-update-checkbox-count-maybe)))
  1595. (defvar org-checkbox-statistics-hook nil
  1596. "Hook that is run whenever Org thinks checkbox statistics should be updated.
  1597. This hook runs even if checkbox rule in
  1598. `org-list-automatic-rules' does not apply, so it can be used to
  1599. implement alternative ways of collecting statistics
  1600. information.")
  1601. (defun org-update-checkbox-count-maybe ()
  1602. "Update checkbox statistics unless turned off by user."
  1603. (when (cdr (assq 'checkbox org-list-automatic-rules))
  1604. (org-update-checkbox-count))
  1605. (run-hooks 'org-checkbox-statistics-hook))
  1606. (defun org-update-checkbox-count (&optional all)
  1607. "Update the checkbox statistics in the current section.
  1608. This will find all statistic cookies like [57%] and [6/12] and update them
  1609. with the current numbers. With optional prefix argument ALL, do this for
  1610. the whole buffer."
  1611. (interactive "P")
  1612. (save-excursion
  1613. (let ((cstat 0))
  1614. (catch 'exit
  1615. (while t
  1616. (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21
  1617. (beg (condition-case nil
  1618. (progn (org-back-to-heading) (point))
  1619. (error (point-min))))
  1620. (end (copy-marker (save-excursion
  1621. (outline-next-heading) (point))))
  1622. (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
  1623. (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
  1624. beg-cookie end-cookie is-percent c-on c-off lim new
  1625. curr-ind next-ind continue-from startsearch list-beg list-end
  1626. (recursive
  1627. (or (not org-hierarchical-checkbox-statistics)
  1628. (string-match "\\<recursive\\>"
  1629. (or (ignore-errors
  1630. (org-entry-get nil "COOKIE_DATA"))
  1631. "")))))
  1632. (goto-char end)
  1633. ;; find each statistics cookie
  1634. (while (and (org-search-backward-unenclosed re-cookie beg 'move)
  1635. (not (save-match-data
  1636. (and (org-on-heading-p)
  1637. (string-match "\\<todo\\>"
  1638. (downcase
  1639. (or (org-entry-get
  1640. nil "COOKIE_DATA")
  1641. "")))))))
  1642. (setq beg-cookie (match-beginning 1)
  1643. end-cookie (match-end 1)
  1644. cstat (+ cstat (if end-cookie 1 0))
  1645. startsearch (point-at-eol)
  1646. continue-from (match-beginning 0)
  1647. is-percent (match-beginning 2)
  1648. lim (cond
  1649. ((org-on-heading-p) (outline-next-heading) (point))
  1650. ;; Ensure many cookies in the same list won't imply
  1651. ;; computing list boundaries as many times.
  1652. ((org-at-item-p)
  1653. (unless (and list-beg (>= (point) list-beg))
  1654. (setq list-beg (org-list-top-point)
  1655. list-end (copy-marker
  1656. (org-list-bottom-point))))
  1657. (org-get-end-of-item list-end))
  1658. (t nil))
  1659. c-on 0
  1660. c-off 0)
  1661. (when lim
  1662. ;; find first checkbox for this cookie and gather
  1663. ;; statistics from all that are at this indentation level
  1664. (goto-char startsearch)
  1665. (if (org-search-forward-unenclosed re-box lim t)
  1666. (progn
  1667. (beginning-of-line)
  1668. (setq curr-ind (org-get-indentation))
  1669. (setq next-ind curr-ind)
  1670. (while (and (bolp) (org-at-item-p)
  1671. (if recursive
  1672. (<= curr-ind next-ind)
  1673. (= curr-ind next-ind)))
  1674. (when (org-at-item-checkbox-p)
  1675. (if (member (match-string 1) '("[ ]" "[-]"))
  1676. (setq c-off (1+ c-off))
  1677. (setq c-on (1+ c-on))))
  1678. (if (not recursive)
  1679. ;; org-get-next-item goes through list-enders
  1680. ;; with proper limit.
  1681. (goto-char (or (org-get-next-item (point) lim) lim))
  1682. (end-of-line)
  1683. (when (org-search-forward-unenclosed
  1684. org-item-beginning-re lim t)
  1685. (beginning-of-line)))
  1686. (setq next-ind (org-get-indentation)))))
  1687. (goto-char continue-from)
  1688. ;; update cookie
  1689. (when end-cookie
  1690. (setq new (if is-percent
  1691. (format "[%d%%]" (/ (* 100 c-on)
  1692. (max 1 (+ c-on c-off))))
  1693. (format "[%d/%d]" c-on (+ c-on c-off))))
  1694. (goto-char beg-cookie)
  1695. (insert new)
  1696. (delete-region (point) (+ (point) (- end-cookie beg-cookie))))
  1697. ;; update items checkbox if it has one
  1698. (when (and (org-at-item-checkbox-p)
  1699. (> (+ c-on c-off) 0))
  1700. (setq beg-cookie (match-beginning 1)
  1701. end-cookie (match-end 1))
  1702. (delete-region beg-cookie end-cookie)
  1703. (goto-char beg-cookie)
  1704. (cond ((= c-off 0) (insert "[X]"))
  1705. ((= c-on 0) (insert "[ ]"))
  1706. (t (insert "[-]")))))
  1707. (goto-char continue-from)))
  1708. (unless (and all (outline-next-heading)) (throw 'exit nil))))
  1709. (when (interactive-p)
  1710. (message "Checkbox statistics updated %s (%d places)"
  1711. (if all "in entire file" "in current outline entry") cstat)))))
  1712. (defun org-get-checkbox-statistics-face ()
  1713. "Select the face for checkbox statistics.
  1714. The face will be `org-done' when all relevant boxes are checked.
  1715. Otherwise it will be `org-todo'."
  1716. (if (match-end 1)
  1717. (if (equal (match-string 1) "100%")
  1718. 'org-checkbox-statistics-done
  1719. 'org-checkbox-statistics-todo)
  1720. (if (and (> (match-end 2) (match-beginning 2))
  1721. (equal (match-string 2) (match-string 3)))
  1722. 'org-checkbox-statistics-done
  1723. 'org-checkbox-statistics-todo)))
  1724. ;;; Misc Tools
  1725. (defun org-apply-on-list (function init-value &rest args)
  1726. "Call FUNCTION for each item of a the list under point.
  1727. FUNCTION must be called with at least one argument: INIT-VALUE,
  1728. that will contain the value returned by the function at the
  1729. previous item, plus ARGS extra arguments.
  1730. As an example, (org-apply-on-list (lambda (result) (1+ result)) 0)
  1731. will return the number of items in the current list.
  1732. Sublists of the list are skipped. Cursor is always at the
  1733. beginning of the item."
  1734. (let* ((pos (copy-marker (point)))
  1735. (end (copy-marker (org-list-bottom-point)))
  1736. (next-p (copy-marker (org-get-beginning-of-list (org-list-top-point))))
  1737. (value init-value))
  1738. (while (< next-p end)
  1739. (goto-char next-p)
  1740. (set-marker next-p (or (org-get-next-item (point) end) end))
  1741. (setq value (apply function value args)))
  1742. (goto-char pos)
  1743. value))
  1744. (defun org-sort-list (&optional with-case sorting-type getkey-func compare-func)
  1745. "Sort plain list items.
  1746. The cursor may be at any item of the list that should be sorted.
  1747. Sublists are not sorted. Checkboxes, if any, are ignored.
  1748. Sorting can be alphabetically, numerically, by date/time as given by
  1749. a time stamp, by a property or by priority.
  1750. Comparing entries ignores case by default. However, with an
  1751. optional argument WITH-CASE, the sorting considers case as well.
  1752. The command prompts for the sorting type unless it has been given
  1753. to the function through the SORTING-TYPE argument, which needs to
  1754. be a character, \(?n ?N ?a ?A ?t ?T ?f ?F). Here is the precise
  1755. meaning of each character:
  1756. n Numerically, by converting the beginning of the item to a number.
  1757. a Alphabetically. Only the first line of item is checked.
  1758. t By date/time, either the first active time stamp in the entry, if
  1759. any, or by the first inactive one. In a timer list, sort the timers.
  1760. Capital letters will reverse the sort order.
  1761. If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a
  1762. function to be called with point at the beginning of the record.
  1763. It must return either a string or a number that should serve as
  1764. the sorting key for that record. It will then use COMPARE-FUNC to
  1765. compare entries."
  1766. (interactive "P")
  1767. (let* ((case-func (if with-case 'identity 'downcase))
  1768. (top (org-list-top-point))
  1769. (bottom (org-list-bottom-point))
  1770. (start (org-get-beginning-of-list top))
  1771. (end (org-get-end-of-list bottom))
  1772. (sorting-type
  1773. (progn
  1774. (message
  1775. "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc A/N/T/F means reversed:")
  1776. (read-char-exclusive)))
  1777. (getkey-func (and (= (downcase sorting-type) ?f)
  1778. (org-icompleting-read "Sort using function: "
  1779. obarray 'fboundp t nil nil)
  1780. (intern getkey-func))))
  1781. (message "Sorting items...")
  1782. (save-restriction
  1783. (narrow-to-region start end)
  1784. (let* ((dcst (downcase sorting-type))
  1785. (case-fold-search nil)
  1786. (now (current-time))
  1787. (sort-func (cond
  1788. ((= dcst ?a) 'string<)
  1789. ((= dcst ?f) compare-func)
  1790. ((= dcst ?t) '<)
  1791. (t nil)))
  1792. (begin-record (lambda ()
  1793. (skip-chars-forward " \r\t\n")
  1794. (beginning-of-line)))
  1795. (end-record (lambda ()
  1796. (goto-char (org-end-of-item-before-blank end))))
  1797. (value-to-sort
  1798. (lambda ()
  1799. (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+")
  1800. (cond
  1801. ((= dcst ?n)
  1802. (string-to-number (buffer-substring (match-end 0)
  1803. (point-at-eol))))
  1804. ((= dcst ?a)
  1805. (buffer-substring (match-end 0) (point-at-eol)))
  1806. ((= dcst ?t)
  1807. (cond
  1808. ;; If it is a timer list, convert timer to seconds
  1809. ((org-at-item-timer-p)
  1810. (org-timer-hms-to-secs (match-string 1)))
  1811. ((or (org-search-forward-unenclosed org-ts-regexp
  1812. (point-at-eol) t)
  1813. (org-search-forward-unenclosed org-ts-regexp-both
  1814. (point-at-eol) t))
  1815. (org-time-string-to-seconds (match-string 0)))
  1816. (t (org-float-time now))))
  1817. ((= dcst ?f)
  1818. (if getkey-func
  1819. (let ((value (funcall getkey-func)))
  1820. (if (stringp value)
  1821. (funcall case-func value)
  1822. value))
  1823. (error "Invalid key function `%s'" getkey-func)))
  1824. (t (error "Invalid sorting type `%c'" sorting-type)))))))
  1825. (sort-subr (/= dcst sorting-type)
  1826. begin-record
  1827. end-record
  1828. value-to-sort
  1829. nil
  1830. sort-func)
  1831. (org-list-repair nil top bottom)
  1832. (run-hooks 'org-after-sorting-entries-or-items-hook)
  1833. (message "Sorting items...done")))))
  1834. ;;; Send and receive lists
  1835. (defun org-list-parse-list (&optional delete)
  1836. "Parse the list at point and maybe DELETE it.
  1837. Return a list containing first level items as strings and
  1838. sublevels as a list of strings."
  1839. (let* ((start (goto-char (org-list-top-point)))
  1840. (end (org-list-bottom-point))
  1841. output itemsep ltype)
  1842. (while (org-search-forward-unenclosed org-item-beginning-re end t)
  1843. (save-excursion
  1844. (beginning-of-line)
  1845. (setq ltype (cond ((looking-at-p "^[ \t]*[0-9]") 'ordered)
  1846. ((org-at-item-description-p) 'descriptive)
  1847. (t 'unordered))))
  1848. (let* ((indent1 (org-get-indentation))
  1849. (nextitem (or (org-get-next-item (point) end) end))
  1850. (item (org-trim (buffer-substring (point)
  1851. (org-end-of-item-or-at-child end))))
  1852. (nextindent (if (= (point) end) 0 (org-get-indentation)))
  1853. (item (if (string-match
  1854. "^\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\[\\([xX ]\\)\\]"
  1855. item)
  1856. (replace-match (if (equal (match-string 1 item) " ")
  1857. "CBOFF"
  1858. "CBON")
  1859. t nil item 1)
  1860. item)))
  1861. (push item output)
  1862. (when (> nextindent indent1)
  1863. (save-restriction
  1864. (narrow-to-region (point) nextitem)
  1865. (push (org-list-parse-list) output)))))
  1866. (when delete
  1867. (delete-region start end)
  1868. (save-match-data
  1869. (when (and (not (eq org-list-ending-method 'indent))
  1870. (looking-at (org-list-end-re)))
  1871. (replace-match "\n"))))
  1872. (setq output (nreverse output))
  1873. (push ltype output)))
  1874. (defun org-list-make-subtree ()
  1875. "Convert the plain list at point into a subtree."
  1876. (interactive)
  1877. (if (not (org-in-item-p))
  1878. (error "Not in a list")
  1879. (let ((list (org-list-parse-list t)) nstars)
  1880. (save-excursion
  1881. (if (ignore-errors
  1882. (org-back-to-heading))
  1883. (progn (looking-at org-complex-heading-regexp)
  1884. (setq nstars (length (match-string 1))))
  1885. (setq nstars 0)))
  1886. (org-list-make-subtrees list (1+ nstars)))))
  1887. (defun org-list-make-subtrees (list level)
  1888. "Convert LIST into subtrees starting at LEVEL."
  1889. (if (symbolp (car list))
  1890. (org-list-make-subtrees (cdr list) level)
  1891. (mapcar (lambda (item)
  1892. (if (stringp item)
  1893. (insert (make-string
  1894. (if org-odd-levels-only
  1895. (1- (* 2 level)) level) ?*) " " item "\n")
  1896. (org-list-make-subtrees item (1+ level))))
  1897. list)))
  1898. (defun org-list-insert-radio-list ()
  1899. "Insert a radio list template appropriate for this major mode."
  1900. (interactive)
  1901. (let* ((e (assq major-mode org-list-radio-list-templates))
  1902. (txt (nth 1 e))
  1903. name pos)
  1904. (unless e (error "No radio list setup defined for %s" major-mode))
  1905. (setq name (read-string "List name: "))
  1906. (while (string-match "%n" txt)
  1907. (setq txt (replace-match name t t txt)))
  1908. (or (bolp) (insert "\n"))
  1909. (setq pos (point))
  1910. (insert txt)
  1911. (goto-char pos)))
  1912. (defun org-list-send-list (&optional maybe)
  1913. "Send a transformed version of this list to the receiver position.
  1914. With argument MAYBE, fail quietly if no transformation is defined for
  1915. this list."
  1916. (interactive)
  1917. (catch 'exit
  1918. (unless (org-at-item-p) (error "Not at a list item"))
  1919. (save-excursion
  1920. (re-search-backward "#\\+ORGLST" nil t)
  1921. (unless (looking-at "[ \t]*#\\+ORGLST[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
  1922. (if maybe
  1923. (throw 'exit nil)
  1924. (error "Don't know how to transform this list"))))
  1925. (let* ((name (match-string 1))
  1926. (transform (intern (match-string 2)))
  1927. (bottom-point
  1928. (save-excursion
  1929. (re-search-forward
  1930. "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t)
  1931. (match-beginning 0)))
  1932. (top-point
  1933. (progn
  1934. (re-search-backward "#\\+ORGLST" nil t)
  1935. (re-search-forward org-item-beginning-re bottom-point t)
  1936. (match-beginning 0)))
  1937. (list (save-restriction
  1938. (narrow-to-region top-point bottom-point)
  1939. (org-list-parse-list)))
  1940. beg txt)
  1941. (unless (fboundp transform)
  1942. (error "No such transformation function %s" transform))
  1943. (let ((txt (funcall transform list)))
  1944. ;; Find the insertion place
  1945. (save-excursion
  1946. (goto-char (point-min))
  1947. (unless (re-search-forward
  1948. (concat "BEGIN RECEIVE ORGLST +"
  1949. name
  1950. "\\([ \t]\\|$\\)") nil t)
  1951. (error "Don't know where to insert translated list"))
  1952. (goto-char (match-beginning 0))
  1953. (beginning-of-line 2)
  1954. (setq beg (point))
  1955. (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t)
  1956. (error "Cannot find end of insertion region"))
  1957. (delete-region beg (point-at-bol))
  1958. (goto-char beg)
  1959. (insert txt "\n")))
  1960. (message "List converted and installed at receiver location"))))
  1961. (defun org-list-to-generic (list params)
  1962. "Convert a LIST parsed through `org-list-parse-list' to other formats.
  1963. Valid parameters PARAMS are
  1964. :ustart String to start an unordered list
  1965. :uend String to end an unordered list
  1966. :ostart String to start an ordered list
  1967. :oend String to end an ordered list
  1968. :dstart String to start a descriptive list
  1969. :dend String to end a descriptive list
  1970. :dtstart String to start a descriptive term
  1971. :dtend String to end a descriptive term
  1972. :ddstart String to start a description
  1973. :ddend String to end a description
  1974. :splice When set to t, return only list body lines, don't wrap
  1975. them into :[u/o]start and :[u/o]end. Default is nil.
  1976. :istart String to start a list item
  1977. :iend String to end a list item
  1978. :isep String to separate items
  1979. :lsep String to separate sublists
  1980. :cboff String to insert for an unchecked checkbox
  1981. :cbon String to insert for a checked checkbox"
  1982. (interactive)
  1983. (let* ((p params) sublist
  1984. (splicep (plist-get p :splice))
  1985. (ostart (plist-get p :ostart))
  1986. (oend (plist-get p :oend))
  1987. (ustart (plist-get p :ustart))
  1988. (uend (plist-get p :uend))
  1989. (dstart (plist-get p :dstart))
  1990. (dend (plist-get p :dend))
  1991. (dtstart (plist-get p :dtstart))
  1992. (dtend (plist-get p :dtend))
  1993. (ddstart (plist-get p :ddstart))
  1994. (ddend (plist-get p :ddend))
  1995. (istart (plist-get p :istart))
  1996. (iend (plist-get p :iend))
  1997. (isep (plist-get p :isep))
  1998. (lsep (plist-get p :lsep))
  1999. (cbon (plist-get p :cbon))
  2000. (cboff (plist-get p :cboff)))
  2001. (let ((wrapper
  2002. (cond ((eq (car list) 'ordered)
  2003. (concat ostart "\n%s" oend "\n"))
  2004. ((eq (car list) 'unordered)
  2005. (concat ustart "\n%s" uend "\n"))
  2006. ((eq (car list) 'descriptive)
  2007. (concat dstart "\n%s" dend "\n"))))
  2008. rtn term defstart defend)
  2009. (while (setq sublist (pop list))
  2010. (cond ((symbolp sublist) nil)
  2011. ((stringp sublist)
  2012. (when (string-match "^\\(\\S-+\\)[ \t]+::" sublist)
  2013. (setq term (org-trim (format (concat dtstart "%s" dtend)
  2014. (match-string 1 sublist))))
  2015. (setq sublist (concat ddstart
  2016. (org-trim (substring sublist
  2017. (match-end 0)))
  2018. ddend)))
  2019. (if (string-match "\\[CBON\\]" sublist)
  2020. (setq sublist (replace-match cbon t t sublist)))
  2021. (if (string-match "\\[CBOFF\\]" sublist)
  2022. (setq sublist (replace-match cboff t t sublist)))
  2023. (if (string-match "\\[-\\]" sublist)
  2024. (setq sublist (replace-match "$\\boxminus$" t t sublist)))
  2025. (setq rtn (concat rtn istart term sublist iend isep)))
  2026. (t (setq rtn (concat rtn ;; previous list
  2027. lsep ;; list separator
  2028. (org-list-to-generic sublist p)
  2029. lsep ;; list separator
  2030. )))))
  2031. (format wrapper rtn))))
  2032. (defun org-list-to-latex (list &optional params)
  2033. "Convert LIST into a LaTeX list.
  2034. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  2035. with overruling parameters for `org-list-to-generic'."
  2036. (org-list-to-generic
  2037. list
  2038. (org-combine-plists
  2039. '(:splicep nil :ostart "\\begin{enumerate}" :oend "\\end{enumerate}"
  2040. :ustart "\\begin{itemize}" :uend "\\end{itemize}"
  2041. :dstart "\\begin{description}" :dend "\\end{description}"
  2042. :dtstart "[" :dtend "]"
  2043. :ddstart "" :ddend ""
  2044. :istart "\\item " :iend ""
  2045. :isep "\n" :lsep "\n"
  2046. :cbon "\\texttt{[X]}" :cboff "\\texttt{[ ]}")
  2047. params)))
  2048. (defun org-list-to-html (list &optional params)
  2049. "Convert LIST into a HTML list.
  2050. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  2051. with overruling parameters for `org-list-to-generic'."
  2052. (org-list-to-generic
  2053. list
  2054. (org-combine-plists
  2055. '(:splicep nil :ostart "<ol>" :oend "</ol>"
  2056. :ustart "<ul>" :uend "</ul>"
  2057. :dstart "<dl>" :dend "</dl>"
  2058. :dtstart "<dt>" :dtend "</dt>"
  2059. :ddstart "<dd>" :ddend "</dd>"
  2060. :istart "<li>" :iend "</li>"
  2061. :isep "\n" :lsep "\n"
  2062. :cbon "<code>[X]</code>" :cboff "<code>[ ]</code>")
  2063. params)))
  2064. (defun org-list-to-texinfo (list &optional params)
  2065. "Convert LIST into a Texinfo list.
  2066. LIST is as returned by `org-list-parse-list'. PARAMS is a property list
  2067. with overruling parameters for `org-list-to-generic'."
  2068. (org-list-to-generic
  2069. list
  2070. (org-combine-plists
  2071. '(:splicep nil :ostart "@itemize @minus" :oend "@end itemize"
  2072. :ustart "@enumerate" :uend "@end enumerate"
  2073. :dstart "@table" :dend "@end table"
  2074. :dtstart "@item " :dtend "\n"
  2075. :ddstart "" :ddend ""
  2076. :istart "@item\n" :iend ""
  2077. :isep "\n" :lsep "\n"
  2078. :cbon "@code{[X]}" :cboff "@code{[ ]}")
  2079. params)))
  2080. (provide 'org-list)
  2081. ;; arch-tag: 73cf50c1-200f-4d1d-8a53-4e842a5b11c8
  2082. ;;; org-list.el ends here