test-org-table.el 105 KB

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