12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371 |
- ;;; test-org-table.el --- tests for org-table.el
- ;; Copyright (c) David Maus
- ;; Authors: David Maus, Michael Brand
- ;; This file is not part of GNU Emacs.
- ;; This program is free software; you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; This program is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with this program. If not, see <https://www.gnu.org/licenses/>.
- ;;;; Comments:
- ;; Template test file for Org tests. Many tests are also a howto
- ;; example collection as a user documentation, more or less all those
- ;; using `org-test-table-target-expect'. See also the doc string of
- ;; `org-test-table-target-expect'.
- ;;; Code:
- (require 'org-table) ; `org-table-make-reference'
- (ert-deftest test-org-table/simple-formula/no-grouping/no-title-row ()
- "Simple sum without grouping rows, without title row."
- (org-test-table-target-expect
- "
- | 2 |
- | 4 |
- | 8 |
- | replace |
- "
- "
- | 2 |
- | 4 |
- | 8 |
- | 14 |
- "
- 1
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@<..@>>)"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @<..@>>); N"))
- (ert-deftest test-org-table/simple-formula/no-grouping/with-title-row ()
- "Simple sum without grouping rows, with title row."
- (org-test-table-target-expect
- "
- | foo |
- |---------|
- | 2 |
- | 4 |
- | 8 |
- | replace |
- "
- "
- | foo |
- |-----|
- | 2 |
- | 4 |
- | 8 |
- | 14 |
- "
- 1
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@I..@>>)"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @I..@>>); N"))
- (ert-deftest test-org-table/simple-formula/with-grouping/no-title-row ()
- "Simple sum with grouping rows, how not to do."
- ;; The first example has a problem, see the second example in this
- ;; ert-deftest.
- (org-test-table-target-expect
- "
- | 2 |
- | 4 |
- | 8 |
- |---------|
- | replace |
- "
- "
- | 2 |
- | 4 |
- | 8 |
- |----|
- | 14 |
- "
- 1
- ;; Calc formula
- "#+TBLFM: $1 = vsum(@<..@>>)"
- ;; Lisp formula
- "#+TBLFM: $1 = '(+ @<..@>>); N")
- ;; The problem is that the first three rows with the summands are
- ;; considered the header and therefore column formulas are not
- ;; applied on them as shown below. Also export behaves unexpected.
- ;; See next ert-deftest how to group rows right.
- (org-test-table-target-expect
- "
- | 2 | header |
- | 4 | header |
- | 8 | header |
- |---------+---------|
- | replace | replace |
- "
- "
- | 2 | header |
- | 4 | header |
- | 8 | header |
- |----+--------|
- | 14 | 28 |
- "
- 2
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@<..@>>) :: $2 = 2 * $1"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @<..@>>); N :: $2 = '(* 2 $1); N"))
- (ert-deftest test-org-table/simple-formula/with-grouping/with-title-row ()
- "Simple sum with grouping rows, how to do it right."
- ;; Always add a top row with the column names separated by hline to
- ;; get the desired header when you want to group rows.
- (org-test-table-target-expect
- "
- | foo | bar |
- |---------+---------|
- | 2 | replace |
- | 4 | replace |
- | 8 | replace |
- |---------+---------|
- | replace | replace |
- "
- "
- | foo | bar |
- |-----+-----|
- | 2 | 4 |
- | 4 | 8 |
- | 8 | 16 |
- |-----+-----|
- | 14 | 28 |
- "
- 2
- ;; Calc formula
- "#+TBLFM: @>$1 = vsum(@I..@>>) :: $2 = 2 * $1"
- ;; Lisp formula
- "#+TBLFM: @>$1 = '(+ @I..@>>); N :: $2 = '(* 2 $1); N"))
- (defconst references/target-normal "
- | 0 | 1 | replace | replace | replace | replace | replace | replace |
- | z | 1 | replace | replace | replace | replace | replace | replace |
- | | 1 | replace | replace | replace | replace | replace | replace |
- | | | replace | replace | replace | replace | replace | replace |
- "
- "Normal numbers and non-numbers for Lisp and Calc formula.")
- (defconst references/target-special "
- | nan | 1 | replace | replace | replace | replace | replace | replace |
- | uinf | 1 | replace | replace | replace | replace | replace | replace |
- | -inf | 1 | replace | replace | replace | replace | replace | replace |
- | inf | 1 | replace | replace | replace | replace | replace | replace |
- "
- "Special numbers for Calc formula.")
- (ert-deftest test-org-table/references/mode-string-EL ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string EL."
- ;; Empty fields are kept during parsing field but lost as list
- ;; elements within Lisp formula syntactically when used literally
- ;; and not enclosed with " within fields, see last columns with len.
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | 1 | 1 | 1 | 1 | 1 |
- | | | | 0 | 0 | 0 | 0 | 0 |
- "
- 1 (concat
- "#+TBLFM: $3 = '(identity \"$1\"); EL :: $4 = '(+ $1 $2); EL :: "
- "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
- "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL"))
- ;; Empty fields are kept during parsing field _and_ as list elements
- ;; within Lisp formula syntactically even when used literally when
- ;; enclosed with " within fields, see last columns with len.
- (org-test-table-target-expect
- "
- | \"0\" | \"1\" | repl | repl | repl | repl | repl | repl |
- | \"z\" | \"1\" | repl | repl | repl | repl | repl | repl |
- | \"\" | \"1\" | repl | repl | repl | repl | repl | repl |
- | \"\" | \"\" | repl | repl | repl | repl | repl | repl |
- "
- "
- | \"0\" | \"1\" | \"0\" | 1 | #ERROR | #ERROR | 2 | 2 |
- | \"z\" | \"1\" | \"z\" | 1 | #ERROR | #ERROR | 2 | 2 |
- | \"\" | \"1\" | \"\" | 1 | #ERROR | #ERROR | 2 | 2 |
- | \"\" | \"\" | \"\" | 0 | #ERROR | #ERROR | 2 | 2 |
- "
- 1 (concat
- "#+TBLFM: $3 = '(concat \"\\\"\" $1 \"\\\"\"); EL :: "
- "$4 = '(+ (string-to-number $1) (string-to-number $2)); EL :: "
- "$5 = '(+ $1..$2); EL :: $6 = '(+ @0$1..@0$2); EL :: "
- "$7 = '(length '($1..$2)); EL :: $8 = '(length '(@0$1..@0$2)); EL")))
- (ert-deftest test-org-table/references/mode-string-E ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string E."
- (let ((lisp
- (concat
- "#+TBLFM: $3 = '(identity $1); E :: $4 = '(+ $1 $2); E :: "
- "$5 = '(+ $1..$2); E :: $6 = '(+ @0$1..@0$2); E :: "
- "$7 = '(length '($1..$2)); E :: $8 = '(length '(@0$1..@0$2)); E"))
- (calc
- (concat
- "#+TBLFM: $3 = $1; E :: $4 = $1 + $2; E :: "
- "$5 = vsum($1..$2); E :: $6 = vsum(@0$1..@0$2); E :: "
- "$7 = vlen($1..$2); E :: $8 = vlen(@0$1..@0$2); E")))
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | | | #ERROR | #ERROR | #ERROR | 2 | 2 |
- "
- 1 lisp)
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
- | | 1 | nan | nan | nan | nan | 2 | 2 |
- | | | nan | nan | nan | nan | 2 | 2 |
- "
- 1 calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | nan | nan | nan | nan | 2 | 2 |
- | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
- | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
- | inf | 1 | inf | inf | inf | inf | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/references/mode-string-EN ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string EN."
- (let ((lisp (concat
- "#+TBLFM: $3 = '(identity $1); EN :: $4 = '(+ $1 $2); EN :: "
- "$5 = '(+ $1..$2); EN :: $6 = '(+ @0$1..@0$2); EN :: "
- "$7 = '(length '($1..$2)); EN :: "
- "$8 = '(length '(@0$1..@0$2)); EN"))
- (calc (concat
- "#+TBLFM: $3 = $1; EN :: $4 = $1 + $2; EN :: "
- "$5 = vsum($1..$2); EN :: $6 = vsum(@0$1..@0$2); EN :: "
- "$7 = vlen($1..$2); EN :: $8 = vlen(@0$1..@0$2); EN")))
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | | | 0 | 0 | 0 | 0 | 2 | 2 |
- "
- 1 lisp calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/references/mode-string-L ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string L."
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | 1 | 1 | 1 | 1 | 1 |
- | | | | 0 | 0 | 0 | 0 | 0 |
- "
- 1 (concat
- "#+TBLFM: $3 = '(identity \"$1\"); L :: $4 = '(+ $1 $2); L :: "
- "$5 = '(+ $1..$2); L :: $6 = '(+ @0$1..@0$2); L :: "
- "$7 = '(length '($1..$2)); L :: $8 = '(length '(@0$1..@0$2)); L")))
- (ert-deftest test-org-table/references/mode-string-none ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). No mode string."
- (let ((lisp (concat
- "#+TBLFM: $3 = '(identity $1) :: $4 = '(+ $1 $2) :: "
- "$5 = '(+ $1..$2) :: $6 = '(+ @0$1..@0$2) :: "
- "$7 = '(length '($1..$2)) :: $8 = '(length '(@0$1..@0$2))"))
- (calc (concat
- "#+TBLFM: $3 = $1 :: $4 = $1 + $2 :: "
- "$5 = vsum($1..$2) :: $6 = vsum(@0$1..@0$2) :: "
- "$7 = vlen($1..$2) :: $8 = vlen(@0$1..@0$2)")))
- (org-test-table-target-expect
- references/target-normal
- ;; All the #ERROR show that for Lisp calculations N has to be used.
- "
- | 0 | 1 | 0 | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | z | 1 | z | #ERROR | #ERROR | #ERROR | 2 | 2 |
- | | 1 | | #ERROR | #ERROR | #ERROR | 1 | 1 |
- | | | | #ERROR | 0 | 0 | 0 | 0 |
- "
- 1 lisp)
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | z | z + 1 | z + 1 | z + 1 | 2 | 2 |
- | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
- | | | 0 | 0 | 0 | 0 | 0 | 0 |
- "
- 1 calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | nan | nan | nan | nan | 2 | 2 |
- | uinf | 1 | uinf | uinf | uinf | uinf | 2 | 2 |
- | -inf | 1 | -inf | -inf | -inf | -inf | 2 | 2 |
- | inf | 1 | inf | inf | inf | inf | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/references/mode-string-N ()
- "Basic: Assign field reference, sum of field references, sum
- and len of simple range reference (no row) and complex range
- reference (with row). Mode string N."
- (let ((lisp
- (concat
- "#+TBLFM: $3 = '(identity $1); N :: $4 = '(+ $1 $2); N :: "
- "$5 = '(+ $1..$2); N :: $6 = '(+ @0$1..@0$2); N :: "
- "$7 = '(length '($1..$2)); N :: $8 = '(length '(@0$1..@0$2)); N"))
- (calc
- (concat
- "#+TBLFM: $3 = $1; N :: $4 = $1 + $2; N :: "
- "$5 = vsum($1..$2); N :: $6 = vsum(@0$1..@0$2); N :: "
- "$7 = vlen($1..$2); N :: $8 = vlen(@0$1..@0$2); N")))
- (org-test-table-target-expect
- references/target-normal
- "
- | 0 | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | z | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | | 1 | 0 | 1 | 1 | 1 | 1 | 1 |
- | | | 0 | 0 | 0 | 0 | 0 | 0 |
- "
- 1 lisp calc)
- (org-test-table-target-expect
- references/target-special
- "
- | nan | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | uinf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | -inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- | inf | 1 | 0 | 1 | 1 | 1 | 2 | 2 |
- "
- 1 calc)))
- (ert-deftest test-org-table/mode-string-u ()
- "Basic: verify that mode string u results in units
- simplification mode applied to Calc formulas."
- (org-test-table-target-expect
- "
- | 1.5 A/B | 2.0 B | |
- "
- "
- | 1.5 A/B | 2.0 B | 3. A |
- "
- 1 "#+TBLFM: $3=$1*$2;u"))
- (ert-deftest test-org-table/lisp-return-value ()
- "Basic: Return value of Lisp formulas."
- (org-test-table-target-expect
- "
- | | nil | (list) | '() |
- |-------------------------+-------------+--------+-----|
- | type-of, no L | replace (r) | r | r |
- | type-of identity, no L | r | r | r |
- | identity, no L | r | r | r |
- |-------------------------+-------------+--------+-----|
- | type-of \"@1\" | r | r | r |
- | type-of (identity \"@1\") | r | r | r |
- | identity \"@1\" | r | r | r |
- |-------------------------+-------------+--------+-----|
- | type-of @1 | r | r | r |
- | type-of (identity @1) | r | r | r |
- | identity @1 | r | r | r |
- "
- "
- | | nil | (list) | '() |
- |-------------------------+--------+--------+--------|
- | type-of, no L | string | string | string |
- | type-of identity, no L | string | string | string |
- | identity, no L | nil | (list) | '() |
- |-------------------------+--------+--------+--------|
- | type-of \"@1\" | string | string | string |
- | type-of (identity \"@1\") | string | string | string |
- | identity \"@1\" | nil | (list) | '() |
- |-------------------------+--------+--------+--------|
- | type-of @1 | symbol | symbol | symbol |
- | type-of (identity @1) | symbol | symbol | symbol |
- | identity @1 | nil | nil | nil |
- "
- 1 (concat "#+TBLFM: @2$<<..@2$> = '(type-of @1) :: "
- "@3$<<..@3$> = '(type-of (identity @1)) :: "
- "@4$<<..@4$> = '(identity @1) :: @5$<<..@>$> = '(@0$1); L")))
- (ert-deftest test-org-table/compare ()
- "Basic: Compare field references in Calc."
- (org-test-table-target-expect
- "
- | | 0 | z | | nan | uinf | -inf | inf |
- |------+------+------+------+------+------+------+------|
- | 0 | repl | repl | repl | repl | repl | repl | repl |
- | z | repl | repl | repl | repl | repl | repl | repl |
- | | repl | repl | repl | repl | repl | repl | repl |
- | nan | repl | repl | repl | repl | repl | repl | repl |
- | uinf | repl | repl | repl | repl | repl | repl | repl |
- | -inf | repl | repl | repl | repl | repl | repl | repl |
- | inf | repl | repl | repl | repl | repl | repl | repl |
- "
- "
- | | 0 | z | | nan | uinf | -inf | inf |
- |------+---+---+---+-----+------+------+-----|
- | 0 | x | | | | | | |
- | z | | x | | | | | |
- | | | | x | | | | |
- | nan | | | | x | | | |
- | uinf | | | | | x | | |
- | -inf | | | | | | x | |
- | inf | | | | | | | x |
- "
- 1
- ;; Compare field reference ($1) with field reference (@1)
- "#+TBLFM: @<<$<<..@>$> = if(\"$1\" == \"@1\", x, string(\"\")); E"
- ;; Compare field reference ($1) with absolute term
- (concat "#+TBLFM: "
- "$2 = if(\"$1\" == \"(0)\" , x, string(\"\")); E :: "
- "$3 = if(\"$1\" == \"(z)\" , x, string(\"\")); E :: "
- "$4 = if(\"$1\" == \"nan\" , x, string(\"\")); E :: "
- "$5 = if(\"$1\" == \"(nan)\" , x, string(\"\")); E :: "
- "$6 = if(\"$1\" == \"(uinf)\", x, string(\"\")); E :: "
- "$7 = if(\"$1\" == \"(-inf)\", x, string(\"\")); E :: "
- "$8 = if(\"$1\" == \"(inf)\" , x, string(\"\")); E"))
- ;; Check field reference converted from an empty field: Despite this
- ;; field reference will not end up in a result, Calc evaluates it.
- ;; Make sure that also then there is no Calc error.
- (org-test-table-target-expect
- "
- | 0 | replace |
- | z | replace |
- | | replace |
- | nan | replace |
- "
- "
- | 0 | 1 |
- | z | z + 1 |
- | | |
- | nan | nan |
- "
- 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"))
- (ert-deftest test-org-table/empty-field ()
- "Examples how to deal with empty fields."
- ;; Test if one field is empty, else do a calculation
- (org-test-table-target-expect
- "
- | -1 | replace |
- | 0 | replace |
- | | replace |
- "
- "
- | -1 | 0 |
- | 0 | 1 |
- | | |
- "
- 1
- ;; Calc formula
- "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1 + 1); E"
- ;; Lisp formula
- "#+TBLFM: $2 = '(if (eq \"$1\" \"\") \"\" (1+ $1)); L")
- ;; Test if several fields are empty, else do a calculation
- (org-test-table-target-expect
- "
- | 1 | 2 | replace |
- | 4 | | replace |
- | | 8 | replace |
- | | | replace |
- "
- "
- | 1 | 2 | 3 |
- | 4 | | |
- | | 8 | |
- | | | |
- "
- 1
- ;; Calc formula
- (concat "#+TBLFM: $3 = if(\"$1\" == \"nan\" || \"$2\" == \"nan\", "
- "string(\"\"), $1 + $2); E")
- ;; Lisp formula
- (concat "#+TBLFM: $3 = '(if (or (eq \"$1\" \"\") (eq \"$2\" \"\")) "
- "\"\" (+ $1 $2)); L"))
- ;; $2: Use $1 + 0.5 if $1 available, else only reformat $2 if $2 available
- (org-test-table-target-expect
- "
- | 1.5 | 0 |
- | 3.5 | |
- | | 5 |
- | | |
- "
- "
- | 1.5 | 2.0 |
- | 3.5 | 4.0 |
- | | 5.0 |
- | | |
- "
- 1
- ;; Calc formula
- (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
- "if(\"$2\" == \"nan\", string(\"\"), $2 +.0), $1 + 0.5); E f-1")
- ;; Lisp formula not implemented yet
- )
- ;; Empty fields in simple and complex range reference
- (org-test-table-target-expect
- "
- | | | | | repl | repl | repl | repl | repl | repl |
- | | | 5 | 7 | repl | repl | repl | repl | repl | repl |
- | 1 | 3 | 5 | 7 | repl | repl | repl | repl | repl | repl |
- "
- "
- | | | | | | | | | 0 | 0 |
- | | | 5 | 7 | | | 6 | 6 | 3 | 3 |
- | 1 | 3 | 5 | 7 | 4 | 4 | 4 | 4 | 4 | 4 |
- "
- 1
- ;; Calc formula
- (concat
- "#+TBLFM: "
- "$5 = if(typeof(vmean($1..$4)) == 12, "
- "string(\"\"), vmean($1..$4)); E :: "
- "$6 = if(typeof(vmean(@0$1..@0$4)) == 12, "
- "string(\"\"), vmean(@0$1..@0$4)); E :: "
- "$7 = if(\"$1..$4\" == \"[]\", string(\"\"), vmean($1..$4)) :: "
- "$8 = if(\"@0$1..@0$4\" == \"[]\", string(\"\"), vmean(@0$1..@0$4)) :: "
- "$9 = vmean($1..$4); EN :: "
- "$10 = vmean(@0$1..@0$4); EN")
- ;; Lisp formula
- (concat
- "#+TBLFM: "
- "$5 = '(let ((l '($1..$4))) (if (member \"\" l) \"\" "
- "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
- "$6 = '(let ((l '(@0$1..@0$4))) (if (member \"\" l) \"\" "
- "(/ (apply '+ (mapcar 'string-to-number l)) (length l)))); E :: "
- "$7 = '(let ((l '($1..$4))) "
- "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
- "$8 = '(let ((l '(@0$1..@0$4))) "
- "(if l (/ (apply '+ l) (length l)) \"\")); N :: "
- "$9 = '(/ (+ $1..$4) (length '($1..$4))); EN :: "
- "$10 = '(/ (+ @0$1..@0$4) (length '(@0$1..@0$4))); EN")))
- (ert-deftest test-org-table/copy-field ()
- "Experiments on how to copy one field into another field.
- See also `test-org-table/remote-reference-access'."
- (let ((target "
- | 0 | replace |
- | a b | replace |
- | c d | replace |
- | | replace |
- | 2012-12 | replace |
- | [2012-12-31 Mon] | replace |
- "))
- ;; Lisp formula to copy literally
- (org-test-table-target-expect
- target
- "
- | 0 | 0 |
- | a b | a b |
- | c d | c d |
- | | |
- | 2012-12 | 2012-12 |
- | [2012-12-31 Mon] | [2012-12-31 Mon] |
- "
- 1 "#+TBLFM: $2 = '(identity $1)")
- ;; Calc formula to copy quite literally
- (org-test-table-target-expect
- target
- "
- | 0 | 0 |
- | a b | a b |
- | c d | c d |
- | | |
- | 2012-12 | 2012-12 |
- | [2012-12-31 Mon] | [2012-12-31 Mon] |
- "
- 1 (concat "#+TBLFM: $2 = if(\"$1\" == \"nan\", "
- "string(\"\"), string(subvec(\"$1\", 2, vlen(\"$1\")))); E"))
- ;; Calc formula simple
- (org-test-table-target-expect
- target
- "
- | 0 | 0 |
- | a b | a b |
- | c d | c d |
- | | |
- | 2012-12 | 2000 |
- | [2012-12-31 Mon] | [2012-12-31 Mon] |
- "
- 1 "#+TBLFM: $2 = if(\"$1\" == \"nan\", string(\"\"), $1); E")))
- (ert-deftest test-org-table/copy-down ()
- "Test `org-table-copy-down' specifications."
- ;; Error when there is nothing to copy in the current field or the
- ;; field above.
- (should-error
- (org-test-with-temp-text "| |\n| <point> |"
- (org-table-copy-down 1)))
- ;; Error when there is nothing to copy in the Nth field.
- (should-error
- (org-test-with-temp-text "| |\n| foo |\n| <point> |"
- (org-table-copy-down 2)))
- ;; In an empty field, copy field above.
- (should
- (equal "| foo |\n| foo |"
- (org-test-with-temp-text "| foo |\n| <point> |"
- (org-table-copy-down 1)
- (buffer-string))))
- ;; In a non-empty field, copy it below.
- (should
- (equal "| foo |\n| foo |\n"
- (org-test-with-temp-text "| <point>foo |"
- (org-table-copy-down 1)
- (buffer-string))))
- ;; If field is a number or a timestamp, or is prefixed or suffixed
- ;; with a number, increment it by one unit.
- (should
- (equal "| 1 |\n| 2 |\n"
- (org-test-with-temp-text "| <point>1 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (string-match-p "<2012-03-30"
- (org-test-with-temp-text "| <point><2012-03-29> |"
- (let ((org-table-copy-increment t))
- (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| A1 |\n| A2 |\n"
- (org-test-with-temp-text "| <point>A1 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 1A |\n| 2A |\n"
- (org-test-with-temp-text "| <point>1A |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; When `org-table-copy-increment' is nil, or when argument is 0, do
- ;; not increment.
- (should
- (equal "| 1 |\n| 1 |\n"
- (org-test-with-temp-text "| <point>1 |"
- (let ((org-table-copy-increment nil)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 1 |\n| 1 |\n"
- (org-test-with-temp-text "| <point>1 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 0))
- (buffer-string))))
- ;; When there is a field just above field being incremented, try to
- ;; use it to guess increment step.
- (should
- (equal "| 4 |\n| 3 |\n| 2 |\n"
- (org-test-with-temp-text "| 4 |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| A0 |\n| A2 |\n| A4 |\n"
- (org-test-with-temp-text "| A0 |\n| <point>A2 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; Both fields need to have the same type. In the special case of
- ;; number-prefixed or suffixed fields, make sure both fields have
- ;; the same pattern.
- (should
- (equal "| A4 |\n| 3 |\n| 4 |\n"
- (org-test-with-temp-text "| A4 |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 0A |\n| A2 |\n| A3 |\n"
- (org-test-with-temp-text "| 0A |\n| <point>A2 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| A0 |\n| 2A |\n| 3A |\n"
- (org-test-with-temp-text "| A0 |\n| <point>2A |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; Do not search field above past blank fields and horizontal
- ;; separators.
- (should
- (equal "| 4 |\n|---|\n| 3 |\n| 4 |\n"
- (org-test-with-temp-text "| 4 |\n|---|\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- (should
- (equal "| 4 |\n| |\n| 3 |\n| 4 |\n"
- (org-test-with-temp-text "| 4 |\n| |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 1))
- (buffer-string))))
- ;; When `org-table-copy-increment' is a number, use it as the
- ;; increment step, ignoring any previous field.
- (should
- (equal "| 1 |\n| 3 |\n| 6 |\n"
- (org-test-with-temp-text "| 1 |\n| <point>3 |"
- (let ((org-table-copy-increment 3)) (org-table-copy-down 1))
- (buffer-string))))
- ;; However, if argument is 0, do not increment whatsoever.
- (should
- (equal "| 1 |\n| 3 |\n| 3 |\n"
- (org-test-with-temp-text "| 1 |\n| <point>3 |"
- (let ((org-table-copy-increment t)) (org-table-copy-down 0))
- (buffer-string))))
- (should
- (equal "| 1 |\n| 3 |\n| 3 |\n"
- (org-test-with-temp-text "| 1 |\n| <point>3 |"
- (let ((org-table-copy-increment 3)) (org-table-copy-down 0))
- (buffer-string)))))
- (ert-deftest test-org-table/sub-total ()
- "Grouped rows with sub-total.
- Begin range with \"@II\" to handle multiline header. Convert
- integer to float with \"+.0\" for sub-total of items c1 and c2.
- Sum empty fields as value zero but without ignoring them for
- \"vlen\" with format specifier \"EN\". Format possibly empty
- results with the Calc formatter \"f-1\" instead of the printf
- formatter \"%.1f\"."
- (org-test-table-target-expect
- "
- |-------+---------+---------|
- | Item | Item | Sub- |
- | name | value | total |
- |-------+---------+---------|
- | a1 | 4.1 | replace |
- | a2 | 8.2 | replace |
- | a3 | | replace |
- |-------+---------+---------|
- | b1 | 16.0 | replace |
- |-------+---------+---------|
- | c1 | 32 | replace |
- | c2 | 64 | replace |
- |-------+---------+---------|
- | Total | replace | replace |
- |-------+---------+---------|
- "
- "
- |-------+-------+-------|
- | Item | Item | Sub- |
- | name | value | total |
- |-------+-------+-------|
- | a1 | 4.1 | |
- | a2 | 8.2 | |
- | a3 | | 12.3 |
- |-------+-------+-------|
- | b1 | 16.0 | 16.0 |
- |-------+-------+-------|
- | c1 | 32 | |
- | c2 | 64 | 96.0 |
- |-------+-------+-------|
- | Total | 124.3 | |
- |-------+-------+-------|
- "
- 1 (concat "#+TBLFM: @>$2 = vsum(@II..@>>) ::"
- "$3 = if(vlen(@0..@+I) == 1, "
- "vsum(@-I$2..@+I$2) +.0, string(\"\")); EN f-1 :: "
- "@>$3 = string(\"\")")))
- (ert-deftest test-org-table/org-lookup-all ()
- "Use `org-lookup-all' for several GROUP BY as in SQL and for ranking.
- See also URL `https://orgmode.org/worg/org-tutorials/org-lookups.html'."
- (let ((data "
- #+NAME: data
- | Purchase | Product | Shop | Rating |
- |----------+---------+------+--------|
- | a | p1 | s1 | 1 |
- | b | p1 | s2 | 4 |
- | c | p2 | s1 | 2 |
- | d | p3 | s2 | 8 |
- "))
- ;; Product rating and ranking by average purchase from "#+NAME: data"
- (org-test-table-target-expect
- (concat data "
- | Product | Rating | Ranking |
- |---------+---------+---------|
- | p1 | replace | replace |
- | p2 | replace | replace |
- | p3 | replace | replace |
- ")
- (concat data "
- | Product | Rating | Ranking |
- |---------+--------+---------|
- | p1 | 2.5 | 2 |
- | p2 | 2.0 | 3 |
- | p3 | 8.0 | 1 |
- ")
- 2 (concat
- "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
- "'(remote(data, @I$2..@>$2)) '(remote(data, @I$4..@>$4))))) "
- "(/ (apply '+ all) (length all) 1.0)); L :: "
- "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))
- ;; Shop rating and ranking by average purchase from "#+NAME: data"
- (org-test-table-target-expect
- (concat data "
- | Shop | Rating | Ranking |
- |------+---------+---------|
- | s1 | replace | replace |
- | s2 | replace | replace |
- ")
- (concat data "
- | Shop | Rating | Ranking |
- |------+--------+---------|
- | s1 | 1.5 | 2 |
- | s2 | 6.0 | 1 |
- ")
- 2 (concat
- "#+TBLFM: $2 = '(let ((all (org-lookup-all '$1 "
- "'(remote(data, @I$3..@>$3)) '(remote(data, @I$4..@>$4))))) "
- "(/ (apply '+ all) (length all) 1.0)); L :: "
- "$3 = '(+ 1 (length (org-lookup-all $2 '(@I$2..@>$2) nil '<))); N"))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-EL ()
- ;; For Lisp formula only
- (should (equal "0" (org-table-make-reference "0" t nil 'literal)))
- (should (equal "z" (org-table-make-reference "z" t nil 'literal)))
- (should (equal "" (org-table-make-reference "" t nil 'literal)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") t nil 'literal)))
- (should (equal "z 1" (org-table-make-reference '("z" "1") t nil 'literal)))
- (should (equal " 1" (org-table-make-reference '("" "1") t nil 'literal)))
- (should (equal " " (org-table-make-reference '("" "") t nil 'literal))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-E ()
- ;; For Lisp formula
- (should (equal "\"0\"" (org-table-make-reference "0" t nil t)))
- (should (equal "\"z\"" (org-table-make-reference "z" t nil t)))
- (should (equal"\"\"" (org-table-make-reference "" t nil t)))
- (should (equal "\"0\" \"1\"" (org-table-make-reference '("0""1") t nil t)))
- (should (equal "\"z\" \"1\"" (org-table-make-reference '("z""1") t nil t)))
- (should (equal"\"\" \"1\"" (org-table-make-reference '("""1") t nil t)))
- (should (equal"\"\" \"\""(org-table-make-reference '("""" ) t nil t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" t nil nil)))
- (should (equal "(z)" (org-table-make-reference "z" t nil nil)))
- (should (equal "nan" (org-table-make-reference "" t nil nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") t nil nil)))
- (should (equal "[z,1]" (org-table-make-reference '("z" "1") t nil nil)))
- (should (equal "[nan,1]" (org-table-make-reference '("" "1") t nil nil)))
- (should (equal "[nan,nan]" (org-table-make-reference '("" "") t nil nil)))
- ;; For Calc formula, special numbers
- (should (equal "(nan)" (org-table-make-reference "nan" t nil nil)))
- (should (equal "(uinf)" (org-table-make-reference "uinf" t nil nil)))
- (should (equal "(-inf)" (org-table-make-reference "-inf" t nil nil)))
- (should (equal "(inf)" (org-table-make-reference "inf" t nil nil)))
- (should (equal "[nan,1]" (org-table-make-reference '("nan" "1") t nil nil)))
- (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") t nil nil)))
- (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") t nil nil)))
- (should (equal "[inf,1]" (org-table-make-reference '("inf" "1") t nil nil))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-EN ()
- ;; For Lisp formula
- (should (equal "0" (org-table-make-reference "0" t t t)))
- (should (equal "0" (org-table-make-reference "z" t t t)))
- (should (equal "0" (org-table-make-reference "" t t t)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") t t t)))
- (should (equal "0 1" (org-table-make-reference '("z" "1") t t t)))
- (should (equal "0 1" (org-table-make-reference '("" "1") t t t)))
- (should (equal "0 0" (org-table-make-reference '("" "" ) t t t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" t t nil)))
- (should (equal "(0)" (org-table-make-reference "z" t t nil)))
- (should (equal "(0)" (org-table-make-reference "" t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("z" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("" "1") t t nil)))
- (should (equal "[0,0]" (org-table-make-reference '("" "" ) t t nil)))
- ;; For Calc formula, special numbers
- (should (equal "(0)" (org-table-make-reference "nan" t t nil)))
- (should (equal "(0)" (org-table-make-reference "uinf" t t nil)))
- (should (equal "(0)" (org-table-make-reference "-inf" t t nil)))
- (should (equal "(0)" (org-table-make-reference "inf" t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") t t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") t t nil))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-L ()
- ;; For Lisp formula only
- (should (equal "0" (org-table-make-reference "0" nil nil 'literal)))
- (should (equal "z" (org-table-make-reference "z" nil nil 'literal)))
- (should (equal "" (org-table-make-reference "" nil nil 'literal)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") nil nil 'literal)))
- (should (equal "z 1" (org-table-make-reference '("z" "1") nil nil 'literal)))
- (should (equal "1" (org-table-make-reference '("" "1") nil nil 'literal)))
- (should (equal "" (org-table-make-reference '("" "" ) nil nil 'literal))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-none ()
- ;; For Lisp formula
- (should (equal "\"0\"" (org-table-make-reference "0" nil nil t)))
- (should (equal "\"z\"" (org-table-make-reference "z" nil nil t)))
- (should (equal "" (org-table-make-reference "" nil nil t)))
- (should (equal "\"0\" \"1\"" (org-table-make-reference '("0" "1") nil nil t)))
- (should (equal "\"z\" \"1\"" (org-table-make-reference '("z" "1") nil nil t)))
- (should (equal "\"1\"" (org-table-make-reference '("" "1") nil nil t)))
- (should (equal "" (org-table-make-reference '("" "" ) nil nil t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" nil nil nil)))
- (should (equal "(z)" (org-table-make-reference "z" nil nil nil)))
- (should (equal "(0)" (org-table-make-reference "" nil nil nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil nil nil)))
- (should (equal "[z,1]" (org-table-make-reference '("z" "1") nil nil nil)))
- (should (equal "[1]" (org-table-make-reference '("" "1") nil nil nil)))
- (should (equal "[]" (org-table-make-reference '("" "" ) nil nil nil)))
- ;; For Calc formula, special numbers
- (should (equal "(nan)" (org-table-make-reference "nan" nil nil nil)))
- (should (equal "(uinf)" (org-table-make-reference "uinf" nil nil nil)))
- (should (equal "(-inf)" (org-table-make-reference "-inf" nil nil nil)))
- (should (equal "(inf)" (org-table-make-reference "inf" nil nil nil)))
- (should (equal "[nan,1]" (org-table-make-reference '( "nan" "1") nil nil nil)))
- (should (equal "[uinf,1]" (org-table-make-reference '("uinf" "1") nil nil nil)))
- (should (equal "[-inf,1]" (org-table-make-reference '("-inf" "1") nil nil nil)))
- (should (equal "[inf,1]" (org-table-make-reference '( "inf" "1") nil nil nil))))
- (ert-deftest test-org-table/org-table-make-reference/mode-string-N ()
- ;; For Lisp formula
- (should (equal "0" (org-table-make-reference "0" nil t t)))
- (should (equal "0" (org-table-make-reference "z" nil t t)))
- (should (equal "" (org-table-make-reference "" nil t t)))
- (should (equal "0 1" (org-table-make-reference '("0" "1") nil t t)))
- (should (equal "0 1" (org-table-make-reference '("z" "1") nil t t)))
- (should (equal "1" (org-table-make-reference '("" "1") nil t t)))
- (should (equal "" (org-table-make-reference '("" "" ) nil t t)))
- ;; For Calc formula
- (should (equal "(0)" (org-table-make-reference "0" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "z" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "" nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("0" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("z" "1") nil t nil)))
- (should (equal "[1]" (org-table-make-reference '("" "1") nil t nil)))
- (should (equal "[]" (org-table-make-reference '("" "" ) nil t nil)))
- ;; For Calc formula, special numbers
- (should (equal "(0)" (org-table-make-reference "nan" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "uinf" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "-inf" nil t nil)))
- (should (equal "(0)" (org-table-make-reference "inf" nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "nan" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("uinf" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '("-inf" "1") nil t nil)))
- (should (equal "[0,1]" (org-table-make-reference '( "inf" "1") nil t nil))))
- (ert-deftest test-org-table/org-table-convert-refs-to-an/1 ()
- "Simple reference @2$1."
- (should
- (string= "A2" (org-table-convert-refs-to-an "@2$1"))))
- ;; TODO: Test broken
- ;; (ert-deftest test-org-table/org-table-convert-refs-to-an/2 ()
- ;; "Self reference @1$1."
- ;; (should
- ;; (string= "A1 = $0" (org-table-convert-refs-to-an "@1$1 = $0"))))
- (ert-deftest test-org-table/org-table-convert-refs-to-an/3 ()
- "Remote reference."
- (should
- (string= "C& = remote(FOO, @@#B&)" (org-table-convert-refs-to-an "$3 = remote(FOO, @@#$2)"))))
- (ert-deftest test-org-table/org-table-convert-refs-to-rc/1 ()
- "Simple reference @2$1."
- (should
- (string= "@2$1" (org-table-convert-refs-to-rc "A2"))))
- (ert-deftest test-org-table/org-table-convert-refs-to-rc/2 ()
- "Self reference $0."
- (should
- (string= "@1$1 = $0" (org-table-convert-refs-to-rc "A1 = $0"))))
- ;; TODO: Test Broken
- ;; (ert-deftest test-org-table/org-table-convert-refs-to-rc/3 ()
- ;; "Remote reference."
- ;; (should
- ;; (string= "$3 = remote(FOO, @@#$2)" (org-table-convert-refs-to-rc "C& = remote(FOO, @@#B&)"))))
- (ert-deftest test-org-table/remote-reference-access ()
- "Access to remote reference.
- See also `test-org-table/copy-field'."
- (org-test-table-target-expect
- "
- #+NAME: table
- | | x 42 | |
- | replace | replace |
- "
- "
- #+NAME: table
- | | x 42 | |
- | x 42 | 84 x |
- "
- 1 (concat "#+TBLFM: "
- ;; Copy text without calculation: Use Lisp formula
- "$1 = '(identity remote(table, @1$2)) :: "
- ;; Do a calculation: Use Calc (or Lisp ) formula
- "$2 = 2 * remote(table, @1$2)")))
- (ert-deftest test-org-table/remote-reference-indirect ()
- "Access to remote reference with indirection of name or ID."
- (let ((source-tables "
- #+NAME: 2012
- | amount |
- |--------|
- | 1 |
- | 2 |
- |--------|
- | 3 |
- #+TBLFM: @>$1 = vsum(@I..@II)
- #+NAME: 2013
- | amount |
- |--------|
- | 4 |
- | 8 |
- |--------|
- | 12 |
- #+TBLFM: @>$1 = vsum(@I..@II)
- "))
- ;; Read several remote references from same column
- (org-test-table-target-expect
- (concat source-tables "
- #+NAME: summary
- | year | amount |
- |-------+---------|
- | 2012 | replace |
- | 2013 | replace |
- |-------+---------|
- | total | replace |
- ")
- (concat source-tables "
- #+NAME: summary
- | year | amount |
- |-------+--------|
- | 2012 | 3 |
- | 2013 | 12 |
- |-------+--------|
- | total | 15 |
- ")
- 1
- ;; Calc formula
- "#+TBLFM: @<<$2..@>>$2 = remote($<, @>$1) :: @>$2 = vsum(@I..@II)"
- ;; Lisp formula
- (concat "#+TBLFM: @<<$2..@>>$2 = '(identity remote($<, @>$1)); N :: "
- "@>$2 = '(+ @I..@II); N"))
- ;; Read several remote references from same row
- (org-test-table-target-expect
- (concat source-tables "
- #+NAME: summary
- | year | 2012 | 2013 | total |
- |--------+---------+---------+---------|
- | amount | replace | replace | replace |
- ")
- (concat source-tables "
- #+NAME: summary
- | year | 2012 | 2013 | total |
- |--------+------+------+-------|
- | amount | 3 | 12 | 15 |
- ")
- 1
- ;; Calc formula
- "#+TBLFM: @2$<<..@2$>> = remote(@<, @>$1) :: @2$> = vsum($<<..$>>)"
- ;; Lisp formula
- (concat "#+TBLFM: @2$<<..@2$>> = '(identity remote(@<, @>$1)); N :: "
- "@2$> = '(+ $<<..$>>); N"))))
- (ert-deftest test-org-table/org-at-TBLFM-p ()
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (forward-line 2)
- (should (equal (org-at-TBLFM-p) nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (equal (org-at-TBLFM-p) t))
- (goto-char (point-min))
- (forward-line 4)
- (should (equal (org-at-TBLFM-p) nil))))
- (ert-deftest test-org-table/org-table-TBLFM-begin ()
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 1)
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 4)
- (should (= (org-table-TBLFM-begin)
- 14))
- ))
- (ert-deftest test-org-table/org-table-TBLFM-begin-for-multiple-TBLFM-lines ()
- "For multiple #+TBLFM lines."
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 1)
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 4)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 5)
- (should (= (org-table-TBLFM-begin)
- 14))
- ))
- (ert-deftest test-org-table/org-table-TBLFM-begin-for-pultiple-TBLFM-lines-blocks ()
- (org-test-with-temp-text-in-file
- "
- | 1 |
- | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- | 6 |
- | 7 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- "
- (goto-char (point-min))
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 1)
- (should (equal (org-table-TBLFM-begin)
- nil))
- (goto-char (point-min))
- (forward-line 3)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 4)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 5)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 6)
- (should (= (org-table-TBLFM-begin)
- 14))
- (goto-char (point-min))
- (forward-line 8)
- (should (= (org-table-TBLFM-begin)
- 61))
- (goto-char (point-min))
- (forward-line 9)
- (should (= (org-table-TBLFM-begin)
- 61))
- (goto-char (point-min))
- (forward-line 10)
- (should (= (org-table-TBLFM-begin)
- 61))))
- (ert-deftest test-org-table/org-table-calc-current-TBLFM ()
- (org-test-with-temp-text-in-file
- "
- | 1 | |
- | 2 | |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- #+TBLFM: $2=$1*3
- "
- (let ((got (progn (goto-char (point-min))
- (forward-line 3)
- (org-table-calc-current-TBLFM)
- (buffer-string)))
- (expect "
- | 1 | 1 |
- | 2 | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- #+TBLFM: $2=$1*3
- "))
- (should (string= got
- expect)))
- (let ((got (progn (goto-char (point-min))
- (forward-line 4)
- (org-table-calc-current-TBLFM)
- (buffer-string)))
- (expect "
- | 1 | 2 |
- | 2 | 4 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2
- #+TBLFM: $2=$1*3
- "))
- (should (string= got
- expect)))))
- (ert-deftest test-org-table/org-table-calc-current-TBLFM-when-stop-because-of-error ()
- "org-table-calc-current-TBLFM should preserve the input as it was."
- (org-test-with-temp-text-in-file
- "
- | 1 | 1 |
- | 2 | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2::$2=$1*2
- #+TBLFM: $2=$1*3
- "
- (let ((expect "
- | 1 | 1 |
- | 2 | 2 |
- #+TBLFM: $2=$1*1
- #+TBLFM: $2=$1*2::$2=$1*2
- #+TBLFM: $2=$1*3
- "))
- (goto-char (point-min))
- (forward-line 4)
- (should-error (org-table-calc-current-TBLFM))
- (setq got (buffer-string))
- (message "%s" got)
- (should (string= got
- expect)))))
- ;;; Tables as Lisp
- (ert-deftest test-org-table/to-lisp ()
- "Test `orgtbl-to-lisp' specifications."
- ;; 2x2 no header
- (should
- (equal '(("a" "b") ("c" "d"))
- (org-table-to-lisp "|a|b|\n|c|d|")))
- ;; 2x2 with 1-line header
- (should
- (equal '(("a" "b") hline ("c" "d"))
- (org-table-to-lisp "|a|b|\n|-\n|c|d|")))
- ;; 2x4 with 2-line header
- (should
- (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
- (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|")))
- ;; leading hlines do not get stripped
- (should
- (equal '(hline ("a" "b") hline ("c" "d"))
- (org-table-to-lisp "|-\n|a|b|\n|-\n|c|d|")))
- (should
- (equal '(hline ("a" "b") ("c" "d"))
- (org-table-to-lisp "|-\n|a|b|\n|c|d|")))
- (should
- (equal '(hline hline hline hline ("a" "b") ("c" "d"))
- (org-table-to-lisp "|-\n|-\n|-\n|-\n|a|b|\n|c|d|"))))
- (ert-deftest test-org-table/collapse-header ()
- "Test `orgtbl-to-lisp' specifications."
- ;; 2x2 no header - no collapsing
- (should
- (equal '(("a" "b") ("c" "d"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|c|d|"))))
- ;; 2x2 with 1-line header - no collapsing
- (should
- (equal '(("a" "b") hline ("c" "d"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|-\n|c|d|"))))
- ;; 2x4 with 2-line header - collapsed
- (should
- (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|"))))
- ;; 2x4 with 2-line header, custom glue - collapsed
- (should
- (equal '(("a.A" "b.B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") ".")))
- ;; 2x4 with 2-line header, threshold 1 - not collapsed
- (should
- (equal '(("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 1)))
- ;; 2x4 with 2-line header, threshold 2 - collapsed
- (should
- (equal '(("a A" "b B") hline ("c" "d") ("aa" "bb"))
- (org-table-collapse-header (org-table-to-lisp "|a|b|\n|A|B|\n|-\n|c|d|\n|aa|bb|") nil 2)))
- ;; 2x8 with 6-line header, default threshold 5 - not collapsed
- (should
- (equal '(("a" "b") ("A" "B") ("a" "b") ("A" "B") ("a" "b") ("A" "B") hline ("c" "d") ("aa" "bb"))
- (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|")))))
- ;;; Radio Tables
- (ert-deftest test-org-table/to-generic ()
- "Test `orgtbl-to-generic' specifications."
- ;; Test :hline parameter.
- (should
- (equal "a\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline nil))))
- (should
- (equal "a\n~\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline "~"))))
- ;; Test :sep parameter.
- (should
- (equal "a!b\nc!d"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:sep "!"))))
- ;; Test :hsep parameter.
- (should
- (equal "a!b\nc?d"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:sep "?" :hsep "!"))))
- ;; Test :tstart parameter.
- (should
- (equal "<begin>\na"
- (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tstart "<begin>"))))
- (should
- (equal "<begin>\na"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tstart (lambda () "<begin>")))))
- (should
- (equal "a"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tstart "<begin>" :splice t))))
- ;; Test :tend parameter.
- (should
- (equal "a\n<end>"
- (orgtbl-to-generic (org-table-to-lisp "| a |") '(:tend "<end>"))))
- (should
- (equal "a\n<end>"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tend (lambda () "<end>")))))
- (should
- (equal "a"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:tend "<end>" :splice t))))
- ;; Test :lstart parameter.
- (should
- (equal "> a"
- (orgtbl-to-generic
- (org-table-to-lisp "| a |") '(:lstart "> "))))
- (should
- (equal "> a"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:lstart (lambda () "> ")))))
- ;; Test :llstart parameter.
- (should
- (equal "> a\n>> b"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lstart "> " :llstart ">> "))))
- ;; Test :hlstart parameter.
- (should
- (equal "!> a\n> b"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lstart "> " :hlstart "!> "))))
- ;; Test :hllstart parameter.
- (should
- (equal "!> a\n!!> b\n> c"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
- '(:lstart "> " :hlstart "!> " :hllstart "!!> "))))
- ;; Test :lend parameter.
- (should
- (equal "a <"
- (orgtbl-to-generic (org-table-to-lisp "| a |") '(:lend " <"))))
- ;; Test :llend parameter.
- (should
- (equal "a <\nb <<"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lend " <" :llend " <<"))))
- ;; Test :hlend parameter.
- (should
- (equal "a <!\nb <"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:lend " <" :hlend " <!"))))
- ;; Test :hllend parameter.
- (should
- (equal "a <!\nb <!!\nc <"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n| b |\n|---|\n| c |")
- '(:lend " <" :hlend " <!" :hllend " <!!"))))
- ;; Test :lfmt parameter.
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:lfmt "%s!%s"))))
- (should
- (equal "a+b"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |")
- '(:lfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:lfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :llfmt parameter.
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:llfmt "%s!%s"))))
- (should
- (equal "a!b\nc+d"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n| c | d |")
- '(:lfmt "%s!%s" :llfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:llfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :hlfmt parameter.
- (should
- (equal "a!b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hlfmt "%s!%s"))))
- (should
- (equal "a+b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hlfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b\n>c d<"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hlfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :hllfmt parameter.
- (should
- (equal "a!b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hllfmt "%s!%s"))))
- (should
- (equal "a+b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hllfmt (lambda (c) (concat (car c) "+" (cadr c)))))))
- (should
- (equal "a!b\n>c d<"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hllfmt "%s!%s" :lstart ">" :lend "<" :sep " "))))
- ;; Test :fmt parameter.
- (should
- (equal ">a<\n>b<"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:fmt ">%s<"))))
- (should
- (equal ">a<b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:fmt (1 ">%s<" 2 (lambda (c) c))))))
- (should
- (equal "a b"
- (orgtbl-to-generic (org-table-to-lisp "| a | b |")
- '(:fmt (2 " %s")))))
- (should
- (equal ">a<"
- (orgtbl-to-generic (org-table-to-lisp "| a |")
- '(:fmt (lambda (c) (format ">%s<" c))))))
- ;; Test :hfmt parameter.
- (should
- (equal ">a<\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hfmt ">%s<"))))
- (should
- (equal ">a<b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hfmt (1 ">%s<" 2 identity)))))
- (should
- (equal "a b\ncd"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |")
- '(:hfmt (2 " %s")))))
- (should
- (equal ">a<\nb"
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hfmt (lambda (c) (format ">%s<" c))))))
- ;; Test :efmt parameter.
- (should
- (equal "2x10^3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
- '(:efmt "%sx10^%s"))))
- (should
- (equal "2x10^3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
- '(:efmt (lambda (m e) (concat m "x10^" e))))))
- (should
- (equal "2x10^3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |")
- '(:efmt (1 "%sx10^%s")))))
- (should
- (equal "2x10^3"
- (orgtbl-to-generic
- (org-table-to-lisp "| 2e3 |")
- '(:efmt (1 (lambda (m e) (format "%sx10^%s" m e)))))))
- (should
- (equal "2e3"
- (orgtbl-to-generic (org-table-to-lisp "| 2e3 |") '(:efmt nil))))
- ;; Test :skip parameter.
- (should
- (equal "cd"
- (orgtbl-to-generic
- (org-table-to-lisp "| \ | <c> |\n| a | b |\n|---+---|\n| c | d |")
- '(:skip 2))))
- ;; Test :skipcols parameter.
- (should
- (equal "a\nc"
- (orgtbl-to-generic
- (org-table-to-lisp "| a | b |\n| c | d |") '(:skipcols (2)))))
- (should
- (equal "a\nc"
- (orgtbl-to-generic
- (org-table-to-lisp
- "| / | <c> | <c> |\n| # | a | b |\n|---+---+---|\n| | c | d |")
- '(:skipcols (2)))))
- ;; Test :raw parameter.
- (when (featurep 'ox-latex)
- (should
- (string-match-p
- "/a/"
- (orgtbl-to-generic (org-table-to-lisp "| /a/ | b |")
- '(:backend latex :raw t)))))
- ;; Hooks are ignored.
- (should
- (equal
- "a\nb"
- (let* ((fun-list (list (lambda (backend) (search-forward "a") (insert "hook"))))
- (org-export-before-parsing-hook fun-list)
- (org-export-before-processing-hook fun-list))
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline nil)))))
- ;; User-defined export filters are ignored.
- (should
- (equal
- "a\nb"
- (let ((org-export-filter-table-cell-functions (list (lambda (c b i) "filter"))))
- (orgtbl-to-generic (org-table-to-lisp "| a |\n|---|\n| b |")
- '(:hline nil)))))
- ;; Macros, even if unknown, are returned as-is.
- (should
- (equal "{{{macro}}}"
- (orgtbl-to-generic (org-table-to-lisp "| {{{macro}}} |") nil))))
- (ert-deftest test-org-table/to-latex ()
- "Test `orgtbl-to-latex' specifications."
- (should
- (equal "\\begin{tabular}{l}\na\\\\\n\\end{tabular}"
- (orgtbl-to-latex (org-table-to-lisp "| a |") nil)))
- ;; Test :environment parameter.
- (should
- (equal "\\begin{tabularx}{l}\na\\\\\n\\end{tabularx}"
- (orgtbl-to-latex (org-table-to-lisp "| a |")
- '(:environment "tabularx"))))
- ;; Test :booktabs parameter.
- (should
- (string-match-p
- "\\toprule" (orgtbl-to-latex (org-table-to-lisp "| a |") '(:booktabs t))))
- ;; Handle LaTeX snippets.
- (should
- (equal "\\begin{tabular}{l}\n\\(x\\)\\\\\n\\end{tabular}"
- (orgtbl-to-latex (org-table-to-lisp "| $x$ |") nil)))
- ;; Test pseudo objects and :raw parameter.
- (should
- (string-match-p
- "\\$x\\$" (orgtbl-to-latex (org-table-to-lisp "| $x$ |") '(:raw t)))))
- (ert-deftest test-org-table/to-html ()
- "Test `orgtbl-to-html' specifications."
- (should
- (equal (orgtbl-to-html (org-table-to-lisp "| a |") nil)
- "<table border=\"2\" cellspacing=\"0\" cellpadding=\"6\" rules=\"groups\" frame=\"hsides\">
- <colgroup>
- <col class=\"org-left\" />
- </colgroup>
- <tbody>
- <tr>
- <td class=\"org-left\">a</td>
- </tr>
- </tbody>
- </table>"))
- ;; Test :attributes parameter.
- (should
- (string-match-p
- "<table>"
- (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes nil))))
- (should
- (string-match-p
- "<table border=\"2\">"
- (orgtbl-to-html (org-table-to-lisp "| a |") '(:attributes (:border "2"))))))
- (ert-deftest test-org-table/to-texinfo ()
- "Test `orgtbl-to-texinfo' specifications."
- (should
- (equal "@multitable {a}\n@item a\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a |") nil)))
- ;; Test :columns parameter.
- (should
- (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
- '(:columns ".4 .6"))))
- (should
- (equal "@multitable @columnfractions .4 .6\n@item a\n@tab b\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
- '(:columns "@columnfractions .4 .6"))))
- (should
- (equal "@multitable {xxx} {xx}\n@item a\n@tab b\n@end multitable"
- (orgtbl-to-texinfo (org-table-to-lisp "| a | b |")
- '(:columns "{xxx} {xx}")))))
- (ert-deftest test-org-table/to-orgtbl ()
- "Test `orgtbl-to-orgtbl' specifications."
- (should
- (equal "| a | b |\n|---+---|\n| c | d |"
- (orgtbl-to-orgtbl
- (org-table-to-lisp "| a | b |\n|---+---|\n| c | d |") nil))))
- (ert-deftest test-org-table/to-unicode ()
- "Test `orgtbl-to-unicode' specifications."
- (should
- (equal "━━━\n a \n━━━"
- (orgtbl-to-unicode (org-table-to-lisp "| a |") nil)))
- ;; Test :narrow parameter.
- (should
- (equal "━━━━\n => \n━━━━"
- (orgtbl-to-unicode (org-table-to-lisp "| <2> |\n| xxx |")
- '(:narrow t)))))
- (ert-deftest test-org-table/send-region ()
- "Test `orgtbl-send-table' specifications."
- ;; Error when not at a table.
- (should-error
- (org-test-with-temp-text "Paragraph"
- (orgtbl-send-table)))
- ;; Error when destination is missing.
- (should-error
- (org-test-with-temp-text "#+ORGTBL: SEND\n<point>| a |"
- (orgtbl-send-table)))
- ;; Error when transformation function is not specified.
- (should-error
- (org-test-with-temp-text "
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table
- #+ORGTBL: SEND table
- <point>| a |"
- (orgtbl-send-table)))
- ;; Standard test.
- (should
- (equal "| a |\n|---|\n| b |\n"
- (org-test-with-temp-text "
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table
- #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
- <point>| a |\n|---|\n| b |"
- (orgtbl-send-table)
- (goto-char (point-min))
- (buffer-substring-no-properties
- (search-forward "# BEGIN RECEIVE ORGTBL table\n")
- (progn (search-forward "# END RECEIVE ORGTBL table")
- (match-beginning 0))))))
- ;; Allow multiple receiver locations.
- (should
- (org-test-with-temp-text "
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table
- #+ORGTBL: SEND table orgtbl-to-orgtbl :hlines nil
- <point>| a |
- # BEGIN RECEIVE ORGTBL table
- # END RECEIVE ORGTBL table"
- (orgtbl-send-table)
- (goto-char (point-min))
- (search-forward "| a |" nil t 3))))
- ;;; Align
- (ert-deftest test-org-table/align ()
- "Test `org-table-align' specifications."
- ;; Regular test.
- (should
- (equal "| a |\n"
- (org-test-with-temp-text "| a |"
- (org-table-align)
- (buffer-string))))
- ;; Preserve alignment.
- (should
- (equal " | a |\n"
- (org-test-with-temp-text " | a |"
- (org-table-align)
- (buffer-string))))
- ;; Handle horizontal lines.
- (should
- (equal "| 123 |\n|-----|\n"
- (org-test-with-temp-text "| 123 |\n|-|"
- (org-table-align)
- (buffer-string))))
- (should
- (equal "| a | b |\n|---+---|\n"
- (org-test-with-temp-text "| a | b |\n|-+-|"
- (org-table-align)
- (buffer-string))))
- ;; Handle empty fields.
- (should
- (equal "| a | bc |\n| bcd | |\n"
- (org-test-with-temp-text "| a | bc |\n| bcd | |"
- (org-table-align)
- (buffer-string))))
- (should
- (equal "| abc | bc |\n| | bcd |\n"
- (org-test-with-temp-text "| abc | bc |\n| | bcd |"
- (org-table-align)
- (buffer-string))))
- ;; Handle missing fields.
- (should
- (equal "| a | b |\n| c | |\n"
- (org-test-with-temp-text "| a | b |\n| c |"
- (org-table-align)
- (buffer-string))))
- (should
- (equal "| a | b |\n|---+---|\n"
- (org-test-with-temp-text "| a | b |\n|---|"
- (org-table-align)
- (buffer-string))))
- ;; Alignment is done to the right when the ratio of numbers in the
- ;; column is superior to `org-table-number-fraction'.
- (should
- (equal "| 1 |\n| 12 |\n| abc |"
- (org-test-with-temp-text "| 1 |\n| 12 |\n| abc |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- (should
- (equal "| 1 |\n| ab |\n| abc |"
- (org-test-with-temp-text "| 1 |\n| ab |\n| abc |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- ;; Obey to alignment cookies.
- (should
- (equal "| <r> |\n| ab |\n| abc |"
- (org-test-with-temp-text "| <r> |\n| ab |\n| abc |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- (should
- (equal "| <l> |\n| 12 |\n| 123 |"
- (org-test-with-temp-text "| <l> |\n| 12 |\n| 123 |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- (should
- (equal "| <c> |\n| 1 |\n| 123 |"
- (org-test-with-temp-text "| <c> |\n| 1 |\n| 123 |"
- (let ((org-table-number-fraction 0.5)) (org-table-align))
- (buffer-string))))
- ;; Handle gracefully tables with only horizontal rules.
- (should
- (org-test-with-temp-text "|-<point>--|"
- (org-table-align)
- t))
- (should
- (org-test-with-temp-text "|-<point>--|---------|\n|---|---|-----|"
- (org-table-align)
- t)))
- (ert-deftest test-org-table/align-buffer-tables ()
- "Align all tables when updating buffer."
- (let ((before "
- | a b |
- | c d |
- ")
- (after "
- | a b |
- | c d |
- "))
- (should (equal (org-test-with-temp-text before
- (org-table-recalculate-buffer-tables)
- (buffer-string))
- after))
- (should (equal (org-test-with-temp-text before
- (org-table-iterate-buffer-tables)
- (buffer-string))
- after))))
- ;;; Sorting
- (ert-deftest test-org-table/sort-lines ()
- "Test `org-table-sort-lines' specifications."
- ;; Sort numerically.
- (should
- (equal "| 1 | 2 |\n| 2 | 4 |\n| 5 | 3 |\n"
- (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
- (org-table-sort-lines nil ?n)
- (buffer-string))))
- (should
- (equal "| 5 | 3 |\n| 2 | 4 |\n| 1 | 2 |\n"
- (org-test-with-temp-text "| <point>1 | 2 |\n| 5 | 3 |\n| 2 | 4 |\n"
- (org-table-sort-lines nil ?N)
- (buffer-string))))
- ;; Sort alphabetically. Enforce the C locale for consistent results.
- (let ((original-string-collate-lessp (symbol-function 'string-collate-lessp)))
- (cl-letf (((symbol-function 'string-collate-lessp)
- (lambda (s1 s2 &optional locale ignore-case)
- (funcall original-string-collate-lessp
- s1 s2 "C" ignore-case))))
- (should
- (equal "| a | x |\n| B | 4 |\n| c | 3 |\n"
- (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
- (org-table-sort-lines nil ?a)
- (buffer-string))))
- (should
- (equal "| c | 3 |\n| B | 4 |\n| a | x |\n"
- (org-test-with-temp-text "| <point>a | x |\n| c | 3 |\n| B | 4 |\n"
- (org-table-sort-lines nil ?A)
- (buffer-string))))
- ;; Sort alphabetically with case.
- (should
- (equal "| C |\n| a |\n| b |\n"
- (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
- (org-table-sort-lines t ?a)
- (buffer-string))))
- (should
- (equal "| C |\n| b |\n| a |\n"
- (org-test-with-temp-text "| <point>a |\n| C |\n| b |\n"
- (org-table-sort-lines nil ?A)
- (buffer-string))))))
- ;; Sort by time (timestamps)
- (should
- (equal
- "| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n| <2014-03-04 tue.> |\n"
- (org-test-with-temp-text
- "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
- (org-table-sort-lines nil ?t)
- (buffer-string))))
- (should
- (equal
- "| <2014-03-04 tue.> |\n| <2012-03-29 thu.> |\n| <2008-08-08 sat.> |\n"
- (org-test-with-temp-text
- "| <2014-03-04 tue.> |\n| <2008-08-08 sat.> |\n| <2012-03-29 thu.> |\n"
- (org-table-sort-lines nil ?T)
- (buffer-string))))
- ;; Sort by time (HH:MM values)
- (should
- (equal "| 1:00 |\n| 17:00 |\n| 114:00 |\n"
- (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
- (org-table-sort-lines nil ?t)
- (buffer-string))))
- (should
- (equal "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
- (org-test-with-temp-text "| 114:00 |\n| 17:00 |\n| 1:00 |\n"
- (org-table-sort-lines nil ?T)
- (buffer-string))))
- ;; Sort by time (durations)
- (should
- (equal "| 1d 3:00 |\n| 28:00 |\n"
- (org-test-with-temp-text "| 28:00 |\n| 1d 3:00 |\n"
- (org-table-sort-lines nil ?t)
- (buffer-string))))
- ;; Sort with custom functions.
- (should
- (equal "| 22 |\n| 15 |\n| 18 |\n"
- (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
- (org-table-sort-lines nil ?f
- (lambda (s) (% (string-to-number s) 10))
- #'<)
- (buffer-string))))
- (should
- (equal "| 18 |\n| 15 |\n| 22 |\n"
- (org-test-with-temp-text "| 15 |\n| 22 |\n| 18 |\n"
- (org-table-sort-lines nil ?F
- (lambda (s) (% (string-to-number s) 10))
- #'<)
- (buffer-string))))
- ;; Sort according to current column.
- (should
- (equal "| 1 | 2 |\n| 7 | 3 |\n| 5 | 4 |\n"
- (org-test-with-temp-text "| 1 | <point>2 |\n| 5 | 4 |\n| 7 | 3 |\n"
- (org-table-sort-lines nil ?n)
- (buffer-string))))
- ;; Sort between horizontal separators if possible.
- (should
- (equal
- "| 9 | 8 |\n|---+---|\n| 5 | 3 |\n| 7 | 4 |\n|---+---|\n| 1 | 2 |\n"
- (org-test-with-temp-text
- "| 9 | 8 |\n|---+---|\n| <point>7 | 4 |\n| 5 | 3 |\n|---+---|\n| 1 | 2 |\n"
- (org-table-sort-lines nil ?n)
- (buffer-string)))))
- ;;; Formulas
- (ert-deftest test-org-table/eval-formula ()
- "Test `org-table-eval-formula' specifications."
- ;; Error when not on a table field.
- (should-error
- (org-test-with-temp-text "Text"
- (org-table-eval-formula)))
- (should-error
- (org-test-with-temp-text "| a |\n|---|<point>"
- (org-table-eval-formula)))
- (should-error
- (org-test-with-temp-text "| a |\n#+TBLFM:<point>"
- (org-table-eval-formula)))
- ;; Handle @<, @>, $< and $>.
- (should
- (equal "| 1 |\n| 1 |"
- (org-test-with-temp-text "| <point> |\n| 1 |"
- (org-table-eval-formula nil "@>" nil nil t)
- (buffer-string))))
- (should
- (equal "| 1 |\n| 1 |"
- (org-test-with-temp-text "| 1 |\n| <point> |"
- (org-table-eval-formula nil "@<" nil nil t)
- (buffer-string))))
- (should
- (equal "| 1 | 1 |"
- (org-test-with-temp-text "| <point> | 1 |"
- (org-table-eval-formula nil "$>" nil nil t)
- (buffer-string))))
- (should
- (equal "| 1 | 1 |"
- (org-test-with-temp-text "| 1 | <point> |"
- (org-table-eval-formula nil "$<" nil nil t)
- (buffer-string)))))
- (ert-deftest test-org-table/field-formula-outside-table ()
- "Test `org-table-formula-create-columns' variable."
- ;; Refuse to create column if variable is nil.
- (should-error
- (org-test-with-temp-text "
- | 2 |
- | 4 |
- | 8 |
- <point>#+TBLFM: @1$2=5"
- (let ((org-table-formula-create-columns nil))
- (org-table-calc-current-TBLFM))
- (buffer-string))
- :type (list 'error 'user-error))
- ;; If the variable is non-nil, field formulas and columns formulas
- ;; can create tables.
- (should
- (equal
- "
- | 2 | 5 |
- | 4 | |
- | 8 | |
- #+TBLFM: @1$2=5"
- (org-test-with-temp-text "
- | 2 |
- | 4 |
- | 8 |
- <point>#+TBLFM: @1$2=5"
- (let ((org-table-formula-create-columns t))
- (org-table-calc-current-TBLFM))
- (buffer-string))))
- (should
- (equal
- "
- | 2 | | 15 |
- | 4 | | 15 |
- | 8 | | 15 |
- #+TBLFM: $3=15"
- (org-test-with-temp-text "
- | 2 |
- | 4 |
- | 8 |
- <point>#+TBLFM: $3=15"
- (let ((org-table-formula-create-columns t))
- (org-table-calc-current-TBLFM))
- (buffer-string)))))
- (ert-deftest test-org-table/duration ()
- "Test durations in table formulas."
- ;; Durations in cells.
- (should
- (string-match "| 2:12 | 1:47 | 03:59:00 |"
- (org-test-with-temp-text "
- | 2:12 | 1:47 | |
- <point>#+TBLFM: @1$3=$1+$2;T"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match "| 2:12 | 1:47 | 03:59 |"
- (org-test-with-temp-text "
- | 2:12 | 1:47 | |
- <point>#+TBLFM: @1$3=$1+$2;U"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match "| 3:02:20 | -2:07:00 | 0.92 |"
- (org-test-with-temp-text "
- | 3:02:20 | -2:07:00 | |
- <point>#+TBLFM: @1$3=$1+$2;t"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- ;; Durations set through properties.
- (should
- (string-match "| 16:00:00 |"
- (org-test-with-temp-text "* H
- :PROPERTIES:
- :time_constant: 08:00:00
- :END:
- | |
- <point>#+TBLFM: $1=2*$PROP_time_constant;T"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match "| 16.00 |"
- (org-test-with-temp-text "* H
- :PROPERTIES:
- :time_constant: 08:00:00
- :END:
- | |
- <point>#+TBLFM: $1=2*$PROP_time_constant;t"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/end-on-hline ()
- "Test with a table ending on a hline."
- (should
- (equal
- (org-test-with-temp-text
- "
- | 1 | 2 | 3 |
- | 4 | 5 | 6 |
- | | | |
- |---+---+---|
- <point>#+TBLFM: @3$2..@3$>=vsum(@1..@2)"
- (org-table-calc-current-TBLFM)
- (buffer-string))
- "
- | 1 | 2 | 3 |
- | 4 | 5 | 6 |
- | | 7 | 9 |
- |---+---+---|
- #+TBLFM: @3$2..@3$>=vsum(@1..@2)")))
- (ert-deftest test-org-table/named-field ()
- "Test formula with a named field."
- (should
- (string-match-p
- "| +| +1 +|"
- (org-test-with-temp-text "
- | | |
- | ^ | name |
- <point>#+TBLFM: $name=1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match-p
- "| +| +1 +|"
- (org-test-with-temp-text "
- | _ | name |
- | | |
- <point>#+TBLFM: $name=1"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/named-column ()
- "Test formula with a named field."
- (should
- (string-match-p
- "| +| +1 +| +1 +|"
- (org-test-with-temp-text "
- | ! | name | |
- | | 1 | |
- <point>#+TBLFM: @2$3=$name"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/formula-priority ()
- "Test field formula priority over column formula."
- ;; Field formulas bind stronger than column formulas.
- (should
- (equal
- "| 1 | 3 |\n| 2 | 99 |\n"
- (org-test-with-temp-text
- "| 1 | |\n| 2 | |\n<point>#+tblfm: $2=3*$1::@2$2=99"
- (org-table-calc-current-TBLFM)
- (buffer-substring-no-properties (point-min) (point)))))
- ;; When field formula is removed, table formulas is applied again.
- (should
- (equal
- "| 1 | 3 |\n| 2 | 6 |\n"
- (org-test-with-temp-text
- "| 1 | |\n| 2 | |\n#+tblfm: $2=3*$1<point>::@2$2=99"
- (org-table-calc-current-TBLFM)
- (delete-region (point) (line-end-position))
- (org-table-calc-current-TBLFM)
- (buffer-substring-no-properties (point-min) (line-beginning-position))))))
- (ert-deftest test-org-table/tab-indent ()
- "Test named fields with tab indentation."
- (should
- (string-match-p
- "| # | 111 |"
- (org-test-with-temp-text
- "
- | ! | sum | | a | b | c |
- |---+------+------+---+----+-----|
- | # | 1011 | 1000 | 1 | 10 | 100 |
- <point>#+TBLFM: $2=$a+$b+$c
- "
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/first-rc ()
- "Test \"$<\" and \"@<\" constructs in formulas."
- (should
- (string-match-p
- "| 1 | 2 |"
- (org-test-with-temp-text
- "| | 2 |
- <point>#+TBLFM: $<=1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match-p
- "| 2 |\n| 2 |"
- (org-test-with-temp-text
- "| 2 |\n| |
- <point>#+TBLFM: @2$1=@<"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/last-rc ()
- "Test \"$>\" and \"@>\" constructs in formulas."
- (should
- (string-match-p
- "| 2 | 1 |"
- (org-test-with-temp-text
- "| 2 | |\n<point>#+TBLFM: $>=1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (string-match-p
- "| 2 |\n| 2 |"
- (org-test-with-temp-text
- "| 2 |\n| |\n<point>#+TBLFM: @>$1=@<"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/time-stamps ()
- "Test time-stamps handling."
- ;; Standard test.
- (should
- (string-match-p
- "| 1 |"
- (org-test-with-temp-text
- "| <2016-07-07 Sun> | <2016-07-08 Fri> | |\n<point>#+TBLFM: $3=$2-$1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- ;; Handle locale specific time-stamps.
- (should
- (string-match-p
- "| 1 |"
- (org-test-with-temp-text
- "| <2016-07-07 Do> | <2016-07-08 Fr> | |\n<point>#+TBLFM: $3=$2-$1"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- (ert-deftest test-org-table/orgtbl-ascii-draw ()
- "Test `orgtbl-ascii-draw'."
- ;; First value: Make sure that an integer input value is converted to a
- ;; float before division. Further values: Show some float input value
- ;; ranges corresponding to the same bar width.
- (should
- (equal
- (org-test-with-temp-text
- "
- | Value | <l> |
- |----------+---------|
- | 19 | replace |
- |----------+---------|
- | -0.50001 | replace |
- | -0.49999 | replace |
- | 0.49999 | replace |
- | 0.50001 | replace |
- | 1.49999 | replace |
- | 22.50001 | replace |
- | 23.49999 | replace |
- | 23.50001 | replace |
- | 24.49999 | replace |
- | 24.50001 | replace |
- <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"
- (org-table-calc-current-TBLFM)
- (buffer-string))
- "
- | Value | <l> |
- |----------+-----------|
- | 19 | 883 |
- |----------+-----------|
- | -0.50001 | too small |
- | -0.49999 | |
- | 0.49999 | |
- | 0.50001 | 1 |
- | 1.49999 | 1 |
- | 22.50001 | 887 |
- | 23.49999 | 887 |
- | 23.50001 | 888 |
- | 24.49999 | 888 |
- | 24.50001 | too large |
- #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 24 3 \" 12345678\")"))
- ;; Draw bars with a bullet. The bullet does not count in the parameter
- ;; WIDTH of `orgtbl-ascii-draw'.
- (should
- (equal
- (org-test-with-temp-text
- "
- | -1 | replace |
- | 0 | replace |
- | 1 | replace |
- | 2 | replace |
- | 3 | replace |
- | 4 | replace |
- <point>#+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")"
- (org-table-calc-current-TBLFM)
- (buffer-string))
- "
- | -1 | too small |
- | 0 | $ |
- | 1 | -$ |
- | 2 | --$ |
- | 3 | ---$ |
- | 4 | too large |
- #+TBLFM: $2 = '(orgtbl-ascii-draw $1 0 3 3 \"$-\")")))
- (ert-deftest test-org-table/single-rowgroup ()
- "Test column formula in a table with a single rowgroup."
- (should
- (equal
- "
- |---+---|
- | 1 | 0 |
- |---+---|
- #+TBLFM: $2=$1-1"
- (org-test-with-temp-text "
- |---+---|
- | 1 | |
- |---+---|
- <point>#+TBLFM: $2=$1-1"
- (org-table-calc-current-TBLFM)
- (buffer-string))))
- (should
- (equal
- "
- | 1 | 0 |
- #+TBLFM: $2=$1-1"
- (org-test-with-temp-text "
- | 1 | |
- <point>#+TBLFM: $2=$1-1"
- (org-table-calc-current-TBLFM)
- (buffer-string)))))
- ;;; Navigation
- (ert-deftest test-org-table/next-field ()
- "Test `org-table-next-field' specifications."
- ;; Regular test.
- (should
- (equal
- "b"
- (org-test-with-temp-text "| a<point> | b |"
- (org-table-next-field)
- (org-trim (org-table-get-field)))))
- ;; Create new rows as needed.
- (should
- (equal
- "| a |\n| |\n"
- (org-test-with-temp-text "| a<point> |"
- (org-table-next-field)
- (buffer-string))))
- ;; Jump over hlines, if `org-table-tab-jumps-over-hlines' is
- ;; non-nil.
- (should
- (equal
- "b"
- (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
- (let ((org-table-tab-jumps-over-hlines t)) (org-table-next-field))
- (org-trim (org-table-get-field)))))
- ;; If `org-table-tab-jumps-over-hlines' is nil, however, create
- ;; a new row before the rule.
- (should
- (equal
- "| a |\n| |\n|---|\n| b |"
- (org-test-with-temp-text "| a<point> |\n|---|\n| b |"
- (let ((org-table-tab-jumps-over-hlines nil)) (org-table-next-field))
- (buffer-string)))))
- (ert-deftest test-org-table/previous-field ()
- "Test `org-table-previous-field' specifications."
- ;; Regular tests.
- (should
- (eq ?a
- (org-test-with-temp-text "| a | <point>b |"
- (org-table-previous-field)
- (char-after))))
- (should
- (eq ?a
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-previous-field)
- (char-after))))
- ;; Find previous field across horizontal rules.
- (should
- (eq ?a
- (org-test-with-temp-text "| a |\n|---|\n| <point>b |"
- (org-table-previous-field)
- (char-after))))
- ;; When called on a horizontal rule, find previous data field.
- (should
- (eq ?b
- (org-test-with-temp-text "| a | b |\n|---+-<point>--|"
- (org-table-previous-field)
- (char-after))))
- ;; Error when at first field. Make sure to preserve original
- ;; position.
- (should-error
- (org-test-with-temp-text "| <point> a|"
- (org-table-previous-field)))
- (should-error
- (org-test-with-temp-text "|---|\n| <point>a |"
- (org-table-previous-field)))
- (should
- (eq ?a
- (org-test-with-temp-text "|---|\n| <point>a |"
- (ignore-errors (org-table-previous-field))
- (char-after)))))
- ;;; Deleting columns
- (ert-deftest test-org-table/delete-column ()
- "Test `org-table-delete-column'."
- ;; Error when outside a table.
- (should-error
- (org-test-with-temp-text "Paragraph"
- (org-table-delete-column)))
- ;; Delete first column.
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| <point> | a |\n"
- (org-table-delete-column)
- (buffer-string))))
- ;; Delete column and check location of point.
- (should
- (= 2
- (org-test-with-temp-text
- "| a | <point>b | c |"
- (org-table-delete-column)
- (org-table-current-column))))
- ;; Delete column when at end of line and after a "|".
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| a | b |<point>\n"
- (org-table-delete-column)
- (buffer-string))))
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| a | b | <point>\n"
- (org-table-delete-column)
- (buffer-string))))
- ;; Delete two columns starting with the last column.
- (should
- (equal "| a |\n"
- (org-test-with-temp-text
- "| a | b | c<point> |"
- (org-table-delete-column)
- (org-table-delete-column)
- (buffer-string)))))
- ;;; Inserting rows, inserting columns
- (ert-deftest test-org-table/insert-column ()
- "Test `org-table-insert-column' specifications."
- ;; Error when outside a table.
- (should-error
- (org-test-with-temp-text "Paragraph"
- (org-table-insert-column)))
- ;; Insert new column after current one.
- (should
- (equal "| | a |\n"
- (org-test-with-temp-text "| a |"
- (org-table-insert-column)
- (buffer-string))))
- (should
- (equal "| | a | b |\n"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-insert-column)
- (buffer-string))))
- ;; Move point into the newly created column.
- (should
- (equal " | a |"
- (org-test-with-temp-text "| <point>a |"
- (org-table-insert-column)
- (buffer-substring-no-properties (point) (line-end-position)))))
- (should
- (equal " | a | b |"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-insert-column)
- (buffer-substring-no-properties (point) (line-end-position)))))
- ;; Handle missing vertical bar in the last column.
- (should
- (equal "| | a |\n"
- (org-test-with-temp-text "| a"
- (org-table-insert-column)
- (buffer-string))))
- (should
- (equal " | a |"
- (org-test-with-temp-text "| <point>a"
- (org-table-insert-column)
- (buffer-substring-no-properties (point) (line-end-position)))))
- ;; Handle column insertion when point is before first column.
- (should
- (equal " | | a |\n"
- (org-test-with-temp-text " | a |"
- (org-table-insert-column)
- (buffer-string))))
- (should
- (equal " | | a | b |\n"
- (org-test-with-temp-text " | a | b |"
- (org-table-insert-column)
- (buffer-string)))))
- (ert-deftest test-org-table/insert-column-with-formula ()
- "Test `org-table-insert-column' with a formula in place."
- (should
- (equal "| | 1 | 1 | 2 |
- #+TBLFM: $4=$2+$3"
- (org-test-with-temp-text
- "| 1<point> | 1 | 2 |
- #+TBLFM: $3=$1+$2"
- (org-table-insert-column)
- (buffer-substring-no-properties (point-min) (point-max))))))
- ;;; Moving single cells
- (ert-deftest test-org-table/move-cell-down ()
- "Test `org-table-move-cell-down' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last row of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a | <point>b |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a | b |\n| <point>c | d |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| a | b |\n| c | <point>d |\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-down)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-down)))
- ;; Check for correct cell movement
- (should (equal (concat "| c | b |\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b |\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "| c | b |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b |\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "| e | d |\n"
- "| c | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| <point>c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "| c | f |\n"
- "| e | b |\n")
- (org-test-with-temp-text
- (concat "| a |<point> b |\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (org-table-move-cell-down)
- (buffer-string))))
- ;; Check for correct handling of hlines which should not change
- ;; position on single cell moves.
- (should (equal (concat "| c | b |\n"
- "|---+---|\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | b |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (org-table-move-cell-down)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | <point>d |\n"
- "| e | f |\n")
- (org-table-move-cell-down)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | d |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | b |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | f |")
- (org-table-move-cell-down)
- (org-table-move-cell-down)
- (buffer-string)))))
- (ert-deftest test-org-table/move-cell-up ()
- "Test `org-table-move-cell-up' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last row of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| <point>a | b |\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-up)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-up)))
- ;; Check for correct cell movement.
- (should (equal (concat "| c | b |\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| <point>c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | d |\n"
- "| c | b |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| c | <point>d |\n"
- "| e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "| e | d |\n"
- "| c | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| c | d |\n"
- "| <point>e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | f |\n"
- "| c | b |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "| c | d |\n"
- "| e |<point> f |\n")
- (org-table-move-cell-up)
- (org-table-move-cell-up)
- (buffer-string))))
- ;; Check for correct handling of hlines which should not change
- ;; position on single cell moves.
- (should (equal (concat "| c | b |\n"
- "|---+---|\n"
- "| a | d |\n"
- "| e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| <point>c | d |\n"
- "| e | f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | f |\n"
- "|---+---|\n"
- "| c | b |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | <point>f |\n")
- (org-table-move-cell-up)
- (org-table-move-cell-up)
- (buffer-string))))
- (should (equal (concat "| a | b |\n"
- "|---+---|\n"
- "| c | f |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | <point>f |\n")
- (org-table-move-cell-up)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | f |\n"
- "|---+---|\n"
- "| c | b |\n"
- "| e | d |\n")
- (org-test-with-temp-text
- (concat "| a | b |\n"
- "|---+---|\n"
- "| c | d |\n"
- "| e | <point>f |")
- (org-table-move-cell-up)
- (org-table-move-cell-up)
- (buffer-string)))))
- (ert-deftest test-org-table/move-cell-right ()
- "Test `org-table-move-cell-right' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last col of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n| b |\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| a | <point>b |\n| c | d |\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-right)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-right)))
- ;; Check for correct cell movement.
- (should (equal (concat "| b | a | c |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b | c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| b | c | a |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| <point>a | b | c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-right)
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| e | f | d |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| <point> d | e | f |\n")
- (org-table-move-cell-right)
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| d | f | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| d | <point>e | f |\n")
- (org-table-move-cell-right)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| e | f | d |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| <point>d | e | f |\n")
- (org-table-move-cell-right)
- (org-table-move-cell-right)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| e | d | f |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| <point>d | e | f |")
- (org-table-move-cell-right)
- (buffer-string)))))
- (ert-deftest test-org-table/move-cell-left ()
- "Test `org-table-move-cell-left' specifications."
- ;; Error out when cell cannot be moved due to not in table, in the
- ;; last col of the table, or is on a hline.
- (should-error
- (org-test-with-temp-text "not in\na table\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n| b |\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| <point>a | b |\n| c | d |\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "| <point>a |\n|---|\n"
- (org-table-move-cell-left)))
- (should-error
- (org-test-with-temp-text "|<point>---|\n| a |\n"
- (org-table-move-cell-left)))
- ;; Check for correct cell movement.
- (should (equal (concat "| b | a | c |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| a | <point>b | c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| c | a | b |\n"
- "| d | e | f |\n")
- (org-test-with-temp-text
- (concat "| a | b | <point>c |\n"
- "| d | e | f |\n")
- (org-table-move-cell-left)
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| f | d | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| d | e | <point>f |\n")
- (org-table-move-cell-left)
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "| d | f | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "| d | e | <point>f |\n")
- (org-table-move-cell-left)
- (buffer-string))))
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| f | d | e |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| d | e | <point>f |\n")
- (org-table-move-cell-left)
- (org-table-move-cell-left)
- (buffer-string))))
- ;; Move single cell even without a final newline.
- (should (equal (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| e | d | f |\n")
- (org-test-with-temp-text
- (concat "| a | b | c |\n"
- "|---+---+---|\n"
- "| d | <point>e | f |")
- (org-table-move-cell-left)
- (buffer-string)))))
- ;;; Moving rows, moving columns
- (ert-deftest test-org-table/move-row-down ()
- "Test `org-table-move-row-down' specifications."
- ;; Error out when row cannot be moved, e.g., it is the last row in
- ;; the table.
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-row-down)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-row-down)))
- (should-error
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-move-row-down)))
- ;; Move data lines.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| b |\n"
- (org-table-move-row-down)
- (buffer-string))))
- (should
- (equal "|---|\n| a |\n"
- (org-test-with-temp-text "| a |\n|---|\n"
- (org-table-move-row-down)
- (buffer-string))))
- ;; Move hlines.
- (should
- (equal "| b |\n|---|\n"
- (org-test-with-temp-text "|---|\n| b |\n"
- (org-table-move-row-down)
- (buffer-string))))
- (should
- (equal "|---|\n|---|\n"
- (org-test-with-temp-text "|---|\n|---|\n"
- (org-table-move-row-down)
- (buffer-string))))
- ;; Move rows even without a final newline.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| b |"
- (org-table-move-row-down)
- (buffer-string)))))
- (ert-deftest test-org-table/move-row-up ()
- "Test `org-table-move-row-up' specifications."
- ;; Error out when row cannot be moved, e.g., it is the first row in
- ;; the table.
- (should-error
- (org-test-with-temp-text "| a |"
- (org-table-move-row-up)))
- (should-error
- (org-test-with-temp-text "| a |\n"
- (org-table-move-row-up)))
- ;; Move data lines.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| <point>b |\n"
- (org-table-move-row-up)
- (buffer-string))))
- (should
- (equal "| b |\n|---|\n"
- (org-test-with-temp-text "|---|\n| <point>b |\n"
- (org-table-move-row-up)
- (buffer-string))))
- ;; Move hlines.
- (should
- (equal "|---|\n| a |\n"
- (org-test-with-temp-text "| a |\n|<point>---|\n"
- (org-table-move-row-up)
- (buffer-string))))
- (should
- (equal "|---|\n|---|\n"
- (org-test-with-temp-text "|---|\n|<point>---|\n"
- (org-table-move-row-up)
- (buffer-string))))
- ;; Move rows even without a final newline.
- (should
- (equal "| b |\n| a |\n"
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-move-row-up)
- (buffer-string)))))
- ;;; Shrunk columns
- (ert-deftest test-org-table/toggle-column-width ()
- "Test `org-table-toggle-columns-width' specifications."
- ;; Error when not at a column.
- (should-error
- (org-test-with-temp-text "<point>a"
- (org-table-toggle-column-width)))
- ;; A shrunk column is overlaid with
- ;; `org-table-shrunk-column-indicator'.
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (overlay-get (car (overlays-at (point))) 'display))))
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| a |\n|-<point>--|"
- (org-table-toggle-column-width)
- (overlay-get (car (overlays-at (point))) 'display))))
- ;; Shrink every field in the same column.
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| a |\n|-<point>--|"
- (org-table-toggle-column-width)
- (overlay-get (car (overlays-at (1+ (line-beginning-position 0))))
- 'display))))
- ;; When column is already shrunk, expand it, i.e., remove overlays.
- (should-not
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-toggle-column-width)
- (overlays-in (point-min) (point-max))))
- (should-not
- (org-test-with-temp-text "| a |\n| <point>b |"
- (org-table-toggle-column-width)
- (org-table-toggle-column-width)
- (overlays-in (point-min) (point-max))))
- ;; With a column width cookie, limit overlay to the specified number
- ;; of characters.
- (should
- (equal "| abc"
- (org-test-with-temp-text "| <3> |\n| <point>abcd |"
- (org-table-toggle-column-width)
- (buffer-substring (line-beginning-position)
- (overlay-start
- (car (overlays-in (line-beginning-position)
- (line-end-position))))))))
- (should
- (equal "| a "
- (org-test-with-temp-text "| <3> |\n| <point>a |"
- (org-table-toggle-column-width)
- (buffer-substring (line-beginning-position)
- (overlay-start
- (car (overlays-in (line-beginning-position)
- (line-end-position))))))))
- (should
- (equal (concat "----" org-table-shrunk-column-indicator)
- (org-test-with-temp-text "| <3> |\n|--<point>----|"
- (org-table-toggle-column-width)
- (overlay-get
- (car (overlays-in (line-beginning-position)
- (line-end-position)))
- 'display))))
- ;; Width only takes into account visible characters.
- (should
- (equal "| [[http"
- (org-test-with-temp-text "| <4> |\n| <point>[[http://orgmode.org]] |"
- (org-table-toggle-column-width)
- (buffer-substring (line-beginning-position)
- (overlay-start
- (car (overlays-in (line-beginning-position)
- (line-end-position))))))))
- ;; Before the first column or after the last one, ask for columns
- ;; ranges.
- (should
- (catch :exit
- (org-test-with-temp-text "| a |"
- (cl-letf (((symbol-function 'read-string)
- (lambda (&rest_) (throw :exit t))))
- (org-table-toggle-column-width)
- nil))))
- (should
- (catch :exit
- (org-test-with-temp-text "| a |<point>"
- (cl-letf (((symbol-function 'read-string)
- (lambda (&rest_) (throw :exit t))))
- (org-table-toggle-column-width)
- nil))))
- ;; When optional argument ARG is a string, toggle specified columns.
- (should
- (equal org-table-shrunk-column-indicator
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width "2")
- (overlay-get (car (overlays-at (- (point-max) 2))) 'display))))
- (should
- (equal '("b" "c")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "2-3")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("b" "c" "d")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "2-")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a" "b")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "-2")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a" "b" "c" "d")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "-")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a" "d")
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "1-3")
- (org-table-toggle-column-width "2-4")
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; When ARG is (16), remove any column overlay.
- (should-not
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-toggle-column-width '(16))
- (overlays-in (point-min) (point-max))))
- (should-not
- (org-test-with-temp-text "| a | b | c | d |"
- (org-table-toggle-column-width "-")
- (org-table-toggle-column-width '(16))
- (overlays-in (point-min) (point-max)))))
- (ert-deftest test-org-table/shrunk-columns ()
- "Test behaviour of shrunk column."
- ;; Edition automatically expands a shrunk column.
- (should-not
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (insert "a")
- (overlays-in (point-min) (point-max))))
- ;; Other columns are not changed.
- (should
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width "-")
- (insert "a")
- (overlays-in (point-min) (point-max))))
- ;; Moving a shrunk column doesn't alter its state.
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width)
- (org-table-move-column-right)
- (overlay-get (car (overlays-at (point))) 'help-echo))))
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a |\n| b |"
- (org-table-toggle-column-width)
- (org-table-move-row-down)
- (overlay-get (car (overlays-at (point))) 'help-echo))))
- ;; State is preserved upon inserting a column.
- (should
- (equal '("a")
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-insert-column)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon deleting a column.
- (should
- (equal '("a" "c")
- (org-test-with-temp-text "| a | <point>b | c |"
- (org-table-toggle-column-width "-")
- (org-table-delete-column)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon deleting a row.
- (should
- (equal '("b1" "b2")
- (org-test-with-temp-text "| a1 | a2 |\n| b1 | b2 |"
- (org-table-toggle-column-width "-")
- (org-table-kill-row)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a1" "a2")
- (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width "-")
- (org-table-kill-row)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon inserting a row or hline.
- (should
- (equal '("" "a1" "b1")
- (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width)
- (org-table-insert-row)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- (should
- (equal '("a1" "b1")
- (org-test-with-temp-text "| a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width)
- (org-table-insert-hline)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon sorting a column for all the columns but
- ;; the one being sorted.
- (should
- (equal '("a2" "b2")
- (org-test-with-temp-text "| <point>a1 | a2 |\n| <point>b1 | b2 |"
- (org-table-toggle-column-width "-")
- (org-table-sort-lines nil ?A)
- (sort (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max)))
- #'string-lessp))))
- ;; State is preserved upon replacing a field non-interactively.
- (should
- (equal '("a")
- (org-test-with-temp-text "| <point>a |"
- (org-table-toggle-column-width)
- (org-table-get-field nil "b")
- (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (point-min) (point-max))))))
- ;; Moving to next field doesn't change shrunk state.
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width)
- (org-table-next-field)
- (overlay-get (car (overlays-at (1+ (line-beginning-position))))
- 'help-echo))))
- (should
- (equal "b"
- (org-test-with-temp-text "| a | <point>b |"
- (org-table-toggle-column-width)
- (goto-char 2)
- (org-table-next-field)
- (overlay-get (car (overlays-at (point))) 'help-echo))))
- ;; Aligning table doesn't alter shrunk state.
- (should
- (equal "a"
- (org-test-with-temp-text "| <point>a | b |"
- (org-table-toggle-column-width)
- (org-table-align)
- (overlay-get (car (overlays-at (1+ (line-beginning-position))))
- 'help-echo))))
- (should
- (equal "b"
- (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
- (org-table-toggle-column-width)
- (org-table-align)
- (overlay-get (car (overlays-at (point)))
- 'help-echo))))
- (should
- (equal
- '("b")
- (org-test-with-temp-text "|---+-----|\n| a | <point>b |"
- (org-table-toggle-column-width)
- (org-table-align)
- (mapcar (lambda (o) (overlay-get o 'help-echo))
- (overlays-in (line-beginning-position) (line-end-position))))))
- ;; Recalculating formulas doesn't change shrunk state.
- (should
- (equal "2"
- (org-test-with-temp-text "| 1 | <point>0 |\n#+TBLFM: $2=$1+1\n"
- (org-table-toggle-column-width)
- (org-table-recalculate)
- (overlay-get (car (overlays-at (point))) 'help-echo)))))
- ;;; Miscellaneous
- (ert-deftest test-org-table/current-column ()
- "Test `org-table-current-column' specifications."
- (should
- (= 1 (org-test-with-temp-text "| <point>a |"
- (org-table-current-column))))
- (should
- (= 1 (org-test-with-temp-text "|-<point>--|"
- (org-table-current-column))))
- (should
- (= 2 (org-test-with-temp-text "| 1 | <point>2 |"
- (org-table-current-column))))
- (should
- (= 2 (org-test-with-temp-text "|---+-<point>--|"
- (org-table-current-column)))))
- (ert-deftest test-org-table/get-field ()
- "Test `org-table-get-field' specifications."
- ;; Regular test.
- (should
- (equal " a "
- (org-test-with-temp-text "| <point>a |" (org-table-get-field))))
- ;; Get field in open last column.
- (should
- (equal " a "
- (org-test-with-temp-text "| <point>a " (org-table-get-field))))
- ;; Get empty field.
- (should
- (equal ""
- (org-test-with-temp-text "|<point>|" (org-table-get-field))))
- (should
- (equal " "
- (org-test-with-temp-text "| <point>|" (org-table-get-field))))
- ;; Outside the table, return the empty string.
- (should
- (equal ""
- (org-test-with-temp-text "<point>| a |" (org-table-get-field))))
- (should
- (equal ""
- (org-test-with-temp-text "| a |<point>" (org-table-get-field))))
- ;; With optional N argument, select a particular column in current
- ;; row.
- (should
- (equal " 3 "
- (org-test-with-temp-text "| 1 | 2 | 3 |" (org-table-get-field 3))))
- (should
- (equal " 4 "
- (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
- (org-table-get-field 2))))
- ;; REPLACE optional argument is used to replace selected field.
- (should
- (equal "| foo |"
- (org-test-with-temp-text "| <point>1 |"
- (org-table-get-field nil " foo ")
- (buffer-string))))
- (should
- (equal "| 1 | 2 | foo |"
- (org-test-with-temp-text "| 1 | 2 | 3 |"
- (org-table-get-field 3 " foo ")
- (buffer-string))))
- (should
- (equal " 4 "
- (org-test-with-temp-text "| 1 | 2 |\n<point>| 3 | 4 |"
- (org-table-get-field 2))))
- ;; An empty REPLACE string clears the field.
- (should
- (equal "| |"
- (org-test-with-temp-text "| <point>1 |"
- (org-table-get-field nil "")
- (buffer-string))))
- ;; When using REPLACE still return old value.
- (should
- (equal " 1 "
- (org-test-with-temp-text "| <point>1 |"
- (org-table-get-field nil " foo ")))))
- (provide 'test-org-table)
- ;;; test-org-table.el ends here
|