org-list.el 119 KB

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