test-org-table.el 105 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373
  1. ;;; test-org-table.el --- tests for org-table.el -*- lexical-binding: t; -*-
  2. ;; Copyright (c) David Maus
  3. ;; Authors: David Maus, Michael Brand
  4. ;; This file is not part of GNU Emacs.
  5. ;; This program is free software; you can redistribute it and/or modify
  6. ;; it under the terms of the GNU General Public License as published by
  7. ;; the Free Software Foundation, either version 3 of the License, or
  8. ;; (at your option) any later version.
  9. ;; This program is distributed in the hope that it will be useful,
  10. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. ;; GNU General Public License for more details.
  13. ;; You should have received a copy of the GNU General Public License
  14. ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
  15. ;;;; Comments:
  16. ;; Template test file for Org tests. Many tests are also a howto
  17. ;; example collection as a user documentation, more or less all those
  18. ;; using `org-test-table-target-expect'. See also the doc string of
  19. ;; `org-test-table-target-expect'.
  20. ;;; Code:
  21. (require 'org-table) ; `org-table-make-reference'
  22. (require 'ox)
  23. (ert-deftest test-org-table/simple-formula/no-grouping/no-title-row ()
  24. "Simple sum without grouping rows, without title row."
  25. (org-test-table-target-expect
  26. "
  27. | 2 |
  28. | 4 |
  29. | 8 |
  30. | replace |
  31. "
  32. "
  33. | 2 |
  34. | 4 |
  35. | 8 |
  36. | 14 |
  37. "
  38. 1
  39. ;; Calc formula
  40. "#+TBLFM: @>$1 = vsum(@<..@>>)"
  41. ;; Lisp formula
  42. "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
  43. (ert-deftest test-org-table/simple-formula/no-grouping/with-title-row ()
  44. "Simple sum without grouping rows, with title row."
  45. (org-test-table-target-expect
  46. "
  47. | foo |
  48. |---------|
  49. | 2 |
  50. | 4 |
  51. | 8 |
  52. | replace |
  53. "
  54. "
  55. | foo |
  56. |-----|
  57. | 2 |
  58. | 4 |
  59. | 8 |
  60. | 14 |
  61. "
  62. 1
  63. ;; Calc formula
  64. "#+TBLFM: @>$1 = vsum(@I..@>>)"
  65. ;; Lisp formula
  66. "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
  67. (ert-deftest test-org-table/simple-formula/with-grouping/no-title-row ()
  68. "Simple sum with grouping rows, how not to do."
  69. ;; The first example has a problem, see the second example in this
  70. ;; ert-deftest.
  71. (org-test-table-target-expect
  72. "
  73. | 2 |
  74. | 4 |
  75. | 8 |
  76. |---------|
  77. | replace |
  78. "
  79. "
  80. | 2 |
  81. | 4 |
  82. | 8 |
  83. |----|
  84. | 14 |
  85. "
  86. 1
  87. ;; Calc formula
  88. "#+TBLFM: $1 = vsum(@<..@>>)"
  89. ;; Lisp formula
  90. "#+TBLFM: $1 = '(+ @<..@>>); N")
  91. ;; The problem is that the first three rows with the summands are
  92. ;; considered the header and therefore column formulas are not
  93. ;; applied on them as shown below. Also export behaves unexpected.
  94. ;; See next ert-deftest how to group rows right.
  95. (org-test-table-target-expect
  96. "
  97. | 2 | header |
  98. | 4 | header |
  99. | 8 | header |
  100. |---------+---------|
  101. | replace | replace |
  102. "
  103. "
  104. | 2 | header |
  105. | 4 | header |
  106. | 8 | header |
  107. |----+--------|
  108. | 14 | 28 |
  109. "
  110. 2
  111. ;; Calc formula
  112. "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
  113. ;; Lisp formula
  114. "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
  115. (ert-deftest test-org-table/simple-formula/with-grouping/with-title-row ()
  116. "Simple sum with grouping rows, how to do it right."
  117. ;; Always add a top row with the column names separated by hline to
  118. ;; get the desired header when you want to group rows.
  119. (org-test-table-target-expect
  120. "
  121. | foo | bar |
  122. |---------+---------|
  123. | 2 | replace |
  124. | 4 | replace |
  125. | 8 | replace |
  126. |---------+---------|
  127. | replace | replace |
  128. "
  129. "
  130. | foo | bar |
  131. |-----+-----|
  132. | 2 | 4 |
  133. | 4 | 8 |
  134. | 8 | 16 |
  135. |-----+-----|
  136. | 14 | 28 |
  137. "
  138. 2
  139. ;; Calc formula
  140. "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
  141. ;; Lisp formula
  142. "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
  143. (defconst references/target-normal "
  144. | 0 | 1 | replace | replace | replace | replace | replace | replace |
  145. | z | 1 | replace | replace | replace | replace | replace | replace |
  146. | | 1 | replace | replace | replace | replace | replace | replace |
  147. | | | replace | replace | replace | replace | replace | replace |
  148. "
  149. "Normal numbers and non-numbers for Lisp and Calc formula.")
  150. (defconst references/target-special "
  151. | nan | 1 | replace | replace | replace | replace | replace | replace |
  152. | uinf | 1 | replace | replace | replace | replace | replace | replace |
  153. | -inf | 1 | replace | replace | replace | replace | replace | replace |
  154. | inf | 1 | replace | replace | replace | replace | replace | replace |
  155. "
  156. "Special numbers for Calc formula.")
  157. (ert-deftest test-org-table/references/mode-string-EL ()
  158. "Basic: Assign field reference, sum of field references, sum
  159. and len of simple range reference (no row) and complex range
  160. reference (with row). Mode string EL."
  161. ;; Empty fields are kept during parsing field but lost as list
  162. ;; elements within Lisp formula syntactically when used literally
  163. ;; and not enclosed with " within fields, see last columns with len.
  164. (org-test-table-target-expect
  165. references/target-normal
  166. ;; All the #ERROR show that for Lisp calculations N has to be used.
  167. "
  168. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  169. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  170. | | 1 | | 1 | 1 | 1 | 1 | 1 |
  171. | | | | 0 | 0 | 0 | 0 | 0 |
  172. "
  173. 1 (concat
  174. "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
  175. "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
  176. "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
  177. ;; Empty fields are kept during parsing field _and_ as list elements
  178. ;; within Lisp formula syntactically even when used literally when
  179. ;; enclosed with " within fields, see last columns with len.
  180. (org-test-table-target-expect
  181. "
  182. | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
  183. | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
  184. | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
  185. | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
  186. "
  187. "
  188. | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
  189. | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
  190. | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
  191. | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
  192. "
  193. 1 (concat
  194. "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
  195. "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
  196. "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
  197. "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
  198. (ert-deftest test-org-table/references/mode-string-E ()
  199. "Basic: Assign field reference, sum of field references, sum
  200. and len of simple range reference (no row) and complex range
  201. reference (with row). Mode string E."
  202. (let ((lisp
  203. (concat
  204. "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
  205. "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
  206. "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
  207. (calc
  208. (concat
  209. "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
  210. "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
  211. "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
  212. (org-test-table-target-expect
  213. references/target-normal
  214. ;; All the #ERROR show that for Lisp calculations N has to be used.
  215. "
  216. | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
  217. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  218. | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
  219. | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
  220. "
  221. 1 lisp)
  222. (org-test-table-target-expect
  223. references/target-normal
  224. "
  225. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  226. | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
  227. | | 1 | nan | nan | nan | nan | 2 | 2 |
  228. | | | nan | nan | nan | nan | 2 | 2 |
  229. "
  230. 1 calc)
  231. (org-test-table-target-expect
  232. references/target-special
  233. "
  234. | nan | 1 | nan | nan | nan | nan | 2 | 2 |
  235. | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
  236. | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
  237. | inf | 1 | inf | inf | inf | inf | 2 | 2 |
  238. "
  239. 1 calc)))
  240. (ert-deftest test-org-table/references/mode-string-EN ()
  241. "Basic: Assign field reference, sum of field references, sum
  242. and len of simple range reference (no row) and complex range
  243. reference (with row). Mode string EN."
  244. (let ((lisp (concat
  245. "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
  246. "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
  247. "$7 = '(length '($1..$2)); EN :: "
  248. "$8 = '(length '(@0$1..@0$2)); EN"))
  249. (calc (concat
  250. "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
  251. "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
  252. "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
  253. (org-test-table-target-expect
  254. references/target-normal
  255. "
  256. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  257. | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  258. | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  259. | | | 0 | 0 | 0 | 0 | 2 | 2 |
  260. "
  261. 1 lisp calc)
  262. (org-test-table-target-expect
  263. references/target-special
  264. "
  265. | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  266. | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  267. | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  268. | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  269. "
  270. 1 calc)))
  271. (ert-deftest test-org-table/references/mode-string-L ()
  272. "Basic: Assign field reference, sum of field references, sum
  273. and len of simple range reference (no row) and complex range
  274. reference (with row). Mode string L."
  275. (org-test-table-target-expect
  276. references/target-normal
  277. ;; All the #ERROR show that for Lisp calculations N has to be used.
  278. "
  279. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  280. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  281. | | 1 | | 1 | 1 | 1 | 1 | 1 |
  282. | | | | 0 | 0 | 0 | 0 | 0 |
  283. "
  284. 1 (concat
  285. "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
  286. "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
  287. "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
  288. (ert-deftest test-org-table/references/mode-string-none ()
  289. "Basic: Assign field reference, sum of field references, sum
  290. and len of simple range reference (no row) and complex range
  291. reference (with row). No mode string."
  292. (let ((lisp (concat
  293. "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
  294. "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
  295. "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
  296. (calc (concat
  297. "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
  298. "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
  299. "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
  300. (org-test-table-target-expect
  301. references/target-normal
  302. ;; All the #ERROR show that for Lisp calculations N has to be used.
  303. "
  304. | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
  305. | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
  306. | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
  307. | | | | #ERROR | 0 | 0 | 0 | 0 |
  308. "
  309. 1 lisp)
  310. (org-test-table-target-expect
  311. references/target-normal
  312. "
  313. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  314. | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
  315. | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
  316. | | | 0 | 0 | 0 | 0 | 0 | 0 |
  317. "
  318. 1 calc)
  319. (org-test-table-target-expect
  320. references/target-special
  321. "
  322. | nan | 1 | nan | nan | nan | nan | 2 | 2 |
  323. | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
  324. | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
  325. | inf | 1 | inf | inf | inf | inf | 2 | 2 |
  326. "
  327. 1 calc)))
  328. (ert-deftest test-org-table/references/mode-string-N ()
  329. "Basic: Assign field reference, sum of field references, sum
  330. and len of simple range reference (no row) and complex range
  331. reference (with row). Mode string N."
  332. (let ((lisp
  333. (concat
  334. "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
  335. "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
  336. "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
  337. (calc
  338. (concat
  339. "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
  340. "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
  341. "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
  342. (org-test-table-target-expect
  343. references/target-normal
  344. "
  345. | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  346. | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  347. | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
  348. | | | 0 | 0 | 0 | 0 | 0 | 0 |
  349. "
  350. 1 lisp calc)
  351. (org-test-table-target-expect
  352. references/target-special
  353. "
  354. | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  355. | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  356. | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  357. | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
  358. "
  359. 1 calc)))
  360. (ert-deftest test-org-table/mode-string-u ()
  361. "Basic: verify that mode string u results in units
  362. simplification mode applied to Calc formulas."
  363. (org-test-table-target-expect
  364. "
  365. | 1.5 A/B | 2.0 B | |
  366. "
  367. "
  368. | 1.5 A/B | 2.0 B | 3. A |
  369. "
  370. 1 "#+TBLFM: $3=$1*$2;u"))
  371. (ert-deftest test-org-table/lisp-return-value ()
  372. "Basic: Return value of Lisp formulas."
  373. (org-test-table-target-expect
  374. "
  375. | | nil | (list) | '() |
  376. |-------------------------+-------------+--------+-----|
  377. | type-of, no L | replace (r) | r | r |
  378. | type-of identity, no L | r | r | r |
  379. | identity, no L | r | r | r |
  380. |-------------------------+-------------+--------+-----|
  381. | type-of \"@1\" | r | r | r |
  382. | type-of (identity \"@1\") | r | r | r |
  383. | identity \"@1\" | r | r | r |
  384. |-------------------------+-------------+--------+-----|
  385. | type-of @1 | r | r | r |
  386. | type-of (identity @1) | r | r | r |
  387. | identity @1 | r | r | r |
  388. "
  389. "
  390. | | nil | (list) | '() |
  391. |-------------------------+--------+--------+--------|
  392. | type-of, no L | string | string | string |
  393. | type-of identity, no L | string | string | string |
  394. | identity, no L | nil | (list) | '() |
  395. |-------------------------+--------+--------+--------|
  396. | type-of \"@1\" | string | string | string |
  397. | type-of (identity \"@1\") | string | string | string |
  398. | identity \"@1\" | nil | (list) | '() |
  399. |-------------------------+--------+--------+--------|
  400. | type-of @1 | symbol | symbol | symbol |
  401. | type-of (identity @1) | symbol | symbol | symbol |
  402. | identity @1 | nil | nil | nil |
  403. "
  404. 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
  405. "@3$<<..@3$> = '(type-of (identity @1)) :: "
  406. "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
  407. (ert-deftest test-org-table/compare ()
  408. "Basic: Compare field references in Calc."
  409. (org-test-table-target-expect
  410. "
  411. | | 0 | z | | nan | uinf | -inf | inf |
  412. |------+------+------+------+------+------+------+------|
  413. | 0 | repl | repl | repl | repl | repl | repl | repl |
  414. | z | repl | repl | repl | repl | repl | repl | repl |
  415. | | repl | repl | repl | repl | repl | repl | repl |
  416. | nan | repl | repl | repl | repl | repl | repl | repl |
  417. | uinf | repl | repl | repl | repl | repl | repl | repl |
  418. | -inf | repl | repl | repl | repl | repl | repl | repl |
  419. | inf | repl | repl | repl | repl | repl | repl | repl |
  420. "
  421. "
  422. | | 0 | z | | nan | uinf | -inf | inf |
  423. |------+---+---+---+-----+------+------+-----|
  424. | 0 | x | | | | | | |
  425. | z | | x | | | | | |
  426. | | | | x | | | | |
  427. | nan | | | | x | | | |
  428. | uinf | | | | | x | | |
  429. | -inf | | | | | | x | |
  430. | inf | | | | | | | x |
  431. "
  432. 1
  433. ;; Compare field reference ($1) with field reference (@1)
  434. "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
  435. ;; Compare field reference ($1) with absolute term
  436. (concat "#+TBLFM: "
  437. "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
  438. "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
  439. "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
  440. "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
  441. "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
  442. "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
  443. "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
  444. ;; Check field reference converted from an empty field: Despite this
  445. ;; field reference will not end up in a result, Calc evaluates it.
  446. ;; Make sure that also then there is no Calc error.
  447. (org-test-table-target-expect
  448. "
  449. | 0 | replace |
  450. | z | replace |
  451. | | replace |
  452. | nan | replace |
  453. "
  454. "
  455. | 0 | 1 |
  456. | z | z + 1 |
  457. | | |
  458. | nan | nan |
  459. "
  460. 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
  461. (ert-deftest test-org-table/empty-field ()
  462. "Examples how to deal with empty fields."
  463. ;; Test if one field is empty, else do a calculation
  464. (org-test-table-target-expect
  465. "
  466. | -1 | replace |
  467. | 0 | replace |
  468. | | replace |
  469. "
  470. "
  471. | -1 | 0 |
  472. | 0 | 1 |
  473. | | |
  474. "
  475. 1
  476. ;; Calc formula
  477. "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
  478. ;; Lisp formula
  479. "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
  480. ;; Test if several fields are empty, else do a calculation
  481. (org-test-table-target-expect
  482. "
  483. | 1 | 2 | replace |
  484. | 4 | | replace |
  485. | | 8 | replace |
  486. | | | replace |
  487. "
  488. "
  489. | 1 | 2 | 3 |
  490. | 4 | | |
  491. | | 8 | |
  492. | | | |
  493. "
  494. 1
  495. ;; Calc formula
  496. (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
  497. "string(\"\"), $1 + $2); E")
  498. ;; Lisp formula
  499. (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
  500. "\"\" (+ $1 $2)); L"))
  501. ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
  502. (org-test-table-target-expect
  503. "
  504. | 1.5 | 0 |
  505. | 3.5 | |
  506. | | 5 |
  507. | | |
  508. "
  509. "
  510. | 1.5 | 2.0 |
  511. | 3.5 | 4.0 |
  512. | | 5.0 |
  513. | | |
  514. "
  515. 1
  516. ;; Calc formula
  517. (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
  518. "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
  519. ;; Lisp formula not implemented yet
  520. )
  521. ;; Empty fields in simple and complex range reference
  522. (org-test-table-target-expect
  523. "
  524. | | | | | repl | repl | repl | repl | repl | repl |
  525. | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
  526. | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
  527. "
  528. "
  529. | | | | | | | | | 0 | 0 |
  530. | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
  531. | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
  532. "
  533. 1
  534. ;; Calc formula
  535. (concat
  536. "#+TBLFM: "
  537. "$5 = if(typeof(vmean($1..$4)) == 12, "
  538. "string(\"\"), vmean($1..$4)); E :: "
  539. "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
  540. "string(\"\"), vmean(@0$1..@0$4)); E :: "
  541. "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
  542. "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
  543. "$9 = vmean($1..$4); EN :: "
  544. "$10 = vmean(@0$1..@0$4); EN")
  545. ;; Lisp formula
  546. (concat
  547. "#+TBLFM: "
  548. "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
  549. "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
  550. "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
  551. "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
  552. "$7 = '(let ((l '($1..$4))) "
  553. "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
  554. "$8 = '(let ((l '(@0$1..@0$4))) "
  555. "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
  556. "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
  557. "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")))
  558. (ert-deftest test-org-table/copy-field ()
  559. "Experiments on how to copy one field into another field.
  560. See also `test-org-table/remote-reference-access'."
  561. (let ((target "
  562. | 0 | replace |
  563. | a b | replace |
  564. | c d | replace |
  565. | | replace |
  566. | 2012-12 | replace |
  567. | [2012-12-31 Mon] | replace |
  568. "))
  569. ;; Lisp formula to copy literally
  570. (org-test-table-target-expect
  571. target
  572. "
  573. | 0 | 0 |
  574. | a b | a b |
  575. | c d | c d |
  576. | | |
  577. | 2012-12 | 2012-12 |
  578. | [2012-12-31 Mon] | [2012-12-31 Mon] |
  579. "
  580. 1 "#+TBLFM: $2 = '(identity $1)")
  581. ;; Calc formula to copy quite literally
  582. (org-test-table-target-expect
  583. target
  584. "
  585. | 0 | 0 |
  586. | a b | a b |
  587. | c d | c d |
  588. | | |
  589. | 2012-12 | 2012-12 |
  590. | [2012-12-31 Mon] | [2012-12-31 Mon] |
  591. "
  592. 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
  593. "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
  594. ;; Calc formula simple
  595. (org-test-table-target-expect
  596. target
  597. "
  598. | 0 | 0 |
  599. | a b | a b |
  600. | c d | c d |
  601. | | |
  602. | 2012-12 | 2000 |
  603. | [2012-12-31 Mon] | [2012-12-31 Mon] |
  604. "
  605. 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
  606. (ert-deftest test-org-table/copy-down ()
  607. "Test `org-table-copy-down' specifications."
  608. ;; Error when there is nothing to copy in the current field or the
  609. ;; field above.
  610. (should-error
  611. (org-test-with-temp-text "| |\n| <point> |"
  612. (org-table-copy-down 1)))
  613. ;; Error when there is nothing to copy in the Nth field.
  614. (should-error
  615. (org-test-with-temp-text "| |\n| foo |\n| <point> |"
  616. (org-table-copy-down 2)))
  617. ;; In an empty field, copy field above.
  618. (should
  619. (equal "| foo |\n| foo |"
  620. (org-test-with-temp-text "| foo |\n| <point> |"
  621. (org-table-copy-down 1)
  622. (buffer-string))))
  623. ;; In a non-empty field, copy it below.
  624. (should
  625. (equal "| foo |\n| foo |\n"
  626. (org-test-with-temp-text "| <point>foo |"
  627. (org-table-copy-down 1)
  628. (buffer-string))))
  629. ;; If field is a number or a timestamp, or is prefixed or suffixed
  630. ;; with a number, increment it by one unit.
  631. (should
  632. (equal "| 1 |\n| 2 |\n"
  633. (org-test-with-temp-text "| <point>1 |"
  634. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  635. (buffer-string))))
  636. (should
  637. (string-match-p "<2012-03-30"
  638. (org-test-with-temp-text "| <point><2012-03-29> |"
  639. (let ((org-table-copy-increment t))
  640. (org-table-copy-down 1))
  641. (buffer-string))))
  642. (should
  643. (equal "| A1 |\n| A2 |\n"
  644. (org-test-with-temp-text "| <point>A1 |"
  645. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  646. (buffer-string))))
  647. (should
  648. (equal "| 1A |\n| 2A |\n"
  649. (org-test-with-temp-text "| <point>1A |"
  650. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  651. (buffer-string))))
  652. ;; When `org-table-copy-increment' is nil, or when argument is 0, do
  653. ;; not increment.
  654. (should
  655. (equal "| 1 |\n| 1 |\n"
  656. (org-test-with-temp-text "| <point>1 |"
  657. (let ((org-table-copy-increment nil)) (org-table-copy-down 1))
  658. (buffer-string))))
  659. (should
  660. (equal "| 1 |\n| 1 |\n"
  661. (org-test-with-temp-text "| <point>1 |"
  662. (let ((org-table-copy-increment t)) (org-table-copy-down 0))
  663. (buffer-string))))
  664. ;; When there is a field just above field being incremented, try to
  665. ;; use it to guess increment step.
  666. (should
  667. (equal "| 4 |\n| 3 |\n| 2 |\n"
  668. (org-test-with-temp-text "| 4 |\n| <point>3 |"
  669. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  670. (buffer-string))))
  671. (should
  672. (equal "| A0 |\n| A2 |\n| A4 |\n"
  673. (org-test-with-temp-text "| A0 |\n| <point>A2 |"
  674. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  675. (buffer-string))))
  676. ;; Both fields need to have the same type. In the special case of
  677. ;; number-prefixed or suffixed fields, make sure both fields have
  678. ;; the same pattern.
  679. (should
  680. (equal "| A4 |\n| 3 |\n| 4 |\n"
  681. (org-test-with-temp-text "| A4 |\n| <point>3 |"
  682. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  683. (buffer-string))))
  684. (should
  685. (equal "| 0A |\n| A2 |\n| A3 |\n"
  686. (org-test-with-temp-text "| 0A |\n| <point>A2 |"
  687. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  688. (buffer-string))))
  689. (should
  690. (equal "| A0 |\n| 2A |\n| 3A |\n"
  691. (org-test-with-temp-text "| A0 |\n| <point>2A |"
  692. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  693. (buffer-string))))
  694. ;; Do not search field above past blank fields and horizontal
  695. ;; separators.
  696. (should
  697. (equal "| 4 |\n|---|\n| 3 |\n| 4 |\n"
  698. (org-test-with-temp-text "| 4 |\n|---|\n| <point>3 |"
  699. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  700. (buffer-string))))
  701. (should
  702. (equal "| 4 |\n| |\n| 3 |\n| 4 |\n"
  703. (org-test-with-temp-text "| 4 |\n| |\n| <point>3 |"
  704. (let ((org-table-copy-increment t)) (org-table-copy-down 1))
  705. (buffer-string))))
  706. ;; When `org-table-copy-increment' is a number, use it as the
  707. ;; increment step, ignoring any previous field.
  708. (should
  709. (equal "| 1 |\n| 3 |\n| 6 |\n"
  710. (org-test-with-temp-text "| 1 |\n| <point>3 |"
  711. (let ((org-table-copy-increment 3)) (org-table-copy-down 1))
  712. (buffer-string))))
  713. ;; However, if argument is 0, do not increment whatsoever.
  714. (should
  715. (equal "| 1 |\n| 3 |\n| 3 |\n"
  716. (org-test-with-temp-text "| 1 |\n| <point>3 |"
  717. (let ((org-table-copy-increment t)) (org-table-copy-down 0))
  718. (buffer-string))))
  719. (should
  720. (equal "| 1 |\n| 3 |\n| 3 |\n"
  721. (org-test-with-temp-text "| 1 |\n| <point>3 |"
  722. (let ((org-table-copy-increment 3)) (org-table-copy-down 0))
  723. (buffer-string)))))
  724. (ert-deftest test-org-table/sub-total ()
  725. "Grouped rows with sub-total.
  726. Begin range with \"@II\" to handle multiline header. Convert
  727. integer to float with \"+.0\" for sub-total of items c1 and c2.
  728. Sum empty fields as value zero but without ignoring them for
  729. \"vlen\" with format specifier \"EN\". Format possibly empty
  730. results with the Calc formatter \"f-1\" instead of the printf
  731. formatter \"%.1f\"."
  732. (org-test-table-target-expect
  733. "
  734. |-------+---------+---------|
  735. | Item | Item | Sub- |
  736. | name | value | total |
  737. |-------+---------+---------|
  738. | a1 | 4.1 | replace |
  739. | a2 | 8.2 | replace |
  740. | a3 | | replace |
  741. |-------+---------+---------|
  742. | b1 | 16.0 | replace |
  743. |-------+---------+---------|
  744. | c1 | 32 | replace |
  745. | c2 | 64 | replace |
  746. |-------+---------+---------|
  747. | Total | replace | replace |
  748. |-------+---------+---------|
  749. "
  750. "
  751. |-------+-------+-------|
  752. | Item | Item | Sub- |
  753. | name | value | total |
  754. |-------+-------+-------|
  755. | a1 | 4.1 | |
  756. | a2 | 8.2 | |
  757. | a3 | | 12.3 |
  758. |-------+-------+-------|
  759. | b1 | 16.0 | 16.0 |
  760. |-------+-------+-------|
  761. | c1 | 32 | |
  762. | c2 | 64 | 96.0 |
  763. |-------+-------+-------|
  764. | Total | 124.3 | |
  765. |-------+-------+-------|
  766. "
  767. 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
  768. "$3 = if(vlen(@0..@+I) == 1, "
  769. "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
  770. "@>$3 = string(\"\")")))
  771. (ert-deftest test-org-table/org-lookup-all ()
  772. "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
  773. See also URL `https://orgmode.org/worg/org-tutorials/org-lookups.html'."
  774. (let ((data "
  775. #+NAME: data
  776. | Purchase | Product | Shop | Rating |
  777. |----------+---------+------+--------|
  778. | a | p1 | s1 | 1 |
  779. | b | p1 | s2 | 4 |
  780. | c | p2 | s1 | 2 |
  781. | d | p3 | s2 | 8 |
  782. "))
  783. ;; Product rating and ranking by average purchase from "#+NAME: data"
  784. (org-test-table-target-expect
  785. (concat data "
  786. | Product | Rating | Ranking |
  787. |---------+---------+---------|
  788. | p1 | replace | replace |
  789. | p2 | replace | replace |
  790. | p3 | replace | replace |
  791. ")
  792. (concat data "
  793. | Product | Rating | Ranking |
  794. |---------+--------+---------|
  795. | p1 | 2.5 | 2 |
  796. | p2 | 2.0 | 3 |
  797. | p3 | 8.0 | 1 |
  798. ")
  799. 2 (concat
  800. "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
  801. "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
  802. "(/ (apply '+ all) (length all) 1.0)); L :: "
  803. "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
  804. ;; Shop rating and ranking by average purchase from "#+NAME: data"
  805. (org-test-table-target-expect
  806. (concat data "
  807. | Shop | Rating | Ranking |
  808. |------+---------+---------|
  809. | s1 | replace | replace |
  810. | s2 | replace | replace |
  811. ")
  812. (concat data "
  813. | Shop | Rating | Ranking |
  814. |------+--------+---------|
  815. | s1 | 1.5 | 2 |
  816. | s2 | 6.0 | 1 |
  817. ")
  818. 2 (concat
  819. "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
  820. "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
  821. "(/ (apply '+ all) (length all) 1.0)); L :: "
  822. "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
  823. (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
  824. ;; For Lisp formula only
  825. (should (equal "0" (org-table-make-reference "0" t nil 'literal)))
  826. (should (equal "z" (org-table-make-reference "z" t nil 'literal)))
  827. (should (equal "" (org-table-make-reference "" t nil 'literal)))
  828. (should (equal "0 1" (org-table-make-reference '("0" "1") t nil 'literal)))
  829. (should (equal "z 1" (org-table-make-reference '("z" "1") t nil 'literal)))
  830. (should (equal " 1" (org-table-make-reference '("" "1") t nil 'literal)))
  831. (should (equal " " (org-table-make-reference '("" "") t nil 'literal))))
  832. (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
  833. ;; For Lisp formula
  834. (should (equal "\"0\"" (org-table-make-reference "0" t nil t)))
  835. (should (equal "\"z\"" (org-table-make-reference "z" t nil t)))
  836. (should (equal"\"\"" (org-table-make-reference "" t nil t)))
  837. (should (equal "\"0\" \"1\"" (org-table-make-reference '("0""1") t nil t)))
  838. (should (equal "\"z\" \"1\"" (org-table-make-reference '("z""1") t nil t)))
  839. (should (equal"\"\" \"1\"" (org-table-make-reference '("""1") t nil t)))
  840. (should (equal"\"\" \"\""(org-table-make-reference '("""" ) t nil t)))
  841. ;; For Calc formula
  842. (should (equal "(0)" (org-table-make-reference "0" t nil nil)))
  843. (should (equal "(z)" (org-table-make-reference "z" t nil nil)))
  844. (should (equal "nan" (org-table-make-reference "" t nil nil)))
  845. (should (equal "[0,1]" (org-table-make-reference '("0" "1") t nil nil)))
  846. (should (equal "[z,1]" (org-table-make-reference '("z" "1") t nil nil)))
  847. (should (equal "[nan,1]" (org-table-make-reference '("" "1") t nil nil)))
  848. (should (equal "[nan,nan]" (org-table-make-reference '("" "") t nil nil)))
  849. ;; For Calc formula, special numbers
  850. (should (equal "(nan)" (org-table-make-reference "nan" t nil nil)))
  851. (should (equal "(uinf)" (org-table-make-reference "uinf" t nil nil)))
  852. (should (equal "(-inf)" (org-table-make-reference "-inf" t nil nil)))
  853. (should (equal "(inf)" (org-table-make-reference "inf" t nil nil)))
  854. (should (equal "[nan,1]" (org-table-make-reference '("nan" "1") t nil nil)))
  855. (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") t nil nil)))
  856. (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") t nil nil)))
  857. (should (equal "[inf,1]" (org-table-make-reference '("inf" "1") t nil nil))))
  858. (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
  859. ;; For Lisp formula
  860. (should (equal "0" (org-table-make-reference "0" t t t)))
  861. (should (equal "0" (org-table-make-reference "z" t t t)))
  862. (should (equal "0" (org-table-make-reference "" t t t)))
  863. (should (equal "0 1" (org-table-make-reference '("0" "1") t t t)))
  864. (should (equal "0 1" (org-table-make-reference '("z" "1") t t t)))
  865. (should (equal "0 1" (org-table-make-reference '("" "1") t t t)))
  866. (should (equal "0 0" (org-table-make-reference '("" "" ) t t t)))
  867. ;; For Calc formula
  868. (should (equal "(0)" (org-table-make-reference "0" t t nil)))
  869. (should (equal "(0)" (org-table-make-reference "z" t t nil)))
  870. (should (equal "(0)" (org-table-make-reference "" t t nil)))
  871. (should (equal "[0,1]" (org-table-make-reference '("0" "1") t t nil)))
  872. (should (equal "[0,1]" (org-table-make-reference '("z" "1") t t nil)))
  873. (should (equal "[0,1]" (org-table-make-reference '("" "1") t t nil)))
  874. (should (equal "[0,0]" (org-table-make-reference '("" "" ) t t nil)))
  875. ;; For Calc formula, special numbers
  876. (should (equal "(0)" (org-table-make-reference "nan" t t nil)))
  877. (should (equal "(0)" (org-table-make-reference "uinf" t t nil)))
  878. (should (equal "(0)" (org-table-make-reference "-inf" t t nil)))
  879. (should (equal "(0)" (org-table-make-reference "inf" t t nil)))
  880. (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") t t nil)))
  881. (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") t t nil)))
  882. (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") t t nil)))
  883. (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") t t nil))))
  884. (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
  885. ;; For Lisp formula only
  886. (should (equal "0" (org-table-make-reference "0" nil nil 'literal)))
  887. (should (equal "z" (org-table-make-reference "z" nil nil 'literal)))
  888. (should (equal "" (org-table-make-reference "" nil nil 'literal)))
  889. (should (equal "0 1" (org-table-make-reference '("0" "1") nil nil 'literal)))
  890. (should (equal "z 1" (org-table-make-reference '("z" "1") nil nil 'literal)))
  891. (should (equal "1" (org-table-make-reference '("" "1") nil nil 'literal)))
  892. (should (equal "" (org-table-make-reference '("" "" ) nil nil 'literal))))
  893. (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
  894. ;; For Lisp formula
  895. (should (equal "\"0\"" (org-table-make-reference "0" nil nil t)))
  896. (should (equal "\"z\"" (org-table-make-reference "z" nil nil t)))
  897. (should (equal "" (org-table-make-reference "" nil nil t)))
  898. (should (equal "\"0\" \"1\"" (org-table-make-reference '("0" "1") nil nil t)))
  899. (should (equal "\"z\" \"1\"" (org-table-make-reference '("z" "1") nil nil t)))
  900. (should (equal "\"1\"" (org-table-make-reference '("" "1") nil nil t)))
  901. (should (equal "" (org-table-make-reference '("" "" ) nil nil t)))
  902. ;; For Calc formula
  903. (should (equal "(0)" (org-table-make-reference "0" nil nil nil)))
  904. (should (equal "(z)" (org-table-make-reference "z" nil nil nil)))
  905. (should (equal "(0)" (org-table-make-reference "" nil nil nil)))
  906. (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil nil nil)))
  907. (should (equal "[z,1]" (org-table-make-reference '("z" "1") nil nil nil)))
  908. (should (equal "[1]" (org-table-make-reference '("" "1") nil nil nil)))
  909. (should (equal "[]" (org-table-make-reference '("" "" ) nil nil nil)))
  910. ;; For Calc formula, special numbers
  911. (should (equal "(nan)" (org-table-make-reference "nan" nil nil nil)))
  912. (should (equal "(uinf)" (org-table-make-reference "uinf" nil nil nil)))
  913. (should (equal "(-inf)" (org-table-make-reference "-inf" nil nil nil)))
  914. (should (equal "(inf)" (org-table-make-reference "inf" nil nil nil)))
  915. (should (equal "[nan,1]" (org-table-make-reference '( "nan" "1") nil nil nil)))
  916. (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") nil nil nil)))
  917. (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") nil nil nil)))
  918. (should (equal "[inf,1]" (org-table-make-reference '( "inf" "1") nil nil nil))))
  919. (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
  920. ;; For Lisp formula
  921. (should (equal "0" (org-table-make-reference "0" nil t t)))
  922. (should (equal "0" (org-table-make-reference "z" nil t t)))
  923. (should (equal "" (org-table-make-reference "" nil t t)))
  924. (should (equal "0 1" (org-table-make-reference '("0" "1") nil t t)))
  925. (should (equal "0 1" (org-table-make-reference '("z" "1") nil t t)))
  926. (should (equal "1" (org-table-make-reference '("" "1") nil t t)))
  927. (should (equal "" (org-table-make-reference '("" "" ) nil t t)))
  928. ;; For Calc formula
  929. (should (equal "(0)" (org-table-make-reference "0" nil t nil)))
  930. (should (equal "(0)" (org-table-make-reference "z" nil t nil)))
  931. (should (equal "(0)" (org-table-make-reference "" nil t nil)))
  932. (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil t nil)))
  933. (should (equal "[0,1]" (org-table-make-reference '("z" "1") nil t nil)))
  934. (should (equal "[1]" (org-table-make-reference '("" "1") nil t nil)))
  935. (should (equal "[]" (org-table-make-reference '("" "" ) nil t nil)))
  936. ;; For Calc formula, special numbers
  937. (should (equal "(0)" (org-table-make-reference "nan" nil t nil)))
  938. (should (equal "(0)" (org-table-make-reference "uinf" nil t nil)))
  939. (should (equal "(0)" (org-table-make-reference "-inf" nil t nil)))
  940. (should (equal "(0)" (org-table-make-reference "inf" nil t nil)))
  941. (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") nil t nil)))
  942. (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") nil t nil)))
  943. (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") nil t nil)))
  944. (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") nil t nil))))
  945. (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
  946. "Simple reference @2$1."
  947. (should
  948. (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
  949. ;; TODO: Test broken
  950. ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
  951. ;; "Self reference @1$1."
  952. ;; (should
  953. ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
  954. (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
  955. "Remote reference."
  956. (should
  957. (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
  958. (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
  959. "Simple reference @2$1."
  960. (should
  961. (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
  962. (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
  963. "Self reference $0."
  964. (should
  965. (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
  966. ;; TODO: Test Broken
  967. ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
  968. ;; "Remote reference."
  969. ;; (should
  970. ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
  971. (ert-deftest test-org-table/remote-reference-access ()
  972. "Access to remote reference.
  973. See also `test-org-table/copy-field'."
  974. (org-test-table-target-expect
  975. "
  976. #+NAME: table
  977. | | x 42 | |
  978. | replace | replace |
  979. "
  980. "
  981. #+NAME: table
  982. | | x 42 | |
  983. | x 42 | 84 x |
  984. "
  985. 1 (concat "#+TBLFM: "
  986. ;; Copy text without calculation: Use Lisp formula
  987. "$1 = '(identity remote(table, @1$2)) :: "
  988. ;; Do a calculation: Use Calc (or Lisp ) formula
  989. "$2 = 2 * remote(table, @1$2)")))
  990. (ert-deftest test-org-table/remote-reference-indirect ()
  991. "Access to remote reference with indirection of name or ID."
  992. (let ((source-tables "
  993. #+NAME: 2012
  994. | amount |
  995. |--------|
  996. | 1 |
  997. | 2 |
  998. |--------|
  999. | 3 |
  1000. #+TBLFM: @>$1 = vsum(@I..@II)
  1001. #+NAME: 2013
  1002. | amount |
  1003. |--------|
  1004. | 4 |
  1005. | 8 |
  1006. |--------|
  1007. | 12 |
  1008. #+TBLFM: @>$1 = vsum(@I..@II)
  1009. "))
  1010. ;; Read several remote references from same column
  1011. (org-test-table-target-expect
  1012. (concat source-tables "
  1013. #+NAME: summary
  1014. | year | amount |
  1015. |-------+---------|
  1016. | 2012 | replace |
  1017. | 2013 | replace |
  1018. |-------+---------|
  1019. | total | replace |
  1020. ")
  1021. (concat source-tables "
  1022. #+NAME: summary
  1023. | year | amount |
  1024. |-------+--------|
  1025. | 2012 | 3 |
  1026. | 2013 | 12 |
  1027. |-------+--------|
  1028. | total | 15 |
  1029. ")
  1030. 1
  1031. ;; Calc formula
  1032. "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
  1033. ;; Lisp formula
  1034. (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
  1035. "@>$2 = '(+ @I..@II); N"))
  1036. ;; Read several remote references from same row
  1037. (org-test-table-target-expect
  1038. (concat source-tables "
  1039. #+NAME: summary
  1040. | year | 2012 | 2013 | total |
  1041. |--------+---------+---------+---------|
  1042. | amount | replace | replace | replace |
  1043. ")
  1044. (concat source-tables "
  1045. #+NAME: summary
  1046. | year | 2012 | 2013 | total |
  1047. |--------+------+------+-------|
  1048. | amount | 3 | 12 | 15 |
  1049. ")
  1050. 1
  1051. ;; Calc formula
  1052. "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
  1053. ;; Lisp formula
  1054. (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
  1055. "@2$> = '(+ $<<..$>>); N"))))
  1056. (ert-deftest test-org-table/org-at-TBLFM-p ()
  1057. (org-test-with-temp-text-in-file
  1058. "
  1059. | 1 |
  1060. | 2 |
  1061. #+TBLFM: $2=$1*2
  1062. "
  1063. (goto-char (point-min))
  1064. (forward-line 2)
  1065. (should (equal (org-at-TBLFM-p) nil))
  1066. (goto-char (point-min))
  1067. (forward-line 3)
  1068. (should (equal (org-at-TBLFM-p) t))
  1069. (goto-char (point-min))
  1070. (forward-line 4)
  1071. (should (equal (org-at-TBLFM-p) nil))))
  1072. (ert-deftest test-org-table/org-table-TBLFM-begin ()
  1073. (org-test-with-temp-text-in-file
  1074. "
  1075. | 1 |
  1076. | 2 |
  1077. #+TBLFM: $2=$1*2
  1078. "
  1079. (goto-char (point-min))
  1080. (should (equal (org-table-TBLFM-begin)
  1081. nil))
  1082. (goto-char (point-min))
  1083. (forward-line 1)
  1084. (should (equal (org-table-TBLFM-begin)
  1085. nil))
  1086. (goto-char (point-min))
  1087. (forward-line 3)
  1088. (should (= (org-table-TBLFM-begin)
  1089. 14))
  1090. (goto-char (point-min))
  1091. (forward-line 4)
  1092. (should (= (org-table-TBLFM-begin)
  1093. 14))
  1094. ))
  1095. (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
  1096. "For multiple #+TBLFM lines."
  1097. (org-test-with-temp-text-in-file
  1098. "
  1099. | 1 |
  1100. | 2 |
  1101. #+TBLFM: $2=$1*1
  1102. #+TBLFM: $2=$1*2
  1103. "
  1104. (goto-char (point-min))
  1105. (should (equal (org-table-TBLFM-begin)
  1106. nil))
  1107. (goto-char (point-min))
  1108. (forward-line 1)
  1109. (should (equal (org-table-TBLFM-begin)
  1110. nil))
  1111. (goto-char (point-min))
  1112. (forward-line 3)
  1113. (should (= (org-table-TBLFM-begin)
  1114. 14))
  1115. (goto-char (point-min))
  1116. (forward-line 4)
  1117. (should (= (org-table-TBLFM-begin)
  1118. 14))
  1119. (goto-char (point-min))
  1120. (forward-line 5)
  1121. (should (= (org-table-TBLFM-begin)
  1122. 14))
  1123. ))
  1124. (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
  1125. (org-test-with-temp-text-in-file
  1126. "
  1127. | 1 |
  1128. | 2 |
  1129. #+TBLFM: $2=$1*1
  1130. #+TBLFM: $2=$1*2
  1131. | 6 |
  1132. | 7 |
  1133. #+TBLFM: $2=$1*1
  1134. #+TBLFM: $2=$1*2
  1135. "
  1136. (goto-char (point-min))
  1137. (should (equal (org-table-TBLFM-begin)
  1138. nil))
  1139. (goto-char (point-min))
  1140. (forward-line 1)
  1141. (should (equal (org-table-TBLFM-begin)
  1142. nil))
  1143. (goto-char (point-min))
  1144. (forward-line 3)
  1145. (should (= (org-table-TBLFM-begin)
  1146. 14))
  1147. (goto-char (point-min))
  1148. (forward-line 4)
  1149. (should (= (org-table-TBLFM-begin)
  1150. 14))
  1151. (goto-char (point-min))
  1152. (forward-line 5)
  1153. (should (= (org-table-TBLFM-begin)
  1154. 14))
  1155. (goto-char (point-min))
  1156. (forward-line 6)
  1157. (should (= (org-table-TBLFM-begin)
  1158. 14))
  1159. (goto-char (point-min))
  1160. (forward-line 8)
  1161. (should (= (org-table-TBLFM-begin)
  1162. 61))
  1163. (goto-char (point-min))
  1164. (forward-line 9)
  1165. (should (= (org-table-TBLFM-begin)
  1166. 61))
  1167. (goto-char (point-min))
  1168. (forward-line 10)
  1169. (should (= (org-table-TBLFM-begin)
  1170. 61))))
  1171. (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
  1172. (org-test-with-temp-text-in-file
  1173. "
  1174. | 1 | |
  1175. | 2 | |
  1176. #+TBLFM: $2=$1*1
  1177. #+TBLFM: $2=$1*2
  1178. #+TBLFM: $2=$1*3
  1179. "
  1180. (let ((got (progn (goto-char (point-min))
  1181. (forward-line 3)
  1182. (org-table-calc-current-TBLFM)
  1183. (buffer-string)))
  1184. (expect "
  1185. | 1 | 1 |
  1186. | 2 | 2 |
  1187. #+TBLFM: $2=$1*1
  1188. #+TBLFM: $2=$1*2
  1189. #+TBLFM: $2=$1*3
  1190. "))
  1191. (should (string= got
  1192. expect)))
  1193. (let ((got (progn (goto-char (point-min))
  1194. (forward-line 4)
  1195. (org-table-calc-current-TBLFM)
  1196. (buffer-string)))
  1197. (expect "
  1198. | 1 | 2 |
  1199. | 2 | 4 |
  1200. #+TBLFM: $2=$1*1
  1201. #+TBLFM: $2=$1*2
  1202. #+TBLFM: $2=$1*3
  1203. "))
  1204. (should (string= got
  1205. expect)))))
  1206. (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
  1207. "org-table-calc-current-TBLFM should preserve the input as it was."
  1208. (org-test-with-temp-text-in-file
  1209. "
  1210. | 1 | 1 |
  1211. | 2 | 2 |
  1212. #+TBLFM: $2=$1*1
  1213. #+TBLFM: $2=$1*2::$2=$1*2
  1214. #+TBLFM: $2=$1*3
  1215. "
  1216. (let ((expect "
  1217. | 1 | 1 |
  1218. | 2 | 2 |
  1219. #+TBLFM: $2=$1*1
  1220. #+TBLFM: $2=$1*2::$2=$1*2
  1221. #+TBLFM: $2=$1*3
  1222. "))
  1223. (goto-char (point-min))
  1224. (forward-line 4)
  1225. (should-error (org-table-calc-current-TBLFM))
  1226. (setq got (buffer-string))
  1227. (message "%s" got)
  1228. (should (string= got
  1229. expect)))))
  1230. ;;; Tables as Lisp
  1231. (ert-deftest test-org-table/to-lisp ()
  1232. "Test `orgtbl-to-lisp' specifications."
  1233. ;; 2x2 no header
  1234. (should
  1235. (equal '(("a" "b") ("c" "d"))
  1236. (org-table-to-lisp "|a|b|\n|c|d|")))
  1237. ;; 2x2 with 1-line header
  1238. (should
  1239. (equal '(("a" "b") hline ("c" "d"))
  1240. (org-table-to-lisp "|a|b|\n|-\n|c|d|")))
  1241. ;; 2x4 with 2-line header
  1242. (should
  1243. (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
  1244. (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))
  1245. ;; leading hlines do not get stripped
  1246. (should
  1247. (equal '(hline ("a" "b") hline ("c" "d"))
  1248. (org-table-to-lisp "|-\n|a|b|\n|-\n|c|d|")))
  1249. (should
  1250. (equal '(hline ("a" "b") ("c" "d"))
  1251. (org-table-to-lisp "|-\n|a|b|\n|c|d|")))
  1252. (should
  1253. (equal '(hline hline hline hline ("a" "b") ("c" "d"))
  1254. (org-table-to-lisp "|-\n|-\n|-\n|-\n|a|b|\n|c|d|"))))
  1255. (ert-deftest test-org-table/collapse-header ()
  1256. "Test `orgtbl-to-lisp' specifications."
  1257. ;; 2x2 no header - no collapsing
  1258. (should
  1259. (equal '(("a" "b") ("c" "d"))
  1260. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|c|d|"))))
  1261. ;; 2x2 with 1-line header - no collapsing
  1262. (should
  1263. (equal '(("a" "b") hline ("c" "d"))
  1264. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|-\n|c|d|"))))
  1265. ;; 2x4 with 2-line header - collapsed
  1266. (should
  1267. (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
  1268. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|"))))
  1269. ;; 2x4 with 2-line header, custom glue - collapsed
  1270. (should
  1271. (equal '(("a.A" "b.B") hline ("c" "d") ("aa" "bb"))
  1272. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") ".")))
  1273. ;; 2x4 with 2-line header, threshold 1 - not collapsed
  1274. (should
  1275. (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
  1276. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 1)))
  1277. ;; 2x4 with 2-line header, threshold 2 - collapsed
  1278. (should
  1279. (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
  1280. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 2)))
  1281. ;; 2x8 with 6-line header, default threshold 5 - not collapsed
  1282. (should
  1283. (equal '(("a" "b") ("A" "B") ("a" "b") ("A" "B") ("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
  1284. (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|a|b|\n|A|B|\n|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))))
  1285. ;;; Radio Tables
  1286. (ert-deftest test-org-table/to-generic ()
  1287. "Test `orgtbl-to-generic' specifications."
  1288. ;; Test :hline parameter.
  1289. (should
  1290. (equal "a\nb"
  1291. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1292. '(:hline nil))))
  1293. (should
  1294. (equal "a\n~\nb"
  1295. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1296. '(:hline "~"))))
  1297. ;; Test :sep parameter.
  1298. (should
  1299. (equal "a!b\nc!d"
  1300. (orgtbl-to-generic
  1301. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1302. '(:sep "!"))))
  1303. ;; Test :hsep parameter.
  1304. (should
  1305. (equal "a!b\nc?d"
  1306. (orgtbl-to-generic
  1307. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1308. '(:sep "?" :hsep "!"))))
  1309. ;; Test :tstart parameter.
  1310. (should
  1311. (equal "<begin>\na"
  1312. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
  1313. (should
  1314. (equal "<begin>\na"
  1315. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1316. '(:tstart (lambda () "<begin>")))))
  1317. (should
  1318. (equal "a"
  1319. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1320. '(:tstart "<begin>" :splice t))))
  1321. ;; Test :tend parameter.
  1322. (should
  1323. (equal "a\n<end>"
  1324. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
  1325. (should
  1326. (equal "a\n<end>"
  1327. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1328. '(:tend (lambda () "<end>")))))
  1329. (should
  1330. (equal "a"
  1331. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1332. '(:tend "<end>" :splice t))))
  1333. ;; Test :lstart parameter.
  1334. (should
  1335. (equal "> a"
  1336. (orgtbl-to-generic
  1337. (org-table-to-lisp "| a |") '(:lstart "> "))))
  1338. (should
  1339. (equal "> a"
  1340. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1341. '(:lstart (lambda () "> ")))))
  1342. ;; Test :llstart parameter.
  1343. (should
  1344. (equal "> a\n>> b"
  1345. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1346. '(:lstart "> " :llstart ">> "))))
  1347. ;; Test :hlstart parameter.
  1348. (should
  1349. (equal "!> a\n> b"
  1350. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1351. '(:lstart "> " :hlstart "!> "))))
  1352. ;; Test :hllstart parameter.
  1353. (should
  1354. (equal "!> a\n!!> b\n> c"
  1355. (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
  1356. '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
  1357. ;; Test :lend parameter.
  1358. (should
  1359. (equal "a <"
  1360. (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
  1361. ;; Test :llend parameter.
  1362. (should
  1363. (equal "a <\nb <<"
  1364. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1365. '(:lend " <" :llend " <<"))))
  1366. ;; Test :hlend parameter.
  1367. (should
  1368. (equal "a <!\nb <"
  1369. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1370. '(:lend " <" :hlend " <!"))))
  1371. ;; Test :hllend parameter.
  1372. (should
  1373. (equal "a <!\nb <!!\nc <"
  1374. (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
  1375. '(:lend " <" :hlend " <!" :hllend " <!!"))))
  1376. ;; Test :lfmt parameter.
  1377. (should
  1378. (equal "a!b"
  1379. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1380. '(:lfmt "%s!%s"))))
  1381. (should
  1382. (equal "a+b"
  1383. (orgtbl-to-generic
  1384. (org-table-to-lisp "| a | b |")
  1385. '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1386. (should
  1387. (equal "a!b"
  1388. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1389. '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1390. ;; Test :llfmt parameter.
  1391. (should
  1392. (equal "a!b"
  1393. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1394. '(:llfmt "%s!%s"))))
  1395. (should
  1396. (equal "a!b\nc+d"
  1397. (orgtbl-to-generic
  1398. (org-table-to-lisp "| a | b |\n| c | d |")
  1399. '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1400. (should
  1401. (equal "a!b"
  1402. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1403. '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1404. ;; Test :hlfmt parameter.
  1405. (should
  1406. (equal "a!b\ncd"
  1407. (orgtbl-to-generic
  1408. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1409. '(:hlfmt "%s!%s"))))
  1410. (should
  1411. (equal "a+b\ncd"
  1412. (orgtbl-to-generic
  1413. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1414. '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1415. (should
  1416. (equal "a!b\n>c d<"
  1417. (orgtbl-to-generic
  1418. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1419. '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1420. ;; Test :hllfmt parameter.
  1421. (should
  1422. (equal "a!b\ncd"
  1423. (orgtbl-to-generic
  1424. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1425. '(:hllfmt "%s!%s"))))
  1426. (should
  1427. (equal "a+b\ncd"
  1428. (orgtbl-to-generic
  1429. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1430. '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
  1431. (should
  1432. (equal "a!b\n>c d<"
  1433. (orgtbl-to-generic
  1434. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1435. '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
  1436. ;; Test :fmt parameter.
  1437. (should
  1438. (equal ">a<\n>b<"
  1439. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1440. '(:fmt ">%s<"))))
  1441. (should
  1442. (equal ">a<b"
  1443. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1444. '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
  1445. (should
  1446. (equal "a b"
  1447. (orgtbl-to-generic (org-table-to-lisp "| a | b |")
  1448. '(:fmt (2 " %s")))))
  1449. (should
  1450. (equal ">a<"
  1451. (orgtbl-to-generic (org-table-to-lisp "| a |")
  1452. '(:fmt (lambda (c) (format ">%s<" c))))))
  1453. ;; Test :hfmt parameter.
  1454. (should
  1455. (equal ">a<\nb"
  1456. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1457. '(:hfmt ">%s<"))))
  1458. (should
  1459. (equal ">a<b\ncd"
  1460. (orgtbl-to-generic
  1461. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1462. '(:hfmt (1 ">%s<" 2 identity)))))
  1463. (should
  1464. (equal "a b\ncd"
  1465. (orgtbl-to-generic
  1466. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
  1467. '(:hfmt (2 " %s")))))
  1468. (should
  1469. (equal ">a<\nb"
  1470. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1471. '(:hfmt (lambda (c) (format ">%s<" c))))))
  1472. ;; Test :efmt parameter.
  1473. (should
  1474. (equal "2x10^3"
  1475. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1476. '(:efmt "%sx10^%s"))))
  1477. (should
  1478. (equal "2x10^3"
  1479. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1480. '(:efmt (lambda (m e) (concat m "x10^" e))))))
  1481. (should
  1482. (equal "2x10^3"
  1483. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
  1484. '(:efmt (1 "%sx10^%s")))))
  1485. (should
  1486. (equal "2x10^3"
  1487. (orgtbl-to-generic
  1488. (org-table-to-lisp "| 2e3 |")
  1489. '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
  1490. (should
  1491. (equal "2e3"
  1492. (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
  1493. ;; Test :skip parameter.
  1494. (should
  1495. (equal "cd"
  1496. (orgtbl-to-generic
  1497. (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
  1498. '(:skip 2))))
  1499. ;; Test :skipcols parameter.
  1500. (should
  1501. (equal "a\nc"
  1502. (orgtbl-to-generic
  1503. (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
  1504. (should
  1505. (equal "a\nc"
  1506. (orgtbl-to-generic
  1507. (org-table-to-lisp
  1508. "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
  1509. '(:skipcols (2)))))
  1510. ;; Test :raw parameter.
  1511. (when (featurep 'ox-latex)
  1512. (should
  1513. (string-match-p
  1514. "/a/"
  1515. (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
  1516. '(:backend latex :raw t)))))
  1517. ;; Hooks are ignored.
  1518. (should
  1519. (equal
  1520. "a\nb"
  1521. (let* ((fun-list (list (lambda (_backend) (search-forward "a") (insert "hook"))))
  1522. (org-export-before-parsing-hook fun-list)
  1523. (org-export-before-processing-hook fun-list))
  1524. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1525. '(:hline nil)))))
  1526. ;; User-defined export filters are ignored.
  1527. (should
  1528. (equal
  1529. "a\nb"
  1530. (let ((org-export-filter-table-cell-functions
  1531. (list (lambda (_c _b _i) "filter"))))
  1532. (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
  1533. '(:hline nil)))))
  1534. ;; Macros, even if unknown, are returned as-is.
  1535. (should
  1536. (equal "{{{macro}}}"
  1537. (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
  1538. (ert-deftest test-org-table/to-latex ()
  1539. "Test `orgtbl-to-latex' specifications."
  1540. (should
  1541. (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
  1542. (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
  1543. ;; Test :environment parameter.
  1544. (should
  1545. (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
  1546. (orgtbl-to-latex (org-table-to-lisp "| a |")
  1547. '(:environment "tabularx"))))
  1548. ;; Test :booktabs parameter.
  1549. (should
  1550. (string-match-p
  1551. "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
  1552. ;; Handle LaTeX snippets.
  1553. (should
  1554. (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
  1555. (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
  1556. ;; Test pseudo objects and :raw parameter.
  1557. (should
  1558. (string-match-p
  1559. "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
  1560. (ert-deftest test-org-table/to-html ()
  1561. "Test `orgtbl-to-html' specifications."
  1562. (should
  1563. (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
  1564. "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
  1565. <colgroup>
  1566. <col class=\"org-left\" />
  1567. </colgroup>
  1568. <tbody>
  1569. <tr>
  1570. <td class=\"org-left\">a</td>
  1571. </tr>
  1572. </tbody>
  1573. </table>"))
  1574. ;; Test :attributes parameter.
  1575. (should
  1576. (string-match-p
  1577. "<table>"
  1578. (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
  1579. (should
  1580. (string-match-p
  1581. "<table border=\"2\">"
  1582. (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
  1583. (ert-deftest test-org-table/to-texinfo ()
  1584. "Test `orgtbl-to-texinfo' specifications."
  1585. (should
  1586. (equal "@multitable {a}\n@item a\n@end multitable"
  1587. (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
  1588. ;; Test :columns parameter.
  1589. (should
  1590. (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
  1591. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1592. '(:columns ".4 .6"))))
  1593. (should
  1594. (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
  1595. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1596. '(:columns "@columnfractions .4 .6"))))
  1597. (should
  1598. (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
  1599. (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
  1600. '(:columns "{xxx} {xx}")))))
  1601. (ert-deftest test-org-table/to-orgtbl ()
  1602. "Test `orgtbl-to-orgtbl' specifications."
  1603. (should
  1604. (equal "| a | b |\n|---+---|\n| c | d |"
  1605. (orgtbl-to-orgtbl
  1606. (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
  1607. (ert-deftest test-org-table/to-unicode ()
  1608. "Test `orgtbl-to-unicode' specifications."
  1609. (should
  1610. (equal "━━━\n a \n━━━"
  1611. (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
  1612. ;; Test :narrow parameter.
  1613. (should
  1614. (equal "━━━━\n => \n━━━━"
  1615. (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
  1616. '(:narrow t)))))
  1617. (ert-deftest test-org-table/send-region ()
  1618. "Test `orgtbl-send-table' specifications."
  1619. ;; Error when not at a table.
  1620. (should-error
  1621. (org-test-with-temp-text "Paragraph"
  1622. (orgtbl-send-table)))
  1623. ;; Error when destination is missing.
  1624. (should-error
  1625. (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
  1626. (orgtbl-send-table)))
  1627. ;; Error when transformation function is not specified.
  1628. (should-error
  1629. (org-test-with-temp-text "
  1630. # BEGIN RECEIVE ORGTBL table
  1631. # END RECEIVE ORGTBL table
  1632. #+ORGTBL: SEND table
  1633. <point>| a |"
  1634. (orgtbl-send-table)))
  1635. ;; Standard test.
  1636. (should
  1637. (equal "| a |\n|---|\n| b |\n"
  1638. (org-test-with-temp-text "
  1639. # BEGIN RECEIVE ORGTBL table
  1640. # END RECEIVE ORGTBL table
  1641. #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
  1642. <point>| a |\n|---|\n| b |"
  1643. (orgtbl-send-table)
  1644. (goto-char (point-min))
  1645. (buffer-substring-no-properties
  1646. (search-forward "# BEGIN RECEIVE ORGTBL table\n")
  1647. (progn (search-forward "# END RECEIVE ORGTBL table")
  1648. (match-beginning 0))))))
  1649. ;; Allow multiple receiver locations.
  1650. (should
  1651. (org-test-with-temp-text "
  1652. # BEGIN RECEIVE ORGTBL table
  1653. # END RECEIVE ORGTBL table
  1654. #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
  1655. <point>| a |
  1656. # BEGIN RECEIVE ORGTBL table
  1657. # END RECEIVE ORGTBL table"
  1658. (orgtbl-send-table)
  1659. (goto-char (point-min))
  1660. (search-forward "| a |" nil t 3))))
  1661. ;;; Align
  1662. (ert-deftest test-org-table/align ()
  1663. "Test `org-table-align' specifications."
  1664. ;; Regular test.
  1665. (should
  1666. (equal "| a |\n"
  1667. (org-test-with-temp-text "| a |"
  1668. (org-table-align)
  1669. (buffer-string))))
  1670. ;; Preserve alignment.
  1671. (should
  1672. (equal " | a |\n"
  1673. (org-test-with-temp-text " | a |"
  1674. (org-table-align)
  1675. (buffer-string))))
  1676. ;; Handle horizontal lines.
  1677. (should
  1678. (equal "| 123 |\n|-----|\n"
  1679. (org-test-with-temp-text "| 123 |\n|-|"
  1680. (org-table-align)
  1681. (buffer-string))))
  1682. (should
  1683. (equal "| a | b |\n|---+---|\n"
  1684. (org-test-with-temp-text "| a | b |\n|-+-|"
  1685. (org-table-align)
  1686. (buffer-string))))
  1687. ;; Handle empty fields.
  1688. (should
  1689. (equal "| a | bc |\n| bcd | |\n"
  1690. (org-test-with-temp-text "| a | bc |\n| bcd | |"
  1691. (org-table-align)
  1692. (buffer-string))))
  1693. (should
  1694. (equal "| abc | bc |\n| | bcd |\n"
  1695. (org-test-with-temp-text "| abc | bc |\n| | bcd |"
  1696. (org-table-align)
  1697. (buffer-string))))
  1698. ;; Handle missing fields.
  1699. (should
  1700. (equal "| a | b |\n| c | |\n"
  1701. (org-test-with-temp-text "| a | b |\n| c |"
  1702. (org-table-align)
  1703. (buffer-string))))
  1704. (should
  1705. (equal "| a | b |\n|---+---|\n"
  1706. (org-test-with-temp-text "| a | b |\n|---|"
  1707. (org-table-align)
  1708. (buffer-string))))
  1709. ;; Alignment is done to the right when the ratio of numbers in the
  1710. ;; column is superior to `org-table-number-fraction'.
  1711. (should
  1712. (equal "| 1 |\n| 12 |\n| abc |"
  1713. (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
  1714. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1715. (buffer-string))))
  1716. (should
  1717. (equal "| 1 |\n| ab |\n| abc |"
  1718. (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
  1719. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1720. (buffer-string))))
  1721. ;; Obey to alignment cookies.
  1722. (should
  1723. (equal "| <r> |\n| ab |\n| abc |"
  1724. (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
  1725. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1726. (buffer-string))))
  1727. (should
  1728. (equal "| <l> |\n| 12 |\n| 123 |"
  1729. (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
  1730. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1731. (buffer-string))))
  1732. (should
  1733. (equal "| <c> |\n| 1 |\n| 123 |"
  1734. (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
  1735. (let ((org-table-number-fraction 0.5)) (org-table-align))
  1736. (buffer-string))))
  1737. ;; Handle gracefully tables with only horizontal rules.
  1738. (should
  1739. (org-test-with-temp-text "|-<point>--|"
  1740. (org-table-align)
  1741. t))
  1742. (should
  1743. (org-test-with-temp-text "|-<point>--|---------|\n|---|---|-----|"
  1744. (org-table-align)
  1745. t)))
  1746. (ert-deftest test-org-table/align-buffer-tables ()
  1747. "Align all tables when updating buffer."
  1748. (let ((before "
  1749. | a b |
  1750. | c d |
  1751. ")
  1752. (after "
  1753. | a b |
  1754. | c d |
  1755. "))
  1756. (should (equal (org-test-with-temp-text before
  1757. (org-table-recalculate-buffer-tables)
  1758. (buffer-string))
  1759. after))
  1760. (should (equal (org-test-with-temp-text before
  1761. (org-table-iterate-buffer-tables)
  1762. (buffer-string))
  1763. after))))
  1764. ;;; Sorting
  1765. (ert-deftest test-org-table/sort-lines ()
  1766. "Test `org-table-sort-lines' specifications."
  1767. ;; Sort numerically.
  1768. (should
  1769. (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
  1770. (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
  1771. (org-table-sort-lines nil ?n)
  1772. (buffer-string))))
  1773. (should
  1774. (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
  1775. (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
  1776. (org-table-sort-lines nil ?N)
  1777. (buffer-string))))
  1778. ;; Sort alphabetically. Enforce the C locale for consistent results.
  1779. (let ((original-string-collate-lessp (symbol-function 'string-collate-lessp)))
  1780. (cl-letf (((symbol-function 'string-collate-lessp)
  1781. (lambda (s1 s2 &optional _locale ignore-case)
  1782. (funcall original-string-collate-lessp
  1783. s1 s2 "C" ignore-case))))
  1784. (should
  1785. (equal "| a | x |\n| B | 4 |\n| c | 3 |\n"
  1786. (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
  1787. (org-table-sort-lines nil ?a)
  1788. (buffer-string))))
  1789. (should
  1790. (equal "| c | 3 |\n| B | 4 |\n| a | x |\n"
  1791. (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
  1792. (org-table-sort-lines nil ?A)
  1793. (buffer-string))))
  1794. ;; Sort alphabetically with case.
  1795. (should
  1796. (equal "| C |\n| a |\n| b |\n"
  1797. (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
  1798. (org-table-sort-lines t ?a)
  1799. (buffer-string))))
  1800. (should
  1801. (equal "| C |\n| b |\n| a |\n"
  1802. (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
  1803. (org-table-sort-lines nil ?A)
  1804. (buffer-string))))))
  1805. ;; Sort by time (timestamps)
  1806. (should
  1807. (equal
  1808. "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
  1809. (org-test-with-temp-text
  1810. "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
  1811. (org-table-sort-lines nil ?t)
  1812. (buffer-string))))
  1813. (should
  1814. (equal
  1815. "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
  1816. (org-test-with-temp-text
  1817. "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
  1818. (org-table-sort-lines nil ?T)
  1819. (buffer-string))))
  1820. ;; Sort by time (HH:MM values)
  1821. (should
  1822. (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
  1823. (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1824. (org-table-sort-lines nil ?t)
  1825. (buffer-string))))
  1826. (should
  1827. (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1828. (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
  1829. (org-table-sort-lines nil ?T)
  1830. (buffer-string))))
  1831. ;; Sort by time (durations)
  1832. (should
  1833. (equal "| 1d 3:00 |\n| 28:00 |\n"
  1834. (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
  1835. (org-table-sort-lines nil ?t)
  1836. (buffer-string))))
  1837. ;; Sort with custom functions.
  1838. (should
  1839. (equal "| 22 |\n| 15 |\n| 18 |\n"
  1840. (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
  1841. (org-table-sort-lines nil ?f
  1842. (lambda (s) (% (string-to-number s) 10))
  1843. #'<)
  1844. (buffer-string))))
  1845. (should
  1846. (equal "| 18 |\n| 15 |\n| 22 |\n"
  1847. (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
  1848. (org-table-sort-lines nil ?F
  1849. (lambda (s) (% (string-to-number s) 10))
  1850. #'<)
  1851. (buffer-string))))
  1852. ;; Sort according to current column.
  1853. (should
  1854. (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
  1855. (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
  1856. (org-table-sort-lines nil ?n)
  1857. (buffer-string))))
  1858. ;; Sort between horizontal separators if possible.
  1859. (should
  1860. (equal
  1861. "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
  1862. (org-test-with-temp-text
  1863. "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
  1864. (org-table-sort-lines nil ?n)
  1865. (buffer-string)))))
  1866. ;;; Formulas
  1867. (ert-deftest test-org-table/eval-formula ()
  1868. "Test `org-table-eval-formula' specifications."
  1869. ;; Error when not on a table field.
  1870. (should-error
  1871. (org-test-with-temp-text "Text"
  1872. (org-table-eval-formula)))
  1873. (should-error
  1874. (org-test-with-temp-text "| a |\n|---|<point>"
  1875. (org-table-eval-formula)))
  1876. (should-error
  1877. (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
  1878. (org-table-eval-formula)))
  1879. ;; Handle @<, @>, $< and $>.
  1880. (should
  1881. (equal "| 1 |\n| 1 |"
  1882. (org-test-with-temp-text "| <point> |\n| 1 |"
  1883. (org-table-eval-formula nil "@>" nil nil t)
  1884. (buffer-string))))
  1885. (should
  1886. (equal "| 1 |\n| 1 |"
  1887. (org-test-with-temp-text "| 1 |\n| <point> |"
  1888. (org-table-eval-formula nil "@<" nil nil t)
  1889. (buffer-string))))
  1890. (should
  1891. (equal "| 1 | 1 |"
  1892. (org-test-with-temp-text "| <point> | 1 |"
  1893. (org-table-eval-formula nil "$>" nil nil t)
  1894. (buffer-string))))
  1895. (should
  1896. (equal "| 1 | 1 |"
  1897. (org-test-with-temp-text "| 1 | <point> |"
  1898. (org-table-eval-formula nil "$<" nil nil t)
  1899. (buffer-string)))))
  1900. (ert-deftest test-org-table/field-formula-outside-table ()
  1901. "Test `org-table-formula-create-columns' variable."
  1902. ;; Refuse to create column if variable is nil.
  1903. (should-error
  1904. (org-test-with-temp-text "
  1905. | 2 |
  1906. | 4 |
  1907. | 8 |
  1908. <point>#+TBLFM: @1$2=5"
  1909. (let ((org-table-formula-create-columns nil))
  1910. (org-table-calc-current-TBLFM))
  1911. (buffer-string))
  1912. :type (list 'error 'user-error))
  1913. ;; If the variable is non-nil, field formulas and columns formulas
  1914. ;; can create tables.
  1915. (should
  1916. (equal
  1917. "
  1918. | 2 | 5 |
  1919. | 4 | |
  1920. | 8 | |
  1921. #+TBLFM: @1$2=5"
  1922. (org-test-with-temp-text "
  1923. | 2 |
  1924. | 4 |
  1925. | 8 |
  1926. <point>#+TBLFM: @1$2=5"
  1927. (let ((org-table-formula-create-columns t))
  1928. (org-table-calc-current-TBLFM))
  1929. (buffer-string))))
  1930. (should
  1931. (equal
  1932. "
  1933. | 2 | | 15 |
  1934. | 4 | | 15 |
  1935. | 8 | | 15 |
  1936. #+TBLFM: $3=15"
  1937. (org-test-with-temp-text "
  1938. | 2 |
  1939. | 4 |
  1940. | 8 |
  1941. <point>#+TBLFM: $3=15"
  1942. (let ((org-table-formula-create-columns t))
  1943. (org-table-calc-current-TBLFM))
  1944. (buffer-string)))))
  1945. (ert-deftest test-org-table/duration ()
  1946. "Test durations in table formulas."
  1947. ;; Durations in cells.
  1948. (should
  1949. (string-match "| 2:12 | 1:47 | 03:59:00 |"
  1950. (org-test-with-temp-text "
  1951. | 2:12 | 1:47 | |
  1952. <point>#+TBLFM: @1$3=$1+$2;T"
  1953. (org-table-calc-current-TBLFM)
  1954. (buffer-string))))
  1955. (should
  1956. (string-match "| 2:12 | 1:47 | 03:59 |"
  1957. (org-test-with-temp-text "
  1958. | 2:12 | 1:47 | |
  1959. <point>#+TBLFM: @1$3=$1+$2;U"
  1960. (org-table-calc-current-TBLFM)
  1961. (buffer-string))))
  1962. (should
  1963. (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
  1964. (org-test-with-temp-text "
  1965. | 3:02:20 | -2:07:00 | |
  1966. <point>#+TBLFM: @1$3=$1+$2;t"
  1967. (org-table-calc-current-TBLFM)
  1968. (buffer-string))))
  1969. ;; Durations set through properties.
  1970. (should
  1971. (string-match "| 16:00:00 |"
  1972. (org-test-with-temp-text "* H
  1973. :PROPERTIES:
  1974. :time_constant: 08:00:00
  1975. :END:
  1976. | |
  1977. <point>#+TBLFM: $1=2*$PROP_time_constant;T"
  1978. (org-table-calc-current-TBLFM)
  1979. (buffer-string))))
  1980. (should
  1981. (string-match "| 16.00 |"
  1982. (org-test-with-temp-text "* H
  1983. :PROPERTIES:
  1984. :time_constant: 08:00:00
  1985. :END:
  1986. | |
  1987. <point>#+TBLFM: $1=2*$PROP_time_constant;t"
  1988. (org-table-calc-current-TBLFM)
  1989. (buffer-string)))))
  1990. (ert-deftest test-org-table/end-on-hline ()
  1991. "Test with a table ending on a hline."
  1992. (should
  1993. (equal
  1994. (org-test-with-temp-text
  1995. "
  1996. | 1 | 2 | 3 |
  1997. | 4 | 5 | 6 |
  1998. | | | |
  1999. |---+---+---|
  2000. <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
  2001. (org-table-calc-current-TBLFM)
  2002. (buffer-string))
  2003. "
  2004. | 1 | 2 | 3 |
  2005. | 4 | 5 | 6 |
  2006. | | 7 | 9 |
  2007. |---+---+---|
  2008. #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
  2009. (ert-deftest test-org-table/named-field ()
  2010. "Test formula with a named field."
  2011. (should
  2012. (string-match-p
  2013. "| +| +1 +|"
  2014. (org-test-with-temp-text "
  2015. | | |
  2016. | ^ | name |
  2017. <point>#+TBLFM: $name=1"
  2018. (org-table-calc-current-TBLFM)
  2019. (buffer-string))))
  2020. (should
  2021. (string-match-p
  2022. "| +| +1 +|"
  2023. (org-test-with-temp-text "
  2024. | _ | name |
  2025. | | |
  2026. <point>#+TBLFM: $name=1"
  2027. (org-table-calc-current-TBLFM)
  2028. (buffer-string)))))
  2029. (ert-deftest test-org-table/named-column ()
  2030. "Test formula with a named field."
  2031. (should
  2032. (string-match-p
  2033. "| +| +1 +| +1 +|"
  2034. (org-test-with-temp-text "
  2035. | ! | name | |
  2036. | | 1 | |
  2037. <point>#+TBLFM: @2$3=$name"
  2038. (org-table-calc-current-TBLFM)
  2039. (buffer-string)))))
  2040. (ert-deftest test-org-table/formula-priority ()
  2041. "Test field formula priority over column formula."
  2042. ;; Field formulas bind stronger than column formulas.
  2043. (should
  2044. (equal
  2045. "| 1 | 3 |\n| 2 | 99 |\n"
  2046. (org-test-with-temp-text
  2047. "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
  2048. (org-table-calc-current-TBLFM)
  2049. (buffer-substring-no-properties (point-min) (point)))))
  2050. ;; When field formula is removed, table formulas is applied again.
  2051. (should
  2052. (equal
  2053. "| 1 | 3 |\n| 2 | 6 |\n"
  2054. (org-test-with-temp-text
  2055. "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
  2056. (org-table-calc-current-TBLFM)
  2057. (delete-region (point) (line-end-position))
  2058. (org-table-calc-current-TBLFM)
  2059. (buffer-substring-no-properties (point-min) (line-beginning-position))))))
  2060. (ert-deftest test-org-table/tab-indent ()
  2061. "Test named fields with tab indentation."
  2062. (should
  2063. (string-match-p
  2064. "| # | 111 |"
  2065. (org-test-with-temp-text
  2066. "
  2067. | ! | sum | | a | b | c |
  2068. |---+------+------+---+----+-----|
  2069. | # | 1011 | 1000 | 1 | 10 | 100 |
  2070. <point>#+TBLFM: $2=$a+$b+$c
  2071. "
  2072. (org-table-calc-current-TBLFM)
  2073. (buffer-string)))))
  2074. (ert-deftest test-org-table/first-rc ()
  2075. "Test \"$<\" and \"@<\" constructs in formulas."
  2076. (should
  2077. (string-match-p
  2078. "| 1 | 2 |"
  2079. (org-test-with-temp-text
  2080. "| | 2 |
  2081. <point>#+TBLFM: $<=1"
  2082. (org-table-calc-current-TBLFM)
  2083. (buffer-string))))
  2084. (should
  2085. (string-match-p
  2086. "| 2 |\n| 2 |"
  2087. (org-test-with-temp-text
  2088. "| 2 |\n| |
  2089. <point>#+TBLFM: @2$1=@<"
  2090. (org-table-calc-current-TBLFM)
  2091. (buffer-string)))))
  2092. (ert-deftest test-org-table/last-rc ()
  2093. "Test \"$>\" and \"@>\" constructs in formulas."
  2094. (should
  2095. (string-match-p
  2096. "| 2 | 1 |"
  2097. (org-test-with-temp-text
  2098. "| 2 | |\n<point>#+TBLFM: $>=1"
  2099. (org-table-calc-current-TBLFM)
  2100. (buffer-string))))
  2101. (should
  2102. (string-match-p
  2103. "| 2 |\n| 2 |"
  2104. (org-test-with-temp-text
  2105. "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
  2106. (org-table-calc-current-TBLFM)
  2107. (buffer-string)))))
  2108. (ert-deftest test-org-table/time-stamps ()
  2109. "Test time-stamps handling."
  2110. ;; Standard test.
  2111. (should
  2112. (string-match-p
  2113. "| 1 |"
  2114. (org-test-with-temp-text
  2115. "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
  2116. (org-table-calc-current-TBLFM)
  2117. (buffer-string))))
  2118. ;; Handle locale specific time-stamps.
  2119. (should
  2120. (string-match-p
  2121. "| 1 |"
  2122. (org-test-with-temp-text
  2123. "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
  2124. (org-table-calc-current-TBLFM)
  2125. (buffer-string)))))
  2126. (ert-deftest test-org-table/orgtbl-ascii-draw ()
  2127. "Test `orgtbl-ascii-draw'."
  2128. ;; First value: Make sure that an integer input value is converted to a
  2129. ;; float before division. Further values: Show some float input value
  2130. ;; ranges corresponding to the same bar width.
  2131. (should
  2132. (equal
  2133. (org-test-with-temp-text
  2134. "
  2135. | Value | <l> |
  2136. |----------+---------|
  2137. | 19 | replace |
  2138. |----------+---------|
  2139. | -0.50001 | replace |
  2140. | -0.49999 | replace |
  2141. | 0.49999 | replace |
  2142. | 0.50001 | replace |
  2143. | 1.49999 | replace |
  2144. | 22.50001 | replace |
  2145. | 23.49999 | replace |
  2146. | 23.50001 | replace |
  2147. | 24.49999 | replace |
  2148. | 24.50001 | replace |
  2149. <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
  2150. (org-table-calc-current-TBLFM)
  2151. (buffer-string))
  2152. "
  2153. | Value | <l> |
  2154. |----------+-----------|
  2155. | 19 | 883 |
  2156. |----------+-----------|
  2157. | -0.50001 | too small |
  2158. | -0.49999 | |
  2159. | 0.49999 | |
  2160. | 0.50001 | 1 |
  2161. | 1.49999 | 1 |
  2162. | 22.50001 | 887 |
  2163. | 23.49999 | 887 |
  2164. | 23.50001 | 888 |
  2165. | 24.49999 | 888 |
  2166. | 24.50001 | too large |
  2167. #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
  2168. ;; Draw bars with a bullet. The bullet does not count in the parameter
  2169. ;; WIDTH of `orgtbl-ascii-draw'.
  2170. (should
  2171. (equal
  2172. (org-test-with-temp-text
  2173. "
  2174. | -1 | replace |
  2175. | 0 | replace |
  2176. | 1 | replace |
  2177. | 2 | replace |
  2178. | 3 | replace |
  2179. | 4 | replace |
  2180. <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
  2181. (org-table-calc-current-TBLFM)
  2182. (buffer-string))
  2183. "
  2184. | -1 | too small |
  2185. | 0 | $ |
  2186. | 1 | -$ |
  2187. | 2 | --$ |
  2188. | 3 | ---$ |
  2189. | 4 | too large |
  2190. #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
  2191. (ert-deftest test-org-table/single-rowgroup ()
  2192. "Test column formula in a table with a single rowgroup."
  2193. (should
  2194. (equal
  2195. "
  2196. |---+---|
  2197. | 1 | 0 |
  2198. |---+---|
  2199. #+TBLFM: $2=$1-1"
  2200. (org-test-with-temp-text "
  2201. |---+---|
  2202. | 1 | |
  2203. |---+---|
  2204. <point>#+TBLFM: $2=$1-1"
  2205. (org-table-calc-current-TBLFM)
  2206. (buffer-string))))
  2207. (should
  2208. (equal
  2209. "
  2210. | 1 | 0 |
  2211. #+TBLFM: $2=$1-1"
  2212. (org-test-with-temp-text "
  2213. | 1 | |
  2214. <point>#+TBLFM: $2=$1-1"
  2215. (org-table-calc-current-TBLFM)
  2216. (buffer-string)))))
  2217. ;;; Navigation
  2218. (ert-deftest test-org-table/next-field ()
  2219. "Test `org-table-next-field' specifications."
  2220. ;; Regular test.
  2221. (should
  2222. (equal
  2223. "b"
  2224. (org-test-with-temp-text "| a<point> | b |"
  2225. (org-table-next-field)
  2226. (org-trim (org-table-get-field)))))
  2227. ;; Create new rows as needed.
  2228. (should
  2229. (equal
  2230. "| a |\n| |\n"
  2231. (org-test-with-temp-text "| a<point> |"
  2232. (org-table-next-field)
  2233. (buffer-string))))
  2234. ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
  2235. ;; non-nil.
  2236. (should
  2237. (equal
  2238. "b"
  2239. (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
  2240. (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
  2241. (org-trim (org-table-get-field)))))
  2242. ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
  2243. ;; a new row before the rule.
  2244. (should
  2245. (equal
  2246. "| a |\n| |\n|---|\n| b |"
  2247. (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
  2248. (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
  2249. (buffer-string)))))
  2250. (ert-deftest test-org-table/previous-field ()
  2251. "Test `org-table-previous-field' specifications."
  2252. ;; Regular tests.
  2253. (should
  2254. (eq ?a
  2255. (org-test-with-temp-text "| a | <point>b |"
  2256. (org-table-previous-field)
  2257. (char-after))))
  2258. (should
  2259. (eq ?a
  2260. (org-test-with-temp-text "| a |\n| <point>b |"
  2261. (org-table-previous-field)
  2262. (char-after))))
  2263. ;; Find previous field across horizontal rules.
  2264. (should
  2265. (eq ?a
  2266. (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
  2267. (org-table-previous-field)
  2268. (char-after))))
  2269. ;; When called on a horizontal rule, find previous data field.
  2270. (should
  2271. (eq ?b
  2272. (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
  2273. (org-table-previous-field)
  2274. (char-after))))
  2275. ;; Error when at first field. Make sure to preserve original
  2276. ;; position.
  2277. (should-error
  2278. (org-test-with-temp-text "| <point> a|"
  2279. (org-table-previous-field)))
  2280. (should-error
  2281. (org-test-with-temp-text "|---|\n| <point>a |"
  2282. (org-table-previous-field)))
  2283. (should
  2284. (eq ?a
  2285. (org-test-with-temp-text "|---|\n| <point>a |"
  2286. (ignore-errors (org-table-previous-field))
  2287. (char-after)))))
  2288. ;;; Deleting columns
  2289. (ert-deftest test-org-table/delete-column ()
  2290. "Test `org-table-delete-column'."
  2291. ;; Error when outside a table.
  2292. (should-error
  2293. (org-test-with-temp-text "Paragraph"
  2294. (org-table-delete-column)))
  2295. ;; Delete first column.
  2296. (should
  2297. (equal "| a |\n"
  2298. (org-test-with-temp-text
  2299. "| <point> | a |\n"
  2300. (org-table-delete-column)
  2301. (buffer-string))))
  2302. ;; Delete column and check location of point.
  2303. (should
  2304. (= 2
  2305. (org-test-with-temp-text
  2306. "| a | <point>b | c |"
  2307. (org-table-delete-column)
  2308. (org-table-current-column))))
  2309. ;; Delete column when at end of line and after a "|".
  2310. (should
  2311. (equal "| a |\n"
  2312. (org-test-with-temp-text
  2313. "| a | b |<point>\n"
  2314. (org-table-delete-column)
  2315. (buffer-string))))
  2316. (should
  2317. (equal "| a |\n"
  2318. (org-test-with-temp-text
  2319. "| a | b | <point>\n"
  2320. (org-table-delete-column)
  2321. (buffer-string))))
  2322. ;; Delete two columns starting with the last column.
  2323. (should
  2324. (equal "| a |\n"
  2325. (org-test-with-temp-text
  2326. "| a | b | c<point> |"
  2327. (org-table-delete-column)
  2328. (org-table-delete-column)
  2329. (buffer-string)))))
  2330. ;;; Inserting rows, inserting columns
  2331. (ert-deftest test-org-table/insert-column ()
  2332. "Test `org-table-insert-column' specifications."
  2333. ;; Error when outside a table.
  2334. (should-error
  2335. (org-test-with-temp-text "Paragraph"
  2336. (org-table-insert-column)))
  2337. ;; Insert new column after current one.
  2338. (should
  2339. (equal "| | a |\n"
  2340. (org-test-with-temp-text "| a |"
  2341. (org-table-insert-column)
  2342. (buffer-string))))
  2343. (should
  2344. (equal "| | a | b |\n"
  2345. (org-test-with-temp-text "| <point>a | b |"
  2346. (org-table-insert-column)
  2347. (buffer-string))))
  2348. ;; Move point into the newly created column.
  2349. (should
  2350. (equal " | a |"
  2351. (org-test-with-temp-text "| <point>a |"
  2352. (org-table-insert-column)
  2353. (buffer-substring-no-properties (point) (line-end-position)))))
  2354. (should
  2355. (equal " | a | b |"
  2356. (org-test-with-temp-text "| <point>a | b |"
  2357. (org-table-insert-column)
  2358. (buffer-substring-no-properties (point) (line-end-position)))))
  2359. ;; Handle missing vertical bar in the last column.
  2360. (should
  2361. (equal "| | a |\n"
  2362. (org-test-with-temp-text "| a"
  2363. (org-table-insert-column)
  2364. (buffer-string))))
  2365. (should
  2366. (equal " | a |"
  2367. (org-test-with-temp-text "| <point>a"
  2368. (org-table-insert-column)
  2369. (buffer-substring-no-properties (point) (line-end-position)))))
  2370. ;; Handle column insertion when point is before first column.
  2371. (should
  2372. (equal " | | a |\n"
  2373. (org-test-with-temp-text " | a |"
  2374. (org-table-insert-column)
  2375. (buffer-string))))
  2376. (should
  2377. (equal " | | a | b |\n"
  2378. (org-test-with-temp-text " | a | b |"
  2379. (org-table-insert-column)
  2380. (buffer-string)))))
  2381. (ert-deftest test-org-table/insert-column-with-formula ()
  2382. "Test `org-table-insert-column' with a formula in place."
  2383. (should
  2384. (equal "| | 1 | 1 | 2 |
  2385. #+TBLFM: $4=$2+$3"
  2386. (org-test-with-temp-text
  2387. "| 1<point> | 1 | 2 |
  2388. #+TBLFM: $3=$1+$2"
  2389. (org-table-insert-column)
  2390. (buffer-substring-no-properties (point-min) (point-max))))))
  2391. ;;; Moving single cells
  2392. (ert-deftest test-org-table/move-cell-down ()
  2393. "Test `org-table-move-cell-down' specifications."
  2394. ;; Error out when cell cannot be moved due to not in table, in the
  2395. ;; last row of the table, or is on a hline.
  2396. (should-error
  2397. (org-test-with-temp-text "not in\na table\n"
  2398. (org-table-move-cell-down)))
  2399. (should-error
  2400. (org-test-with-temp-text "| a |"
  2401. (org-table-move-cell-down)))
  2402. (should-error
  2403. (org-test-with-temp-text "| a |\n"
  2404. (org-table-move-cell-down)))
  2405. (should-error
  2406. (org-test-with-temp-text "| a | <point>b |\n"
  2407. (org-table-move-cell-down)))
  2408. (should-error
  2409. (org-test-with-temp-text "| a | b |\n| <point>c | d |\n"
  2410. (org-table-move-cell-down)))
  2411. (should-error
  2412. (org-test-with-temp-text "| a | b |\n| c | <point>d |\n"
  2413. (org-table-move-cell-down)))
  2414. (should-error
  2415. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2416. (org-table-move-cell-down)))
  2417. (should-error
  2418. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2419. (org-table-move-cell-down)))
  2420. ;; Check for correct cell movement
  2421. (should (equal (concat "| c | b |\n"
  2422. "| a | d |\n"
  2423. "| e | f |\n")
  2424. (org-test-with-temp-text
  2425. (concat "| <point>a | b |\n"
  2426. "| c | d |\n"
  2427. "| e | f |\n")
  2428. (org-table-move-cell-down)
  2429. (buffer-string))))
  2430. (should (equal (concat "| a | d |\n"
  2431. "| c | b |\n"
  2432. "| e | f |\n")
  2433. (org-test-with-temp-text
  2434. (concat "| a | <point>b |\n"
  2435. "| c | d |\n"
  2436. "| e | f |\n")
  2437. (org-table-move-cell-down)
  2438. (buffer-string))))
  2439. (should (equal (concat "| a | b |\n"
  2440. "| e | d |\n"
  2441. "| c | f |\n")
  2442. (org-test-with-temp-text
  2443. (concat "| a | b |\n"
  2444. "| <point>c | d |\n"
  2445. "| e | f |\n")
  2446. (org-table-move-cell-down)
  2447. (buffer-string))))
  2448. (should (equal (concat "| a | d |\n"
  2449. "| c | f |\n"
  2450. "| e | b |\n")
  2451. (org-test-with-temp-text
  2452. (concat "| a |<point> b |\n"
  2453. "| c | d |\n"
  2454. "| e | f |\n")
  2455. (org-table-move-cell-down)
  2456. (org-table-move-cell-down)
  2457. (buffer-string))))
  2458. ;; Check for correct handling of hlines which should not change
  2459. ;; position on single cell moves.
  2460. (should (equal (concat "| c | b |\n"
  2461. "|---+---|\n"
  2462. "| a | d |\n"
  2463. "| e | f |\n")
  2464. (org-test-with-temp-text
  2465. (concat "| <point>a | b |\n"
  2466. "|---+---|\n"
  2467. "| c | d |\n"
  2468. "| e | f |\n")
  2469. (org-table-move-cell-down)
  2470. (buffer-string))))
  2471. (should (equal (concat "| a | d |\n"
  2472. "|---+---|\n"
  2473. "| c | f |\n"
  2474. "| e | b |\n")
  2475. (org-test-with-temp-text
  2476. (concat "| a | <point>b |\n"
  2477. "|---+---|\n"
  2478. "| c | d |\n"
  2479. "| e | f |\n")
  2480. (org-table-move-cell-down)
  2481. (org-table-move-cell-down)
  2482. (buffer-string))))
  2483. (should (equal (concat "| a | b |\n"
  2484. "|---+---|\n"
  2485. "| c | f |\n"
  2486. "| e | d |\n")
  2487. (org-test-with-temp-text
  2488. (concat "| a | b |\n"
  2489. "|---+---|\n"
  2490. "| c | <point>d |\n"
  2491. "| e | f |\n")
  2492. (org-table-move-cell-down)
  2493. (buffer-string))))
  2494. ;; Move single cell even without a final newline.
  2495. (should (equal (concat "| a | d |\n"
  2496. "|---+---|\n"
  2497. "| c | f |\n"
  2498. "| e | b |\n")
  2499. (org-test-with-temp-text
  2500. (concat "| a | <point>b |\n"
  2501. "|---+---|\n"
  2502. "| c | d |\n"
  2503. "| e | f |")
  2504. (org-table-move-cell-down)
  2505. (org-table-move-cell-down)
  2506. (buffer-string)))))
  2507. (ert-deftest test-org-table/move-cell-up ()
  2508. "Test `org-table-move-cell-up' specifications."
  2509. ;; Error out when cell cannot be moved due to not in table, in the
  2510. ;; last row of the table, or is on a hline.
  2511. (should-error
  2512. (org-test-with-temp-text "not in\na table\n"
  2513. (org-table-move-cell-up)))
  2514. (should-error
  2515. (org-test-with-temp-text "| a |"
  2516. (org-table-move-cell-up)))
  2517. (should-error
  2518. (org-test-with-temp-text "| a |\n"
  2519. (org-table-move-cell-up)))
  2520. (should-error
  2521. (org-test-with-temp-text "| <point>a | b |\n"
  2522. (org-table-move-cell-up)))
  2523. (should-error
  2524. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2525. (org-table-move-cell-up)))
  2526. (should-error
  2527. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2528. (org-table-move-cell-up)))
  2529. (should-error
  2530. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2531. (org-table-move-cell-up)))
  2532. ;; Check for correct cell movement.
  2533. (should (equal (concat "| c | b |\n"
  2534. "| a | d |\n"
  2535. "| e | f |\n")
  2536. (org-test-with-temp-text
  2537. (concat "| a | b |\n"
  2538. "| <point>c | d |\n"
  2539. "| e | f |\n")
  2540. (org-table-move-cell-up)
  2541. (buffer-string))))
  2542. (should (equal (concat "| a | d |\n"
  2543. "| c | b |\n"
  2544. "| e | f |\n")
  2545. (org-test-with-temp-text
  2546. (concat "| a | b |\n"
  2547. "| c | <point>d |\n"
  2548. "| e | f |\n")
  2549. (org-table-move-cell-up)
  2550. (buffer-string))))
  2551. (should (equal (concat "| a | b |\n"
  2552. "| e | d |\n"
  2553. "| c | f |\n")
  2554. (org-test-with-temp-text
  2555. (concat "| a | b |\n"
  2556. "| c | d |\n"
  2557. "| <point>e | f |\n")
  2558. (org-table-move-cell-up)
  2559. (buffer-string))))
  2560. (should (equal (concat "| a | f |\n"
  2561. "| c | b |\n"
  2562. "| e | d |\n")
  2563. (org-test-with-temp-text
  2564. (concat "| a | b |\n"
  2565. "| c | d |\n"
  2566. "| e |<point> f |\n")
  2567. (org-table-move-cell-up)
  2568. (org-table-move-cell-up)
  2569. (buffer-string))))
  2570. ;; Check for correct handling of hlines which should not change
  2571. ;; position on single cell moves.
  2572. (should (equal (concat "| c | b |\n"
  2573. "|---+---|\n"
  2574. "| a | d |\n"
  2575. "| e | f |\n")
  2576. (org-test-with-temp-text
  2577. (concat "| a | b |\n"
  2578. "|---+---|\n"
  2579. "| <point>c | d |\n"
  2580. "| e | f |\n")
  2581. (org-table-move-cell-up)
  2582. (buffer-string))))
  2583. (should (equal (concat "| a | f |\n"
  2584. "|---+---|\n"
  2585. "| c | b |\n"
  2586. "| e | d |\n")
  2587. (org-test-with-temp-text
  2588. (concat "| a | b |\n"
  2589. "|---+---|\n"
  2590. "| c | d |\n"
  2591. "| e | <point>f |\n")
  2592. (org-table-move-cell-up)
  2593. (org-table-move-cell-up)
  2594. (buffer-string))))
  2595. (should (equal (concat "| a | b |\n"
  2596. "|---+---|\n"
  2597. "| c | f |\n"
  2598. "| e | d |\n")
  2599. (org-test-with-temp-text
  2600. (concat "| a | b |\n"
  2601. "|---+---|\n"
  2602. "| c | d |\n"
  2603. "| e | <point>f |\n")
  2604. (org-table-move-cell-up)
  2605. (buffer-string))))
  2606. ;; Move single cell even without a final newline.
  2607. (should (equal (concat "| a | f |\n"
  2608. "|---+---|\n"
  2609. "| c | b |\n"
  2610. "| e | d |\n")
  2611. (org-test-with-temp-text
  2612. (concat "| a | b |\n"
  2613. "|---+---|\n"
  2614. "| c | d |\n"
  2615. "| e | <point>f |")
  2616. (org-table-move-cell-up)
  2617. (org-table-move-cell-up)
  2618. (buffer-string)))))
  2619. (ert-deftest test-org-table/move-cell-right ()
  2620. "Test `org-table-move-cell-right' specifications."
  2621. ;; Error out when cell cannot be moved due to not in table, in the
  2622. ;; last col of the table, or is on a hline.
  2623. (should-error
  2624. (org-test-with-temp-text "not in\na table\n"
  2625. (org-table-move-cell-right)))
  2626. (should-error
  2627. (org-test-with-temp-text "| a |"
  2628. (org-table-move-cell-right)))
  2629. (should-error
  2630. (org-test-with-temp-text "| a |\n"
  2631. (org-table-move-cell-right)))
  2632. (should-error
  2633. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2634. (org-table-move-cell-right)))
  2635. (should-error
  2636. (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
  2637. (org-table-move-cell-right)))
  2638. (should-error
  2639. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2640. (org-table-move-cell-right)))
  2641. (should-error
  2642. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2643. (org-table-move-cell-right)))
  2644. ;; Check for correct cell movement.
  2645. (should (equal (concat "| b | a | c |\n"
  2646. "| d | e | f |\n")
  2647. (org-test-with-temp-text
  2648. (concat "| <point>a | b | c |\n"
  2649. "| d | e | f |\n")
  2650. (org-table-move-cell-right)
  2651. (buffer-string))))
  2652. (should (equal (concat "| b | c | a |\n"
  2653. "| d | e | f |\n")
  2654. (org-test-with-temp-text
  2655. (concat "| <point>a | b | c |\n"
  2656. "| d | e | f |\n")
  2657. (org-table-move-cell-right)
  2658. (org-table-move-cell-right)
  2659. (buffer-string))))
  2660. (should (equal (concat "| a | b | c |\n"
  2661. "| e | f | d |\n")
  2662. (org-test-with-temp-text
  2663. (concat "| a | b | c |\n"
  2664. "| <point> d | e | f |\n")
  2665. (org-table-move-cell-right)
  2666. (org-table-move-cell-right)
  2667. (buffer-string))))
  2668. (should (equal (concat "| a | b | c |\n"
  2669. "| d | f | e |\n")
  2670. (org-test-with-temp-text
  2671. (concat "| a | b | c |\n"
  2672. "| d | <point>e | f |\n")
  2673. (org-table-move-cell-right)
  2674. (buffer-string))))
  2675. (should (equal (concat "| a | b | c |\n"
  2676. "|---+---+---|\n"
  2677. "| e | f | d |\n")
  2678. (org-test-with-temp-text
  2679. (concat "| a | b | c |\n"
  2680. "|---+---+---|\n"
  2681. "| <point>d | e | f |\n")
  2682. (org-table-move-cell-right)
  2683. (org-table-move-cell-right)
  2684. (buffer-string))))
  2685. ;; Move single cell even without a final newline.
  2686. (should (equal (concat "| a | b | c |\n"
  2687. "|---+---+---|\n"
  2688. "| e | d | f |\n")
  2689. (org-test-with-temp-text
  2690. (concat "| a | b | c |\n"
  2691. "|---+---+---|\n"
  2692. "| <point>d | e | f |")
  2693. (org-table-move-cell-right)
  2694. (buffer-string)))))
  2695. (ert-deftest test-org-table/move-cell-left ()
  2696. "Test `org-table-move-cell-left' specifications."
  2697. ;; Error out when cell cannot be moved due to not in table, in the
  2698. ;; last col of the table, or is on a hline.
  2699. (should-error
  2700. (org-test-with-temp-text "not in\na table\n"
  2701. (org-table-move-cell-left)))
  2702. (should-error
  2703. (org-test-with-temp-text "| a |"
  2704. (org-table-move-cell-left)))
  2705. (should-error
  2706. (org-test-with-temp-text "| a |\n"
  2707. (org-table-move-cell-left)))
  2708. (should-error
  2709. (org-test-with-temp-text "| <point>a |\n| b |\n"
  2710. (org-table-move-cell-left)))
  2711. (should-error
  2712. (org-test-with-temp-text "| <point>a | b |\n| c | d |\n"
  2713. (org-table-move-cell-left)))
  2714. (should-error
  2715. (org-test-with-temp-text "| <point>a |\n|---|\n"
  2716. (org-table-move-cell-left)))
  2717. (should-error
  2718. (org-test-with-temp-text "|<point>---|\n| a |\n"
  2719. (org-table-move-cell-left)))
  2720. ;; Check for correct cell movement.
  2721. (should (equal (concat "| b | a | c |\n"
  2722. "| d | e | f |\n")
  2723. (org-test-with-temp-text
  2724. (concat "| a | <point>b | c |\n"
  2725. "| d | e | f |\n")
  2726. (org-table-move-cell-left)
  2727. (buffer-string))))
  2728. (should (equal (concat "| c | a | b |\n"
  2729. "| d | e | f |\n")
  2730. (org-test-with-temp-text
  2731. (concat "| a | b | <point>c |\n"
  2732. "| d | e | f |\n")
  2733. (org-table-move-cell-left)
  2734. (org-table-move-cell-left)
  2735. (buffer-string))))
  2736. (should (equal (concat "| a | b | c |\n"
  2737. "| f | d | e |\n")
  2738. (org-test-with-temp-text
  2739. (concat "| a | b | c |\n"
  2740. "| d | e | <point>f |\n")
  2741. (org-table-move-cell-left)
  2742. (org-table-move-cell-left)
  2743. (buffer-string))))
  2744. (should (equal (concat "| a | b | c |\n"
  2745. "| d | f | e |\n")
  2746. (org-test-with-temp-text
  2747. (concat "| a | b | c |\n"
  2748. "| d | e | <point>f |\n")
  2749. (org-table-move-cell-left)
  2750. (buffer-string))))
  2751. (should (equal (concat "| a | b | c |\n"
  2752. "|---+---+---|\n"
  2753. "| f | d | e |\n")
  2754. (org-test-with-temp-text
  2755. (concat "| a | b | c |\n"
  2756. "|---+---+---|\n"
  2757. "| d | e | <point>f |\n")
  2758. (org-table-move-cell-left)
  2759. (org-table-move-cell-left)
  2760. (buffer-string))))
  2761. ;; Move single cell even without a final newline.
  2762. (should (equal (concat "| a | b | c |\n"
  2763. "|---+---+---|\n"
  2764. "| e | d | f |\n")
  2765. (org-test-with-temp-text
  2766. (concat "| a | b | c |\n"
  2767. "|---+---+---|\n"
  2768. "| d | <point>e | f |")
  2769. (org-table-move-cell-left)
  2770. (buffer-string)))))
  2771. ;;; Moving rows, moving columns
  2772. (ert-deftest test-org-table/move-row-down ()
  2773. "Test `org-table-move-row-down' specifications."
  2774. ;; Error out when row cannot be moved, e.g., it is the last row in
  2775. ;; the table.
  2776. (should-error
  2777. (org-test-with-temp-text "| a |"
  2778. (org-table-move-row-down)))
  2779. (should-error
  2780. (org-test-with-temp-text "| a |\n"
  2781. (org-table-move-row-down)))
  2782. (should-error
  2783. (org-test-with-temp-text "| a |\n| <point>b |"
  2784. (org-table-move-row-down)))
  2785. ;; Move data lines.
  2786. (should
  2787. (equal "| b |\n| a |\n"
  2788. (org-test-with-temp-text "| a |\n| b |\n"
  2789. (org-table-move-row-down)
  2790. (buffer-string))))
  2791. (should
  2792. (equal "|---|\n| a |\n"
  2793. (org-test-with-temp-text "| a |\n|---|\n"
  2794. (org-table-move-row-down)
  2795. (buffer-string))))
  2796. ;; Move hlines.
  2797. (should
  2798. (equal "| b |\n|---|\n"
  2799. (org-test-with-temp-text "|---|\n| b |\n"
  2800. (org-table-move-row-down)
  2801. (buffer-string))))
  2802. (should
  2803. (equal "|---|\n|---|\n"
  2804. (org-test-with-temp-text "|---|\n|---|\n"
  2805. (org-table-move-row-down)
  2806. (buffer-string))))
  2807. ;; Move rows even without a final newline.
  2808. (should
  2809. (equal "| b |\n| a |\n"
  2810. (org-test-with-temp-text "| a |\n| b |"
  2811. (org-table-move-row-down)
  2812. (buffer-string)))))
  2813. (ert-deftest test-org-table/move-row-up ()
  2814. "Test `org-table-move-row-up' specifications."
  2815. ;; Error out when row cannot be moved, e.g., it is the first row in
  2816. ;; the table.
  2817. (should-error
  2818. (org-test-with-temp-text "| a |"
  2819. (org-table-move-row-up)))
  2820. (should-error
  2821. (org-test-with-temp-text "| a |\n"
  2822. (org-table-move-row-up)))
  2823. ;; Move data lines.
  2824. (should
  2825. (equal "| b |\n| a |\n"
  2826. (org-test-with-temp-text "| a |\n| <point>b |\n"
  2827. (org-table-move-row-up)
  2828. (buffer-string))))
  2829. (should
  2830. (equal "| b |\n|---|\n"
  2831. (org-test-with-temp-text "|---|\n| <point>b |\n"
  2832. (org-table-move-row-up)
  2833. (buffer-string))))
  2834. ;; Move hlines.
  2835. (should
  2836. (equal "|---|\n| a |\n"
  2837. (org-test-with-temp-text "| a |\n|<point>---|\n"
  2838. (org-table-move-row-up)
  2839. (buffer-string))))
  2840. (should
  2841. (equal "|---|\n|---|\n"
  2842. (org-test-with-temp-text "|---|\n|<point>---|\n"
  2843. (org-table-move-row-up)
  2844. (buffer-string))))
  2845. ;; Move rows even without a final newline.
  2846. (should
  2847. (equal "| b |\n| a |\n"
  2848. (org-test-with-temp-text "| a |\n| <point>b |"
  2849. (org-table-move-row-up)
  2850. (buffer-string)))))
  2851. ;;; Shrunk columns
  2852. (ert-deftest test-org-table/toggle-column-width ()
  2853. "Test `org-table-toggle-columns-width' specifications."
  2854. ;; Error when not at a column.
  2855. (should-error
  2856. (org-test-with-temp-text "<point>a"
  2857. (org-table-toggle-column-width)))
  2858. ;; A shrunk column is overlaid with
  2859. ;; `org-table-shrunk-column-indicator'.
  2860. (should
  2861. (equal org-table-shrunk-column-indicator
  2862. (org-test-with-temp-text "| <point>a |"
  2863. (org-table-toggle-column-width)
  2864. (overlay-get (car (overlays-at (point))) 'display))))
  2865. (should
  2866. (equal org-table-shrunk-column-indicator
  2867. (org-test-with-temp-text "| a |\n|-<point>--|"
  2868. (org-table-toggle-column-width)
  2869. (overlay-get (car (overlays-at (point))) 'display))))
  2870. ;; Shrink every field in the same column.
  2871. (should
  2872. (equal org-table-shrunk-column-indicator
  2873. (org-test-with-temp-text "| a |\n|-<point>--|"
  2874. (org-table-toggle-column-width)
  2875. (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
  2876. 'display))))
  2877. ;; When column is already shrunk, expand it, i.e., remove overlays.
  2878. (should-not
  2879. (org-test-with-temp-text "| <point>a |"
  2880. (org-table-toggle-column-width)
  2881. (org-table-toggle-column-width)
  2882. (overlays-in (point-min) (point-max))))
  2883. (should-not
  2884. (org-test-with-temp-text "| a |\n| <point>b |"
  2885. (org-table-toggle-column-width)
  2886. (org-table-toggle-column-width)
  2887. (overlays-in (point-min) (point-max))))
  2888. ;; With a column width cookie, limit overlay to the specified number
  2889. ;; of characters.
  2890. (should
  2891. (equal "| abc"
  2892. (org-test-with-temp-text "| <3> |\n| <point>abcd |"
  2893. (org-table-toggle-column-width)
  2894. (buffer-substring (line-beginning-position)
  2895. (overlay-start
  2896. (car (overlays-in (line-beginning-position)
  2897. (line-end-position))))))))
  2898. (should
  2899. (equal "| a "
  2900. (org-test-with-temp-text "| <3> |\n| <point>a |"
  2901. (org-table-toggle-column-width)
  2902. (buffer-substring (line-beginning-position)
  2903. (overlay-start
  2904. (car (overlays-in (line-beginning-position)
  2905. (line-end-position))))))))
  2906. (should
  2907. (equal (concat "----" org-table-shrunk-column-indicator)
  2908. (org-test-with-temp-text "| <3> |\n|--<point>----|"
  2909. (org-table-toggle-column-width)
  2910. (overlay-get
  2911. (car (overlays-in (line-beginning-position)
  2912. (line-end-position)))
  2913. 'display))))
  2914. ;; Width only takes into account visible characters.
  2915. (should
  2916. (equal "| [[http"
  2917. (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
  2918. (org-table-toggle-column-width)
  2919. (buffer-substring (line-beginning-position)
  2920. (overlay-start
  2921. (car (overlays-in (line-beginning-position)
  2922. (line-end-position))))))))
  2923. ;; Before the first column or after the last one, ask for columns
  2924. ;; ranges.
  2925. (should
  2926. (catch :exit
  2927. (org-test-with-temp-text "| a |"
  2928. (cl-letf (((symbol-function 'read-string)
  2929. (lambda (&rest_) (throw :exit t))))
  2930. (org-table-toggle-column-width)
  2931. nil))))
  2932. (should
  2933. (catch :exit
  2934. (org-test-with-temp-text "| a |<point>"
  2935. (cl-letf (((symbol-function 'read-string)
  2936. (lambda (&rest_) (throw :exit t))))
  2937. (org-table-toggle-column-width)
  2938. nil))))
  2939. ;; When optional argument ARG is a string, toggle specified columns.
  2940. (should
  2941. (equal org-table-shrunk-column-indicator
  2942. (org-test-with-temp-text "| <point>a | b |"
  2943. (org-table-toggle-column-width "2")
  2944. (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
  2945. (should
  2946. (equal '("b" "c")
  2947. (org-test-with-temp-text "| a | b | c | d |"
  2948. (org-table-toggle-column-width "2-3")
  2949. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2950. (overlays-in (point-min) (point-max)))
  2951. #'string-lessp))))
  2952. (should
  2953. (equal '("b" "c" "d")
  2954. (org-test-with-temp-text "| a | b | c | d |"
  2955. (org-table-toggle-column-width "2-")
  2956. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2957. (overlays-in (point-min) (point-max)))
  2958. #'string-lessp))))
  2959. (should
  2960. (equal '("a" "b")
  2961. (org-test-with-temp-text "| a | b | c | d |"
  2962. (org-table-toggle-column-width "-2")
  2963. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2964. (overlays-in (point-min) (point-max)))
  2965. #'string-lessp))))
  2966. (should
  2967. (equal '("a" "b" "c" "d")
  2968. (org-test-with-temp-text "| a | b | c | d |"
  2969. (org-table-toggle-column-width "-")
  2970. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2971. (overlays-in (point-min) (point-max)))
  2972. #'string-lessp))))
  2973. (should
  2974. (equal '("a" "d")
  2975. (org-test-with-temp-text "| a | b | c | d |"
  2976. (org-table-toggle-column-width "1-3")
  2977. (org-table-toggle-column-width "2-4")
  2978. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  2979. (overlays-in (point-min) (point-max)))
  2980. #'string-lessp))))
  2981. ;; When ARG is (16), remove any column overlay.
  2982. (should-not
  2983. (org-test-with-temp-text "| <point>a |"
  2984. (org-table-toggle-column-width)
  2985. (org-table-toggle-column-width '(16))
  2986. (overlays-in (point-min) (point-max))))
  2987. (should-not
  2988. (org-test-with-temp-text "| a | b | c | d |"
  2989. (org-table-toggle-column-width "-")
  2990. (org-table-toggle-column-width '(16))
  2991. (overlays-in (point-min) (point-max)))))
  2992. (ert-deftest test-org-table/shrunk-columns ()
  2993. "Test behaviour of shrunk column."
  2994. ;; Edition automatically expands a shrunk column.
  2995. (should-not
  2996. (org-test-with-temp-text "| <point>a |"
  2997. (org-table-toggle-column-width)
  2998. (insert "a")
  2999. (overlays-in (point-min) (point-max))))
  3000. ;; Other columns are not changed.
  3001. (should
  3002. (org-test-with-temp-text "| <point>a | b |"
  3003. (org-table-toggle-column-width "-")
  3004. (insert "a")
  3005. (overlays-in (point-min) (point-max))))
  3006. ;; Moving a shrunk column doesn't alter its state.
  3007. (should
  3008. (equal "a"
  3009. (org-test-with-temp-text "| <point>a | b |"
  3010. (org-table-toggle-column-width)
  3011. (org-table-move-column-right)
  3012. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3013. (should
  3014. (equal "a"
  3015. (org-test-with-temp-text "| <point>a |\n| b |"
  3016. (org-table-toggle-column-width)
  3017. (org-table-move-row-down)
  3018. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3019. ;; State is preserved upon inserting a column.
  3020. (should
  3021. (equal '("a")
  3022. (org-test-with-temp-text "| <point>a |"
  3023. (org-table-toggle-column-width)
  3024. (org-table-insert-column)
  3025. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3026. (overlays-in (point-min) (point-max)))
  3027. #'string-lessp))))
  3028. ;; State is preserved upon deleting a column.
  3029. (should
  3030. (equal '("a" "c")
  3031. (org-test-with-temp-text "| a | <point>b | c |"
  3032. (org-table-toggle-column-width "-")
  3033. (org-table-delete-column)
  3034. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3035. (overlays-in (point-min) (point-max)))
  3036. #'string-lessp))))
  3037. ;; State is preserved upon deleting a row.
  3038. (should
  3039. (equal '("b1" "b2")
  3040. (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
  3041. (org-table-toggle-column-width "-")
  3042. (org-table-kill-row)
  3043. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3044. (overlays-in (point-min) (point-max)))
  3045. #'string-lessp))))
  3046. (should
  3047. (equal '("a1" "a2")
  3048. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  3049. (org-table-toggle-column-width "-")
  3050. (org-table-kill-row)
  3051. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3052. (overlays-in (point-min) (point-max)))
  3053. #'string-lessp))))
  3054. ;; State is preserved upon inserting a row or hline.
  3055. (should
  3056. (equal '("" "a1" "b1")
  3057. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  3058. (org-table-toggle-column-width)
  3059. (org-table-insert-row)
  3060. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3061. (overlays-in (point-min) (point-max)))
  3062. #'string-lessp))))
  3063. (should
  3064. (equal '("a1" "b1")
  3065. (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
  3066. (org-table-toggle-column-width)
  3067. (org-table-insert-hline)
  3068. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3069. (overlays-in (point-min) (point-max)))
  3070. #'string-lessp))))
  3071. ;; State is preserved upon sorting a column for all the columns but
  3072. ;; the one being sorted.
  3073. (should
  3074. (equal '("a2" "b2")
  3075. (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
  3076. (org-table-toggle-column-width "-")
  3077. (org-table-sort-lines nil ?A)
  3078. (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
  3079. (overlays-in (point-min) (point-max)))
  3080. #'string-lessp))))
  3081. ;; State is preserved upon replacing a field non-interactively.
  3082. (should
  3083. (equal '("a")
  3084. (org-test-with-temp-text "| <point>a |"
  3085. (org-table-toggle-column-width)
  3086. (org-table-get-field nil "b")
  3087. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3088. (overlays-in (point-min) (point-max))))))
  3089. ;; Moving to next field doesn't change shrunk state.
  3090. (should
  3091. (equal "a"
  3092. (org-test-with-temp-text "| <point>a | b |"
  3093. (org-table-toggle-column-width)
  3094. (org-table-next-field)
  3095. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3096. 'help-echo))))
  3097. (should
  3098. (equal "b"
  3099. (org-test-with-temp-text "| a | <point>b |"
  3100. (org-table-toggle-column-width)
  3101. (goto-char 2)
  3102. (org-table-next-field)
  3103. (overlay-get (car (overlays-at (point))) 'help-echo))))
  3104. ;; Aligning table doesn't alter shrunk state.
  3105. (should
  3106. (equal "a"
  3107. (org-test-with-temp-text "| <point>a | b |"
  3108. (org-table-toggle-column-width)
  3109. (org-table-align)
  3110. (overlay-get (car (overlays-at (1+ (line-beginning-position))))
  3111. 'help-echo))))
  3112. (should
  3113. (equal "b"
  3114. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3115. (org-table-toggle-column-width)
  3116. (org-table-align)
  3117. (overlay-get (car (overlays-at (point)))
  3118. 'help-echo))))
  3119. (should
  3120. (equal
  3121. '("b")
  3122. (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
  3123. (org-table-toggle-column-width)
  3124. (org-table-align)
  3125. (mapcar (lambda (o) (overlay-get o 'help-echo))
  3126. (overlays-in (line-beginning-position) (line-end-position))))))
  3127. ;; Recalculating formulas doesn't change shrunk state.
  3128. (should
  3129. (equal "2"
  3130. (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
  3131. (org-table-toggle-column-width)
  3132. (org-table-recalculate)
  3133. (overlay-get (car (overlays-at (point))) 'help-echo)))))
  3134. ;;; Miscellaneous
  3135. (ert-deftest test-org-table/current-column ()
  3136. "Test `org-table-current-column' specifications."
  3137. (should
  3138. (= 1 (org-test-with-temp-text "| <point>a |"
  3139. (org-table-current-column))))
  3140. (should
  3141. (= 1 (org-test-with-temp-text "|-<point>--|"
  3142. (org-table-current-column))))
  3143. (should
  3144. (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
  3145. (org-table-current-column))))
  3146. (should
  3147. (= 2 (org-test-with-temp-text "|---+-<point>--|"
  3148. (org-table-current-column)))))
  3149. (ert-deftest test-org-table/get-field ()
  3150. "Test `org-table-get-field' specifications."
  3151. ;; Regular test.
  3152. (should
  3153. (equal " a "
  3154. (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
  3155. ;; Get field in open last column.
  3156. (should
  3157. (equal " a "
  3158. (org-test-with-temp-text "| <point>a " (org-table-get-field))))
  3159. ;; Get empty field.
  3160. (should
  3161. (equal ""
  3162. (org-test-with-temp-text "|<point>|" (org-table-get-field))))
  3163. (should
  3164. (equal " "
  3165. (org-test-with-temp-text "| <point>|" (org-table-get-field))))
  3166. ;; Outside the table, return the empty string.
  3167. (should
  3168. (equal ""
  3169. (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
  3170. (should
  3171. (equal ""
  3172. (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
  3173. ;; With optional N argument, select a particular column in current
  3174. ;; row.
  3175. (should
  3176. (equal " 3 "
  3177. (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
  3178. (should
  3179. (equal " 4 "
  3180. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3181. (org-table-get-field 2))))
  3182. ;; REPLACE optional argument is used to replace selected field.
  3183. (should
  3184. (equal "| foo |"
  3185. (org-test-with-temp-text "| <point>1 |"
  3186. (org-table-get-field nil " foo ")
  3187. (buffer-string))))
  3188. (should
  3189. (equal "| 1 | 2 | foo |"
  3190. (org-test-with-temp-text "| 1 | 2 | 3 |"
  3191. (org-table-get-field 3 " foo ")
  3192. (buffer-string))))
  3193. (should
  3194. (equal " 4 "
  3195. (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
  3196. (org-table-get-field 2))))
  3197. ;; An empty REPLACE string clears the field.
  3198. (should
  3199. (equal "| |"
  3200. (org-test-with-temp-text "| <point>1 |"
  3201. (org-table-get-field nil "")
  3202. (buffer-string))))
  3203. ;; When using REPLACE still return old value.
  3204. (should
  3205. (equal " 1 "
  3206. (org-test-with-temp-text "| <point>1 |"
  3207. (org-table-get-field nil " foo ")))))
  3208. (provide 'test-org-table)
  3209. ;;; test-org-table.el ends here