test-org-table.el 101 KB

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