12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570 |
- ;;; org-table.el --- The Table Editor for Org -*- lexical-binding: t; -*-
- ;; Copyright (C) 2004-2018 Free Software Foundation, Inc.
- ;; Author: Carsten Dominik <carsten at orgmode dot org>
- ;; Keywords: outlines, hypermedia, calendar, wp
- ;; Homepage: http://orgmode.org
- ;;
- ;; This file is part of GNU Emacs.
- ;;
- ;; GNU Emacs 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.
- ;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;;; Commentary:
- ;; This file contains the table editor and spreadsheet for Org mode.
- ;; Watch out: Here we are talking about two different kind of tables.
- ;; Most of the code is for the tables created with the Org mode table editor.
- ;; Sometimes, we talk about tables created and edited with the table.el
- ;; Emacs package. We call the former org-type tables, and the latter
- ;; table.el-type tables.
- ;;; Code:
- (require 'cl-lib)
- (require 'org)
- (declare-function org-element-at-point "org-element" ())
- (declare-function org-element-contents "org-element" (element))
- (declare-function org-element-extract-element "org-element" (element))
- (declare-function org-element-interpret-data "org-element" (data))
- (declare-function org-element-lineage "org-element"
- (blob &optional types with-self))
- (declare-function org-element-map "org-element"
- (data types fun
- &optional info first-match no-recursion with-affiliated))
- (declare-function org-element-parse-buffer "org-element"
- (&optional granularity visible-only))
- (declare-function org-element-property "org-element" (property element))
- (declare-function org-element-type "org-element" (element))
- (declare-function org-export-create-backend "ox" (&rest rest) t)
- (declare-function org-export-data-with-backend "ox" (data backend info))
- (declare-function org-export-filter-apply-functions "ox"
- (filters value info))
- (declare-function org-export-first-sibling-p "ox" (blob info))
- (declare-function org-export-get-backend "ox" (name))
- (declare-function org-export-get-environment "ox"
- (&optional backend subtreep ext-plist))
- (declare-function org-export-install-filters "ox" (info))
- (declare-function org-export-table-has-special-column-p "ox" (table))
- (declare-function org-export-table-row-is-special-p "ox" (table-row info))
- (declare-function calc-eval "calc" (str &optional separator &rest args))
- (defvar constants-unit-system)
- (defvar org-element-use-cache)
- (defvar org-export-filters-alist)
- (defvar org-table-follow-field-mode)
- (defvar orgtbl-mode) ; defined below
- (defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized
- (defvar sort-fold-case)
- (defvar orgtbl-after-send-table-hook nil
- "Hook for functions attaching to `C-c C-c', if the table is sent.
- This can be used to add additional functionality after the table is sent
- to the receiver position, otherwise, if table is not sent, the functions
- are not run.")
- (defvar org-table-TBLFM-begin-regexp "^[ \t]*|.*\n[ \t]*#\\+TBLFM: ")
- (defcustom orgtbl-optimized t
- "Non-nil means use the optimized table editor version for `orgtbl-mode'.
- In the optimized version, the table editor takes over all simple keys that
- normally just insert a character. In tables, the characters are inserted
- in a way to minimize disturbing the table structure (i.e. in overwrite mode
- for empty fields). Outside tables, the correct binding of the keys is
- restored.
- Changing this variable requires a restart of Emacs to become
- effective."
- :group 'org-table
- :type 'boolean)
- (defcustom orgtbl-radio-table-templates
- '((latex-mode "% BEGIN RECEIVE ORGTBL %n
- % END RECEIVE ORGTBL %n
- \\begin{comment}
- #+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0
- | | |
- \\end{comment}\n")
- (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n
- @c END RECEIVE ORGTBL %n
- @ignore
- #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
- | | |
- @end ignore\n")
- (html-mode "<!-- BEGIN RECEIVE ORGTBL %n -->
- <!-- END RECEIVE ORGTBL %n -->
- <!--
- #+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0
- | | |
- -->\n")
- (org-mode "#+ BEGIN RECEIVE ORGTBL %n
- #+ END RECEIVE ORGTBL %n
- #+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0
- | | |
- "))
- "Templates for radio tables in different major modes.
- Each template must define lines that will be treated as a comment and that
- must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\"
- lines where \"%n\" will be replaced with the name of the table during
- insertion of the template. The transformed table will later be inserted
- between these lines.
- The template should also contain a minimal table in a multiline comment.
- If multiline comments are not possible in the buffer language,
- you can pack it into a string that will not be used when the code
- is compiled or executed. Above the table will you need a line with
- the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to
- convert the table into a data structure useful in the
- language of the buffer. Check the manual for the section on
- \"Translator functions\", and more generally check out
- http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax
- All occurrences of %n in a template will be replaced with the name of the
- table, obtained by prompting the user."
- :group 'org-table
- :type '(repeat
- (list (symbol :tag "Major mode")
- (string :tag "Format"))))
- (defgroup org-table-settings nil
- "Settings for tables in Org mode."
- :tag "Org Table Settings"
- :group 'org-table)
- (defcustom org-table-default-size "5x2"
- "The default size for newly created tables, Columns x Rows."
- :group 'org-table-settings
- :type 'string)
- (defcustom org-table-number-regexp
- "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$"
- "Regular expression for recognizing numbers in table columns.
- If a table column contains mostly numbers, it will be aligned to the
- right. If not, it will be aligned to the left.
- The default value of this option is a regular expression which allows
- anything which looks remotely like a number as used in scientific
- context. For example, all of the following will be considered a
- number:
- 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5
- Other options offered by the customize interface are more restrictive."
- :group 'org-table-settings
- :type '(choice
- (const :tag "Positive Integers"
- "^[0-9]+$")
- (const :tag "Integers"
- "^[-+]?[0-9]+$")
- (const :tag "Floating Point Numbers"
- "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$")
- (const :tag "Floating Point Number or Integer"
- "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$")
- (const :tag "Exponential, Floating point, Integer"
- "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$")
- (const :tag "Very General Number-Like, including hex and Calc radix"
- "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
- (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark"
- "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$")
- (string :tag "Regexp:")))
- (defcustom org-table-number-fraction 0.5
- "Fraction of numbers in a column required to make the column align right.
- In a column all non-white fields are considered. If at least
- this fraction of fields is matched by `org-table-number-regexp',
- alignment to the right border applies."
- :group 'org-table-settings
- :type 'number)
- (defgroup org-table-editing nil
- "Behavior of tables during editing in Org mode."
- :tag "Org Table Editing"
- :group 'org-table)
- (defcustom org-table-automatic-realign t
- "Non-nil means automatically re-align table when pressing TAB or RETURN.
- When nil, aligning is only done with `\\[org-table-align]', or after column
- removal/insertion."
- :group 'org-table-editing
- :type 'boolean)
- (defcustom org-table-auto-blank-field t
- "Non-nil means automatically blank table field when starting to type into it.
- This only happens when typing immediately after a field motion
- command (TAB, S-TAB or RET)."
- :group 'org-table-editing
- :type 'boolean)
- (defcustom org-table-exit-follow-field-mode-when-leaving-table t
- "Non-nil means automatically exit the follow mode.
- When nil, the follow mode will stay on and be active in any table
- the cursor enters. Since the table follow filed mode messes with the
- window configuration, it is not recommended to set this variable to nil,
- except maybe locally in a special file that has mostly tables with long
- fields."
- :group 'org-table
- :version "24.1"
- :type 'boolean)
- (defcustom org-table-fix-formulas-confirm nil
- "Whether the user should confirm when Org fixes formulas."
- :group 'org-table-editing
- :version "24.1"
- :type '(choice
- (const :tag "with yes-or-no" yes-or-no-p)
- (const :tag "with y-or-n" y-or-n-p)
- (const :tag "no confirmation" nil)))
- (put 'org-table-fix-formulas-confirm
- 'safe-local-variable
- #'(lambda (x) (member x '(yes-or-no-p y-or-n-p))))
- (defcustom org-table-tab-jumps-over-hlines t
- "Non-nil means tab in the last column of a table with jump over a hline.
- If a horizontal separator line is following the current line,
- `org-table-next-field' can either create a new row before that line, or jump
- over the line. When this option is nil, a new line will be created before
- this line."
- :group 'org-table-editing
- :type 'boolean)
- (defgroup org-table-calculation nil
- "Options concerning tables in Org mode."
- :tag "Org Table Calculation"
- :group 'org-table)
- (defcustom org-table-use-standard-references 'from
- "Non-nil means using table references like B3 instead of @3$2.
- Possible values are:
- nil never use them
- from accept as input, do not present for editing
- t accept as input and present for editing"
- :group 'org-table-calculation
- :type '(choice
- (const :tag "Never, don't even check user input for them" nil)
- (const :tag "Always, both as user input, and when editing" t)
- (const :tag "Convert user input, don't offer during editing" from)))
- (defcustom org-table-copy-increment t
- "Non-nil means increment when copying current field with \
- `\\[org-table-copy-down]'."
- :group 'org-table-calculation
- :version "26.1"
- :package-version '(Org . "8.3")
- :type '(choice
- (const :tag "Use the difference between the current and the above fields" t)
- (integer :tag "Use a number" 1)
- (const :tag "Don't increment the value when copying a field" nil)))
- (defcustom org-calc-default-modes
- '(calc-internal-prec 12
- calc-float-format (float 8)
- calc-angle-mode deg
- calc-prefer-frac nil
- calc-symbolic-mode nil
- calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm))
- calc-display-working-message t
- )
- "List with Calc mode settings for use in `calc-eval' for table formulas.
- The list must contain alternating symbols (Calc modes variables and values).
- Don't remove any of the default settings, just change the values. Org mode
- relies on the variables to be present in the list."
- :group 'org-table-calculation
- :type 'plist)
- (defcustom org-table-duration-custom-format 'hours
- "Format for the output of calc computations like $1+$2;t.
- The default value is `hours', and will output the results as a
- number of hours. Other allowed values are `seconds', `minutes' and
- `days', and the output will be a fraction of seconds, minutes or
- days. `hh:mm' selects to use hours and minutes, ignoring seconds.
- The `U' flag in a table formula will select this specific format for
- a single formula."
- :group 'org-table-calculation
- :version "24.1"
- :type '(choice (symbol :tag "Seconds" 'seconds)
- (symbol :tag "Minutes" 'minutes)
- (symbol :tag "Hours " 'hours)
- (symbol :tag "Days " 'days)
- (symbol :tag "HH:MM " 'hh:mm)))
- (defcustom org-table-duration-hour-zero-padding t
- "Non-nil means hours in table duration computations should be zero-padded.
- So this is about 08:32:34 versus 8:33:34."
- :group 'org-table-calculation
- :version "26.1"
- :package-version '(Org . "9.1")
- :type 'boolean
- :safe #'booleanp)
- (defcustom org-table-formula-field-format "%s"
- "Format for fields which contain the result of a formula.
- For example, using \"~%s~\" will display the result within tilde
- characters. Beware that modifying the display can prevent the
- field from being used in another formula."
- :group 'org-table-settings
- :version "24.1"
- :type 'string)
- (defcustom org-table-formula-evaluate-inline t
- "Non-nil means TAB and RET evaluate a formula in current table field.
- If the current field starts with an equal sign, it is assumed to be a formula
- which should be evaluated as described in the manual and in the documentation
- string of the command `org-table-eval-formula'. This feature requires the
- Emacs calc package.
- When this variable is nil, formula calculation is only available through
- the command `\\[org-table-eval-formula]'."
- :group 'org-table-calculation
- :type 'boolean)
- (defcustom org-table-formula-use-constants t
- "Non-nil means interpret constants in formulas in tables.
- A constant looks like `$c' or `$Grav' and will be replaced before evaluation
- by the value given in `org-table-formula-constants', or by a value obtained
- from the `constants.el' package."
- :group 'org-table-calculation
- :type 'boolean)
- (defcustom org-table-formula-constants nil
- "Alist with constant names and values, for use in table formulas.
- The car of each element is a name of a constant, without the `$' before it.
- The cdr is the value as a string. For example, if you'd like to use the
- speed of light in a formula, you would configure
- (setq org-table-formula-constants \\='((\"c\" . \"299792458.\")))
- and then use it in an equation like `$1*$c'.
- Constants can also be defined on a per-file basis using a line like
- #+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6"
- :group 'org-table-calculation
- :type '(repeat
- (cons (string :tag "name")
- (string :tag "value"))))
- (defcustom org-table-allow-automatic-line-recalculation t
- "Non-nil means lines marked with |#| or |*| will be recomputed automatically.
- \\<org-mode-map>\
- Automatically means when `TAB' or `RET' or `\\[org-ctrl-c-ctrl-c]' \
- are pressed in the line."
- :group 'org-table-calculation
- :type 'boolean)
- (defcustom org-table-relative-ref-may-cross-hline t
- "Non-nil means relative formula references may cross hlines.
- Here are the allowed values:
- nil Relative references may not cross hlines. They will reference the
- field next to the hline instead. Coming from below, the reference
- will be to the field below the hline. Coming from above, it will be
- to the field above.
- t Relative references may cross hlines.
- error An attempt to cross a hline will throw an error.
- It is probably good to never set this variable to nil, for the sake of
- portability of tables."
- :group 'org-table-calculation
- :type '(choice
- (const :tag "Allow to cross" t)
- (const :tag "Stick to hline" nil)
- (const :tag "Error on attempt to cross" error)))
- (defcustom org-table-formula-create-columns nil
- "Non-nil means evaluation of formula can add new columns.
- When non-nil, evaluating an out-of-bounds field can insert as
- many columns as needed. When set to `warn', issue a warning when
- doing so. When set to `prompt', ask user before creating a new
- column. Otherwise, throw an error."
- :group 'org-table-calculation
- :version "26.1"
- :package-version '(Org . "8.3")
- :type '(choice
- (const :tag "Out-of-bounds field generates an error (default)" nil)
- (const :tag "Out-of-bounds field silently adds columns as needed" t)
- (const :tag "Out-of-bounds field adds columns, but issues a warning" warn)
- (const :tag "Prompt user when setting an out-of-bounds field" prompt)))
- (defgroup org-table-import-export nil
- "Options concerning table import and export in Org mode."
- :tag "Org Table Import Export"
- :group 'org-table)
- (defcustom org-table-export-default-format "orgtbl-to-tsv"
- "Default export parameters for `org-table-export'.
- These can be overridden for a specific table by setting the
- TABLE_EXPORT_FORMAT property. See the manual section on orgtbl
- radio tables for the different export transformations and
- available parameters."
- :group 'org-table-import-export
- :type 'string)
- (defcustom org-table-convert-region-max-lines 999
- "Max lines that `org-table-convert-region' will attempt to process.
- The function can be slow on larger regions; this safety feature
- prevents it from hanging emacs."
- :group 'org-table-import-export
- :type 'integer
- :version "26.1"
- :package-version '(Org . "8.3"))
- (defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)"
- "Regexp matching a line marked for automatic recalculation.")
- (defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)"
- "Regexp matching a line marked for recalculation.")
- (defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)"
- "Regexp matching a line marked for calculation.")
- (defconst org-table-border-regexp "^[ \t]*[^| \t]"
- "Regexp matching any line outside an Org table.")
- (defvar org-table-last-highlighted-reference nil)
- (defvar org-table-formula-history nil)
- (defvar org-table-column-names nil
- "Alist with column names, derived from the `!' line.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-column-name-regexp nil
- "Regular expression matching the current column names.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-local-parameters nil
- "Alist with parameter names, derived from the `$' line.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-named-field-locations nil
- "Alist with locations of named fields.
- Associations follow the pattern (NAME LINE COLUMN) where
- NAME is the name of the field as a string,
- LINE is the number of lines from the beginning of the table,
- COLUMN is the column of the field, as an integer.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-current-line-types nil
- "Table row types in current table.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-current-begin-pos nil
- "Current table begin position, as a marker.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-current-ncol nil
- "Number of columns in current table.
- This variable is initialized with `org-table-analyze'.")
- (defvar org-table-dlines nil
- "Vector of data line line numbers in the current table.
- Line numbers are counted from the beginning of the table. This
- variable is initialized with `org-table-analyze'.")
- (defvar org-table-hlines nil
- "Vector of hline line numbers in the current table.
- Line numbers are counted from the beginning of the table. This
- variable is initialized with `org-table-analyze'.")
- (defconst org-table-range-regexp
- "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?"
- ;; 1 2 3 4 5
- "Regular expression for matching ranges in formulas.")
- (defconst org-table-range-regexp2
- (concat
- "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)"
- "\\.\\."
- "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)")
- "Match a range for reference display.")
- (defconst org-table-translate-regexp
- (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)")
- "Match a reference that needs translation, for reference display.")
- (defmacro org-table-save-field (&rest body)
- "Save current field; execute BODY; restore field.
- Field is restored even in case of abnormal exit."
- (declare (debug (body)))
- (org-with-gensyms (line column)
- `(let ((,line (copy-marker (line-beginning-position)))
- (,column (org-table-current-column)))
- (unwind-protect
- (progn ,@body)
- (goto-char ,line)
- (org-table-goto-column ,column)
- (set-marker ,line nil)))))
- ;;;###autoload
- (defun org-table-create-with-table.el ()
- "Use the table.el package to insert a new table.
- If there is already a table at point, convert between Org tables
- and table.el tables."
- (interactive)
- (require 'table)
- (cond
- ((org-at-table.el-p)
- (if (y-or-n-p "Convert table to Org table? ")
- (org-table-convert)))
- ((org-at-table-p)
- (when (y-or-n-p "Convert table to table.el table? ")
- (org-table-align)
- (org-table-convert)))
- (t (call-interactively 'table-insert))))
- ;;;###autoload
- (defun org-table-create-or-convert-from-region (arg)
- "Convert region to table, or create an empty table.
- If there is an active region, convert it to a table, using the function
- `org-table-convert-region'. See the documentation of that function
- to learn how the prefix argument is interpreted to determine the field
- separator.
- If there is no such region, create an empty table with `org-table-create'."
- (interactive "P")
- (if (org-region-active-p)
- (org-table-convert-region (region-beginning) (region-end) arg)
- (org-table-create arg)))
- ;;;###autoload
- (defun org-table-create (&optional size)
- "Query for a size and insert a table skeleton.
- SIZE is a string Columns x Rows like for example \"3x2\"."
- (interactive "P")
- (unless size
- (setq size (read-string
- (concat "Table size Columns x Rows [e.g. "
- org-table-default-size "]: ")
- "" nil org-table-default-size)))
- (let* ((pos (point))
- (indent (make-string (current-column) ?\ ))
- (split (org-split-string size " *x *"))
- (rows (string-to-number (nth 1 split)))
- (columns (string-to-number (car split)))
- (line (concat (apply 'concat indent "|" (make-list columns " |"))
- "\n")))
- (if (string-match "^[ \t]*$" (buffer-substring-no-properties
- (point-at-bol) (point)))
- (beginning-of-line 1)
- (newline))
- ;; (mapcar (lambda (x) (insert line)) (make-list rows t))
- (dotimes (_ rows) (insert line))
- (goto-char pos)
- (if (> rows 1)
- ;; Insert a hline after the first row.
- (progn
- (end-of-line 1)
- (insert "\n|-")
- (goto-char pos)))
- (org-table-align)))
- ;;;###autoload
- (defun org-table-convert-region (beg0 end0 &optional separator)
- "Convert region to a table.
- The region goes from BEG0 to END0, but these borders will be moved
- slightly, to make sure a beginning of line in the first line is included.
- SEPARATOR specifies the field separator in the lines. It can have the
- following values:
- (4) Use the comma as a field separator
- (16) Use a TAB as field separator
- (64) Prompt for a regular expression as field separator
- integer When a number, use that many spaces, or a TAB, as field separator
- regexp When a regular expression, use it to match the separator
- nil When nil, the command tries to be smart and figure out the
- separator in the following way:
- - when each line contains a TAB, assume TAB-separated material
- - when each line contains a comma, assume CSV material
- - else, assume one or more SPACE characters as separator."
- (interactive "r\nP")
- (let* ((beg (min beg0 end0))
- (end (max beg0 end0))
- re)
- (if (> (count-lines beg end) org-table-convert-region-max-lines)
- (user-error "Region is longer than `org-table-convert-region-max-lines' (%s) lines; not converting"
- org-table-convert-region-max-lines)
- (if (equal separator '(64))
- (setq separator (read-regexp "Regexp for field separator")))
- (goto-char beg)
- (beginning-of-line 1)
- (setq beg (point-marker))
- (goto-char end)
- (if (bolp) (backward-char 1) (end-of-line 1))
- (setq end (point-marker))
- ;; Get the right field separator
- (unless separator
- (goto-char beg)
- (setq separator
- (cond
- ((not (re-search-forward "^[^\n\t]+$" end t)) '(16))
- ((not (re-search-forward "^[^\n,]+$" end t)) '(4))
- (t 1))))
- (goto-char beg)
- (if (equal separator '(4))
- (while (< (point) end)
- ;; parse the csv stuff
- (cond
- ((looking-at "^") (insert "| "))
- ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2))
- ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"")
- (replace-match "\\1")
- (if (looking-at "\"") (insert "\"")))
- ((looking-at "[^,\n]+") (goto-char (match-end 0)))
- ((looking-at "[ \t]*,") (replace-match " | "))
- (t (beginning-of-line 2))))
- (setq re (cond
- ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?")
- ((equal separator '(16)) "^\\|\t")
- ((integerp separator)
- (if (< separator 1)
- (user-error "Number of spaces in separator must be >= 1")
- (format "^ *\\| *\t *\\| \\{%d,\\}" separator)))
- ((stringp separator)
- (format "^ *\\|%s" separator))
- (t (error "This should not happen"))))
- (while (re-search-forward re end t)
- (replace-match "| " t t)))
- (goto-char beg)
- (org-table-align))))
- ;;;###autoload
- (defun org-table-import (file separator)
- "Import FILE as a table.
- The command tries to be smart and figure out the separator in the
- following way:
- - when each line contains a TAB, assume TAB-separated material
- - when each line contains a comma, assume CSV material
- - else, assume one or more SPACE characters as separator.
- When non-nil, SEPARATOR specifies the field separator in the
- lines. It can have the following values:
- (4) Use the comma as a field separator
- (16) Use a TAB as field separator
- (64) Prompt for a regular expression as field separator
- integer When a number, use that many spaces, or a TAB, as field separator
- regexp When a regular expression, use it to match the separator."
- (interactive "f\nP")
- (unless (bolp) (insert "\n"))
- (let ((beg (point))
- (pm (point-max)))
- (insert-file-contents file)
- (org-table-convert-region beg (+ (point) (- (point-max) pm)) separator)))
- ;;;###autoload
- (defun org-table-export (&optional file format)
- "Export table to a file, with configurable format.
- Such a file can be imported into usual spreadsheet programs.
- FILE can be the output file name. If not given, it will be taken
- from a TABLE_EXPORT_FILE property in the current entry or higher
- up in the hierarchy, or the user will be prompted for a file
- name. FORMAT can be an export format, of the same kind as it
- used when `orgtbl-mode' sends a table in a different format.
- The command suggests a format depending on TABLE_EXPORT_FORMAT,
- whether it is set locally or up in the hierarchy, then on the
- extension of the given file name, and finally on the variable
- `org-table-export-default-format'."
- (interactive)
- (unless (org-at-table-p) (user-error "No table at point"))
- (org-table-align) ; Make sure we have everything we need.
- (let ((file (or file (org-entry-get (point) "TABLE_EXPORT_FILE" t))))
- (unless file
- (setq file (read-file-name "Export table to: "))
- (unless (or (not (file-exists-p file))
- (y-or-n-p (format "Overwrite file %s? " file)))
- (user-error "File not written")))
- (when (file-directory-p file)
- (user-error "This is a directory path, not a file"))
- (when (and (buffer-file-name (buffer-base-buffer))
- (file-equal-p
- (file-truename file)
- (file-truename (buffer-file-name (buffer-base-buffer)))))
- (user-error "Please specify a file name that is different from current"))
- (let ((fileext (concat (file-name-extension file) "$"))
- (format (or format (org-entry-get (point) "TABLE_EXPORT_FORMAT" t))))
- (unless format
- (let* ((formats '("orgtbl-to-tsv" "orgtbl-to-csv" "orgtbl-to-latex"
- "orgtbl-to-html" "orgtbl-to-generic"
- "orgtbl-to-texinfo" "orgtbl-to-orgtbl"
- "orgtbl-to-unicode"))
- (deffmt-readable
- (replace-regexp-in-string
- "\t" "\\t"
- (replace-regexp-in-string
- "\n" "\\n"
- (or (car (delq nil
- (mapcar
- (lambda (f)
- (and (string-match-p fileext f) f))
- formats)))
- org-table-export-default-format)
- t t) t t)))
- (setq format
- (org-completing-read
- "Format: " formats nil nil deffmt-readable))))
- (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format)
- (let ((transform (intern (match-string 1 format)))
- (params (and (match-end 2)
- (read (concat "(" (match-string 2 format) ")"))))
- (table (org-table-to-lisp
- (buffer-substring-no-properties
- (org-table-begin) (org-table-end)))))
- (unless (fboundp transform)
- (user-error "No such transformation function %s" transform))
- (let (buf)
- (with-current-buffer (find-file-noselect file)
- (setq buf (current-buffer))
- (erase-buffer)
- (fundamental-mode)
- (insert (funcall transform table params) "\n")
- (save-buffer))
- (kill-buffer buf))
- (message "Export done."))
- (user-error "TABLE_EXPORT_FORMAT invalid")))))
- (defvar org-table-aligned-begin-marker (make-marker)
- "Marker at the beginning of the table last aligned.
- Used to check if cursor still is in that table, to minimize realignment.")
- (defvar org-table-aligned-end-marker (make-marker)
- "Marker at the end of the table last aligned.
- Used to check if cursor still is in that table, to minimize realignment.")
- (defvar org-table-last-alignment nil
- "List of flags for flushright alignment, from the last re-alignment.
- This is being used to correctly align a single field after TAB or RET.")
- (defvar org-table-last-column-widths nil
- "List of max width of fields in each column.
- This is being used to correctly align a single field after TAB or RET.")
- (defvar-local org-table-formula-debug nil
- "Non-nil means debug table formulas.
- When nil, simply write \"#ERROR\" in corrupted fields.")
- (defvar-local org-table-overlay-coordinates nil
- "Overlay coordinates after each align of a table.")
- (defvar org-last-recalc-line nil)
- (defvar org-table-do-narrow t) ; for dynamic scoping
- (defconst org-narrow-column-arrow "=>"
- "Used as display property in narrowed table columns.")
- ;;;###autoload
- (defun org-table-align ()
- "Align the table at point by aligning all vertical bars."
- (interactive)
- (let* ((beg (org-table-begin))
- (end (copy-marker (org-table-end))))
- (org-table-save-field
- ;; Make sure invisible characters in the table are at the right
- ;; place since column widths take them into account.
- (font-lock-fontify-region beg end)
- (move-marker org-table-aligned-begin-marker beg)
- (move-marker org-table-aligned-end-marker end)
- (goto-char beg)
- (let* ((indent (progn (looking-at "[ \t]*") (match-string 0)))
- ;; Table's rows. Separators are replaced by nil. Trailing
- ;; spaces are also removed.
- (lines (mapcar (lambda (l)
- (and (not (string-match-p "\\`[ \t]*|-" l))
- (let ((l (org-trim l)))
- (remove-text-properties
- 0 (length l) '(display t org-cwidth t) l)
- l)))
- (org-split-string (buffer-substring beg end) "\n")))
- ;; Get the data fields by splitting the lines.
- (fields (mapcar (lambda (l) (org-split-string l " *| *"))
- (remq nil lines)))
- ;; Compute number of fields in the longest line. If the
- ;; table contains no field, create a default table.
- (maxfields (if fields (apply #'max (mapcar #'length fields))
- (kill-region beg end)
- (org-table-create org-table-default-size)
- (user-error "Empty table - created default table")))
- ;; A list of empty strings to fill any short rows on output.
- (emptycells (make-list maxfields ""))
- lengths typenums)
- ;; Check for special formatting.
- (dotimes (i maxfields)
- (let ((column (mapcar (lambda (x) (or (nth i x) "")) fields))
- fmax falign)
- ;; Look for an explicit width or alignment.
- (when (save-excursion
- (or (re-search-forward "| *<[lrc][0-9]*> *\\(|\\|$\\)" end t)
- (and org-table-do-narrow
- (re-search-forward
- "| *<[lrc]?[0-9]+> *\\(|\\|$\\)" end t))))
- (catch :exit
- (dolist (cell column)
- (when (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" cell)
- (when (match-end 1) (setq falign (match-string 1 cell)))
- (when (and org-table-do-narrow (match-end 2))
- (setq fmax (string-to-number (match-string 2 cell))))
- (when (or falign fmax) (throw :exit nil)))))
- ;; Find fields that are wider than FMAX, and shorten them.
- (when fmax
- (dolist (x column)
- (when (> (string-width x) fmax)
- (org-add-props x nil
- 'help-echo
- (concat
- "Clipped table field, use `\\[org-table-edit-field]' to \
- edit. Full value is:\n"
- (substring-no-properties x)))
- (let ((l (length x))
- (f1 (min fmax
- (or (string-match org-bracket-link-regexp x)
- fmax)))
- (f2 1))
- (unless (> f1 1)
- (user-error
- "Cannot narrow field starting with wide link \"%s\""
- (match-string 0 x)))
- (if (= (org-string-width x) l) (setq f2 f1)
- (setq f2 1)
- (while (< (org-string-width (substring x 0 f2)) f1)
- (cl-incf f2)))
- (add-text-properties f2 l (list 'org-cwidth t) x)
- (add-text-properties
- (if (>= (string-width (substring x (1- f2) f2)) 2) (1- f2)
- (- f2 2))
- f2
- (list 'display org-narrow-column-arrow)
- x))))))
- ;; Get the maximum width for each column
- (push (or fmax (apply #'max 1 (mapcar #'org-string-width column)))
- lengths)
- ;; Get the fraction of numbers among non-empty cells to
- ;; decide about alignment of the column.
- (if falign (push (equal (downcase falign) "r") typenums)
- (let ((cnt 0)
- (frac 0.0))
- (dolist (x column)
- (unless (equal x "")
- (setq frac
- (/ (+ (* frac cnt)
- (if (string-match-p org-table-number-regexp x)
- 1
- 0))
- (cl-incf cnt)))))
- (push (>= frac org-table-number-fraction) typenums)))))
- (setq lengths (nreverse lengths))
- (setq typenums (nreverse typenums))
- ;; Store alignment of this table, for later editing of single
- ;; fields.
- (setq org-table-last-alignment typenums)
- (setq org-table-last-column-widths lengths)
- ;; With invisible characters, `format' does not get the field
- ;; width right So we need to make these fields wide by hand.
- ;; Invisible characters may be introduced by fontified links,
- ;; emphasis, macros or sub/superscripts.
- (when (or (text-property-any beg end 'invisible 'org-link)
- (text-property-any beg end 'invisible t))
- (dotimes (i maxfields)
- (let ((len (nth i lengths)))
- (dotimes (j (length fields))
- (let* ((c (nthcdr i (nth j fields)))
- (cell (car c)))
- (when (and
- (stringp cell)
- (let ((l (length cell)))
- (or (text-property-any 0 l 'invisible 'org-link cell)
- (text-property-any beg end 'invisible t)))
- (< (org-string-width cell) len))
- (let ((s (make-string (- len (org-string-width cell)) ?\s)))
- (setcar c (if (nth i typenums) (concat s cell)
- (concat cell s))))))))))
- ;; Compute the formats needed for output of the table.
- (let ((hfmt (concat indent "|"))
- (rfmt (concat indent "|"))
- (rfmt1 " %%%s%ds |")
- (hfmt1 "-%s-+"))
- (dolist (l lengths (setq hfmt (concat (substring hfmt 0 -1) "|")))
- (let ((ty (if (pop typenums) "" "-"))) ; Flush numbers right.
- (setq rfmt (concat rfmt (format rfmt1 ty l)))
- (setq hfmt (concat hfmt (format hfmt1 (make-string l ?-))))))
- ;; Replace modified lines only. Check not only contents, but
- ;; also columns' width.
- (dolist (l lines)
- (let ((line
- (if l (apply #'format rfmt (append (pop fields) emptycells))
- hfmt))
- (previous (buffer-substring (point) (line-end-position))))
- (if (and (equal previous line)
- (let ((a 0)
- (b 0))
- (while (and (progn
- (setq a (next-single-property-change
- a 'org-cwidth previous))
- (setq b (next-single-property-change
- b 'org-cwidth line)))
- (eq a b)))
- (eq a b)))
- (forward-line)
- (insert line "\n")
- (delete-region (point) (line-beginning-position 2))))))
- (when (and orgtbl-mode (not (derived-mode-p 'org-mode)))
- (goto-char org-table-aligned-begin-marker)
- (while (org-hide-wide-columns org-table-aligned-end-marker)))
- (set-marker end nil)
- (when org-table-overlay-coordinates (org-table-overlay-coordinates))
- (setq org-table-may-need-update nil)))))
- ;;;###autoload
- (defun org-table-begin (&optional table-type)
- "Find the beginning of the table and return its position.
- With a non-nil optional argument TABLE-TYPE, return the beginning
- of a table.el-type table. This function assumes point is on
- a table."
- (cond (table-type
- (org-element-property :post-affiliated (org-element-at-point)))
- ((save-excursion
- (and (re-search-backward org-table-border-regexp nil t)
- (line-beginning-position 2))))
- (t (point-min))))
- ;;;###autoload
- (defun org-table-end (&optional table-type)
- "Find the end of the table and return its position.
- With a non-nil optional argument TABLE-TYPE, return the end of
- a table.el-type table. This function assumes point is on
- a table."
- (save-excursion
- (cond (table-type
- (goto-char (org-element-property :end (org-element-at-point)))
- (skip-chars-backward " \t\n")
- (line-beginning-position 2))
- ((re-search-forward org-table-border-regexp nil t)
- (match-beginning 0))
- ;; When the line right after the table is the last line in
- ;; the buffer with trailing spaces but no final newline
- ;; character, be sure to catch the correct ending at its
- ;; beginning. In any other case, ending is expected to be
- ;; at point max.
- (t (goto-char (point-max))
- (skip-chars-backward " \t")
- (if (bolp) (point) (line-end-position))))))
- ;;;###autoload
- (defun org-table-justify-field-maybe (&optional new)
- "Justify the current field, text to left, number to right.
- Optional argument NEW may specify text to replace the current field content."
- (cond
- ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway
- ((org-at-table-hline-p))
- ((and (not new)
- (or (not (eq (marker-buffer org-table-aligned-begin-marker)
- (current-buffer)))
- (< (point) org-table-aligned-begin-marker)
- (>= (point) org-table-aligned-end-marker)))
- ;; This is not the same table, force a full re-align.
- (setq org-table-may-need-update t))
- (t
- ;; Realign the current field, based on previous full realign.
- (let ((pos (point))
- (col (org-table-current-column)))
- (when (> col 0)
- (skip-chars-backward "^|")
- (if (not (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)"))
- (setq org-table-may-need-update t)
- (let* ((numbers? (nth (1- col) org-table-last-alignment))
- (cell (match-string 0))
- (field (match-string 1))
- (len (max 1 (- (org-string-width cell) 3)))
- (properly-closed? (/= (match-beginning 2) (match-end 2)))
- (fmt (format (if numbers? " %%%ds %s" " %%-%ds %s")
- len
- (if properly-closed? "|"
- (setq org-table-may-need-update t)
- "")))
- (new-cell
- (cond ((not new) (format fmt field))
- ((<= (org-string-width new) len) (format fmt new))
- (t
- (setq org-table-may-need-update t)
- (format " %s |" new)))))
- (unless (equal new-cell cell)
- (let (org-table-may-need-update)
- (replace-match new-cell t t)))
- (goto-char pos))))))))
- ;;;###autoload
- (defun org-table-next-field ()
- "Go to the next field in the current table, creating new lines as needed.
- Before doing so, re-align the table if necessary."
- (interactive)
- (org-table-maybe-eval-formula)
- (org-table-maybe-recalculate-line)
- (if (and org-table-automatic-realign
- org-table-may-need-update)
- (org-table-align))
- (let ((end (org-table-end)))
- (if (org-at-table-hline-p)
- (end-of-line 1))
- (condition-case nil
- (progn
- (re-search-forward "|" end)
- (if (looking-at "[ \t]*$")
- (re-search-forward "|" end))
- (if (and (looking-at "-")
- org-table-tab-jumps-over-hlines
- (re-search-forward "^[ \t]*|\\([^-]\\)" end t))
- (goto-char (match-beginning 1)))
- (if (looking-at "-")
- (progn
- (beginning-of-line 0)
- (org-table-insert-row 'below))
- (if (looking-at " ") (forward-char 1))))
- (error
- (org-table-insert-row 'below)))))
- ;;;###autoload
- (defun org-table-previous-field ()
- "Go to the previous field in the table.
- Before doing so, re-align the table if necessary."
- (interactive)
- (org-table-justify-field-maybe)
- (org-table-maybe-recalculate-line)
- (when (and org-table-automatic-realign
- org-table-may-need-update)
- (org-table-align))
- (when (org-at-table-hline-p)
- (end-of-line))
- (let ((start (org-table-begin))
- (origin (point)))
- (condition-case nil
- (progn
- (search-backward "|" start nil 2)
- (while (looking-at-p "|\\(?:-\\|[ \t]*$\\)")
- (search-backward "|" start)))
- (error
- (goto-char origin)
- (user-error "Cannot move to previous table field"))))
- (when (looking-at "| ?")
- (goto-char (match-end 0))))
- (defun org-table-beginning-of-field (&optional n)
- "Move to the beginning of the current table field.
- If already at or before the beginning, move to the beginning of the
- previous field.
- With numeric argument N, move N-1 fields backward first."
- (interactive "p")
- (let ((pos (point)))
- (while (> n 1)
- (setq n (1- n))
- (org-table-previous-field))
- (if (not (re-search-backward "|" (point-at-bol 0) t))
- (user-error "No more table fields before the current")
- (goto-char (match-end 0))
- (and (looking-at " ") (forward-char 1)))
- (if (>= (point) pos) (org-table-beginning-of-field 2))))
- (defun org-table-end-of-field (&optional n)
- "Move to the end of the current table field.
- If already at or after the end, move to the end of the next table field.
- With numeric argument N, move N-1 fields forward first."
- (interactive "p")
- (let ((pos (point)))
- (while (> n 1)
- (setq n (1- n))
- (org-table-next-field))
- (when (re-search-forward "|" (point-at-eol 1) t)
- (backward-char 1)
- (skip-chars-backward " ")
- (if (and (equal (char-before (point)) ?|) (looking-at " "))
- (forward-char 1)))
- (if (<= (point) pos) (org-table-end-of-field 2))))
- ;;;###autoload
- (defun org-table-next-row ()
- "Go to the next row (same column) in the current table.
- Before doing so, re-align the table if necessary."
- (interactive)
- (org-table-maybe-eval-formula)
- (org-table-maybe-recalculate-line)
- (if (and org-table-automatic-realign
- org-table-may-need-update)
- (org-table-align))
- (let ((col (org-table-current-column)))
- (beginning-of-line 2)
- (when (or (not (org-at-table-p))
- (org-at-table-hline-p))
- (beginning-of-line 0)
- (org-table-insert-row 'below))
- (org-table-goto-column col)
- (skip-chars-backward "^|\n\r")
- (when (looking-at " ") (forward-char))))
- ;;;###autoload
- (defun org-table-copy-down (n)
- "Copy the value of the current field one row below.
- If the field at the cursor is empty, copy the content of the
- nearest non-empty field above. With argument N, use the Nth
- non-empty field.
- If the current field is not empty, it is copied down to the next
- row, and the cursor is moved with it. Therefore, repeating this
- command causes the column to be filled row-by-row.
- If the variable `org-table-copy-increment' is non-nil and the
- field is an integer or a timestamp, it will be incremented while
- copying. By default, increment by the difference between the
- value in the current field and the one in the field above. To
- increment using a fixed integer, set `org-table-copy-increment'
- to a number. In the case of a timestamp, increment by days."
- (interactive "p")
- (let* ((colpos (org-table-current-column))
- (col (current-column))
- (field (save-excursion (org-table-get-field)))
- (field-up (or (save-excursion
- (org-table-get (1- (org-table-current-line))
- (org-table-current-column))) ""))
- (non-empty (string-match "[^ \t]" field))
- (non-empty-up (string-match "[^ \t]" field-up))
- (beg (org-table-begin))
- (orig-n n)
- txt txt-up inc)
- (org-table-check-inside-data-field)
- (if (not non-empty)
- (save-excursion
- (setq txt
- (catch 'exit
- (while (progn (beginning-of-line 1)
- (re-search-backward org-table-dataline-regexp
- beg t))
- (org-table-goto-column colpos t)
- (if (and (looking-at
- "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
- (<= (setq n (1- n)) 0))
- (throw 'exit (match-string 1))))))
- (setq field-up
- (catch 'exit
- (while (progn (beginning-of-line 1)
- (re-search-backward org-table-dataline-regexp
- beg t))
- (org-table-goto-column colpos t)
- (if (and (looking-at
- "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|")
- (<= (setq n (1- n)) 0))
- (throw 'exit (match-string 1))))))
- (setq non-empty-up (and field-up (string-match "[^ \t]" field-up))))
- ;; Above field was not empty, go down to the next row
- (setq txt (org-trim field))
- (org-table-next-row)
- (org-table-blank-field))
- (if non-empty-up (setq txt-up (org-trim field-up)))
- (setq inc (cond
- ((numberp org-table-copy-increment) org-table-copy-increment)
- (txt-up (cond ((and (string-match org-ts-regexp3 txt-up)
- (string-match org-ts-regexp3 txt))
- (- (org-time-string-to-absolute txt)
- (org-time-string-to-absolute txt-up)))
- ((string-match org-ts-regexp3 txt) 1)
- ((string-match "\\([-+]\\)?\\(?:[0-9]+\\)?\\(?:\.[0-9]+\\)?" txt-up)
- (- (string-to-number txt)
- (string-to-number (match-string 0 txt-up))))
- (t 1)))
- (t 1)))
- (if (not txt)
- (user-error "No non-empty field found")
- (if (and org-table-copy-increment
- (not (equal orig-n 0))
- (string-match-p "^[-+^/*0-9eE.]+$" txt)
- (< (string-to-number txt) 100000000))
- (setq txt (calc-eval (concat txt "+" (number-to-string inc)))))
- (insert txt)
- (org-move-to-column col)
- (if (and org-table-copy-increment (org-at-timestamp-p 'lax))
- (org-timestamp-up-day inc)
- (org-table-maybe-recalculate-line))
- (org-table-align)
- (org-move-to-column col))))
- (defun org-table-check-inside-data-field (&optional noerror)
- "Is point inside a table data field?
- I.e. not on a hline or before the first or after the last column?
- This actually throws an error, so it aborts the current command."
- (cond ((and (org-at-table-p)
- (not (save-excursion (skip-chars-backward " \t") (bolp)))
- (not (org-at-table-hline-p))
- (not (looking-at "[ \t]*$"))))
- (noerror nil)
- (t (user-error "Not in table data field"))))
- (defvar org-table-clip nil
- "Clipboard for table regions.")
- (defun org-table-get (line column)
- "Get the field in table line LINE, column COLUMN.
- If LINE is larger than the number of data lines in the table, the function
- returns nil. However, if COLUMN is too large, we will simply return an
- empty string.
- If LINE is nil, use the current line.
- If COLUMN is nil, use the current column."
- (setq column (or column (org-table-current-column)))
- (save-excursion
- (and (or (not line) (org-table-goto-line line))
- (org-trim (org-table-get-field column)))))
- (defun org-table-put (line column value &optional align)
- "Put VALUE into line LINE, column COLUMN.
- When ALIGN is set, also realign the table."
- (setq column (or column (org-table-current-column)))
- (prog1 (save-excursion
- (and (or (not line) (org-table-goto-line line))
- (progn (org-table-goto-column column nil 'force) t)
- (org-table-get-field column value)))
- (and align (org-table-align))))
- (defun org-table-current-line ()
- "Return the index of the current data line."
- (let ((pos (point)) (end (org-table-end)) (cnt 0))
- (save-excursion
- (goto-char (org-table-begin))
- (while (and (re-search-forward org-table-dataline-regexp end t)
- (setq cnt (1+ cnt))
- (< (point-at-eol) pos))))
- cnt))
- (defun org-table-goto-line (N)
- "Go to the Nth data line in the current table.
- Return t when the line exists, nil if it does not exist."
- (goto-char (org-table-begin))
- (let ((end (org-table-end)) (cnt 0))
- (while (and (re-search-forward org-table-dataline-regexp end t)
- (< (setq cnt (1+ cnt)) N)))
- (= cnt N)))
- ;;;###autoload
- (defun org-table-blank-field ()
- "Blank the current table field or active region."
- (interactive)
- (org-table-check-inside-data-field)
- (if (and (called-interactively-p 'any) (org-region-active-p))
- (let (org-table-clip)
- (org-table-cut-region (region-beginning) (region-end)))
- (skip-chars-backward "^|")
- (backward-char 1)
- (if (looking-at "|[^|\n]+")
- (let* ((pos (match-beginning 0))
- (match (match-string 0))
- (len (org-string-width match)))
- (replace-match (concat "|" (make-string (1- len) ?\ )))
- (goto-char (+ 2 pos))
- (substring match 1)))))
- (defun org-table-get-field (&optional n replace)
- "Return the value of the field in column N of current row.
- N defaults to current column. If REPLACE is a string, replace
- field with this value. The return value is always the old
- value."
- (when n (org-table-goto-column n))
- (skip-chars-backward "^|\n")
- (if (or (bolp) (looking-at-p "[ \t]*$"))
- ;; Before first column or after last one.
- ""
- (looking-at "[^|\r\n]*")
- (let* ((pos (match-beginning 0))
- (val (buffer-substring pos (match-end 0))))
- (when replace
- (replace-match (if (equal replace "") " " replace) t t))
- (goto-char (min (line-end-position) (1+ pos)))
- val)))
- ;;;###autoload
- (defun org-table-field-info (_arg)
- "Show info about the current field, and highlight any reference at point."
- (interactive "P")
- (unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-analyze)
- (save-excursion
- (let* ((pos (point))
- (col (org-table-current-column))
- (cname (car (rassoc (int-to-string col) org-table-column-names)))
- (name (car (rassoc (list (count-lines org-table-current-begin-pos
- (line-beginning-position))
- col)
- org-table-named-field-locations)))
- (eql (org-table-expand-lhs-ranges
- (mapcar
- (lambda (e)
- (cons (org-table-formula-handle-first/last-rc (car e))
- (cdr e)))
- (org-table-get-stored-formulas))))
- (dline (org-table-current-dline))
- (ref (format "@%d$%d" dline col))
- (ref1 (org-table-convert-refs-to-an ref))
- ;; Prioritize field formulas over column formulas.
- (fequation (or (assoc name eql) (assoc ref eql)))
- (cequation (assoc (format "$%d" col) eql))
- (eqn (or fequation cequation)))
- (let ((p (and eqn (get-text-property 0 :orig-eqn (car eqn)))))
- (when p (setq eqn p)))
- (goto-char pos)
- (ignore-errors (org-table-show-reference 'local))
- (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s"
- dline col
- (if cname (concat " or $" cname) "")
- dline col ref1
- (if name (concat " or $" name) "")
- ;; FIXME: formula info not correct if special table line
- (if eqn
- (concat ", formula: "
- (org-table-formula-to-user
- (concat
- (if (or (string-prefix-p "$" (car eqn))
- (string-prefix-p "@" (car eqn)))
- ""
- "$")
- (car eqn) "=" (cdr eqn))))
- "")))))
- (defun org-table-current-column ()
- "Find out which column we are in."
- (interactive)
- (save-excursion
- (let ((column 0) (pos (point)))
- (beginning-of-line)
- (while (search-forward "|" pos t) (cl-incf column))
- column)))
- (defun org-table-current-dline ()
- "Find out what table data line we are in.
- Only data lines count for this."
- (save-excursion
- (let ((c 0)
- (pos (line-beginning-position)))
- (goto-char (org-table-begin))
- (while (<= (point) pos)
- (when (looking-at org-table-dataline-regexp) (cl-incf c))
- (forward-line))
- c)))
- ;;;###autoload
- (defun org-table-goto-column (n &optional on-delim force)
- "Move the cursor to the Nth column in the current table line.
- With optional argument ON-DELIM, stop with point before the left delimiter
- of the field.
- If there are less than N fields, just go to after the last delimiter.
- However, when FORCE is non-nil, create new columns if necessary."
- (interactive "p")
- (beginning-of-line 1)
- (when (> n 0)
- (while (and (> (setq n (1- n)) -1)
- (or (search-forward "|" (point-at-eol) t)
- (and force
- (progn (end-of-line 1)
- (skip-chars-backward "^|")
- (insert " | ")
- t)))))
- (when (and force (not (looking-at ".*|")))
- (save-excursion (end-of-line 1) (insert " | ")))
- (if on-delim
- (backward-char 1)
- (if (looking-at " ") (forward-char 1)))))
- ;;;###autoload
- (defun org-table-insert-column ()
- "Insert a new column into the table."
- (interactive)
- (unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-find-dataline)
- (let* ((col (max 1 (org-table-current-column)))
- (beg (org-table-begin))
- (end (copy-marker (org-table-end))))
- (org-table-save-field
- (goto-char beg)
- (while (< (point) end)
- (unless (org-at-table-hline-p)
- (org-table-goto-column col t)
- (insert "| "))
- (forward-line)))
- (set-marker end nil)
- (org-table-align)
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas "$" nil (1- col) 1)
- (org-table-fix-formulas "$LR" nil (1- col) 1))))
- (defun org-table-find-dataline ()
- "Find a data line in the current table, which is needed for column commands."
- (if (and (org-at-table-p)
- (not (org-at-table-hline-p)))
- t
- (let ((col (current-column))
- (end (org-table-end)))
- (org-move-to-column col)
- (while (and (< (point) end)
- (or (not (= (current-column) col))
- (org-at-table-hline-p)))
- (beginning-of-line 2)
- (org-move-to-column col))
- (if (and (org-at-table-p)
- (not (org-at-table-hline-p)))
- t
- (user-error
- "Please position cursor in a data line for column operations")))))
- (defun org-table-line-to-dline (line &optional above)
- "Turn a buffer line number into a data line number.
- If there is no data line in this line, return nil.
- If there is no matching dline (most likely the reference was
- a hline), the first dline below it is used. When ABOVE is
- non-nil, the one above is used."
- (let ((min 1)
- (max (1- (length org-table-dlines))))
- (cond ((or (> (aref org-table-dlines min) line)
- (< (aref org-table-dlines max) line))
- nil)
- ((= (aref org-table-dlines max) line) max)
- (t (catch 'exit
- (while (> (- max min) 1)
- (let* ((mean (/ (+ max min) 2))
- (v (aref org-table-dlines mean)))
- (cond ((= v line) (throw 'exit mean))
- ((> v line) (setq max mean))
- (t (setq min mean)))))
- (if above min max))))))
- ;;;###autoload
- (defun org-table-delete-column ()
- "Delete a column from the table."
- (interactive)
- (unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-find-dataline)
- (org-table-check-inside-data-field)
- (let ((col (org-table-current-column))
- (beg (org-table-begin))
- (end (copy-marker (org-table-end))))
- (org-table-save-field
- (goto-char beg)
- (while (< (point) end)
- (if (org-at-table-hline-p)
- nil
- (org-table-goto-column col t)
- (and (looking-at "|[^|\n]+|")
- (replace-match "|")))
- (forward-line)))
- (set-marker end nil)
- (org-table-goto-column (max 1 (1- col)))
- (org-table-align)
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas
- "$" (list (cons (number-to-string col) "INVALID")) col -1 col)
- (org-table-fix-formulas
- "$LR" (list (cons (number-to-string col) "INVALID")) col -1 col))))
- ;;;###autoload
- (defun org-table-move-column-right ()
- "Move column to the right."
- (interactive)
- (org-table-move-column nil))
- ;;;###autoload
- (defun org-table-move-column-left ()
- "Move column to the left."
- (interactive)
- (org-table-move-column 'left))
- ;;;###autoload
- (defun org-table-move-column (&optional left)
- "Move the current column to the right. With arg LEFT, move to the left."
- (interactive "P")
- (unless (org-at-table-p) (user-error "Not at a table"))
- (org-table-find-dataline)
- (org-table-check-inside-data-field)
- (let* ((col (org-table-current-column))
- (col1 (if left (1- col) col))
- (colpos (if left (1- col) (1+ col)))
- (beg (org-table-begin))
- (end (copy-marker (org-table-end))))
- (when (and left (= col 1))
- (user-error "Cannot move column further left"))
- (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$"))
- (user-error "Cannot move column further right"))
- (org-table-save-field
- (goto-char beg)
- (while (< (point) end)
- (unless (org-at-table-hline-p)
- (org-table-goto-column col1 t)
- (when (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|")
- (transpose-regions
- (match-beginning 1) (match-end 1)
- (match-beginning 2) (match-end 2))))
- (forward-line)))
- (set-marker end nil)
- (org-table-goto-column colpos)
- (org-table-align)
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas
- "$" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col))))
- (org-table-fix-formulas
- "$LR" (list (cons (number-to-string col) (number-to-string colpos))
- (cons (number-to-string colpos) (number-to-string col)))))))
- ;;;###autoload
- (defun org-table-move-row-down ()
- "Move table row down."
- (interactive)
- (org-table-move-row nil))
- ;;;###autoload
- (defun org-table-move-row-up ()
- "Move table row up."
- (interactive)
- (org-table-move-row 'up))
- ;;;###autoload
- (defun org-table-move-row (&optional up)
- "Move the current table line down. With arg UP, move it up."
- (interactive "P")
- (let* ((col (current-column))
- (pos (point))
- (hline1p (save-excursion (beginning-of-line 1)
- (looking-at org-table-hline-regexp)))
- (dline1 (org-table-current-dline))
- (dline2 (+ dline1 (if up -1 1)))
- (tonew (if up 0 2))
- hline2p)
- (when (and up (= (point-min) (line-beginning-position)))
- (user-error "Cannot move row further"))
- (beginning-of-line tonew)
- (when (or (and (not up) (eobp)) (not (org-at-table-p)))
- (goto-char pos)
- (user-error "Cannot move row further"))
- (setq hline2p (looking-at org-table-hline-regexp))
- (goto-char pos)
- (let ((row (delete-and-extract-region (line-beginning-position)
- (line-beginning-position 2))))
- (beginning-of-line tonew)
- (unless (bolp) (insert "\n")) ;at eob without a newline
- (insert row)
- (unless (bolp) (insert "\n")) ;missing final newline in ROW
- (beginning-of-line 0)
- (org-move-to-column col)
- (unless (or hline1p hline2p
- (not (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm
- "Fix formulas? "))))
- (org-table-fix-formulas
- "@" (list
- (cons (number-to-string dline1) (number-to-string dline2))
- (cons (number-to-string dline2) (number-to-string dline1))))))))
- ;;;###autoload
- (defun org-table-insert-row (&optional arg)
- "Insert a new row above the current line into the table.
- With prefix ARG, insert below the current line."
- (interactive "P")
- (unless (org-at-table-p) (user-error "Not at a table"))
- (let* ((line (buffer-substring (line-beginning-position) (line-end-position)))
- (new (org-table-clean-line line)))
- ;; Fix the first field if necessary
- (if (string-match "^[ \t]*| *[#$] *|" line)
- (setq new (replace-match (match-string 0 line) t t new)))
- (beginning-of-line (if arg 2 1))
- ;; Buffer may not end of a newline character, so ensure
- ;; (beginning-of-line 2) moves point to a new line.
- (unless (bolp) (insert "\n"))
- (let (org-table-may-need-update) (insert-before-markers new "\n"))
- (beginning-of-line 0)
- (re-search-forward "| ?" (line-end-position) t)
- (when (or org-table-may-need-update org-table-overlay-coordinates)
- (org-table-align))
- (when (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? "))
- (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1))))
- ;;;###autoload
- (defun org-table-insert-hline (&optional above)
- "Insert a horizontal-line below the current line into the table.
- With prefix ABOVE, insert above the current line."
- (interactive "P")
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
- (when (eobp) (insert "\n") (backward-char 1))
- (if (not (string-match-p "|[ \t]*$" (org-current-line-string)))
- (org-table-align))
- (let ((line (org-table-clean-line
- (buffer-substring (point-at-bol) (point-at-eol))))
- (col (current-column)))
- (while (string-match "|\\( +\\)|" line)
- (setq line (replace-match
- (concat "+" (make-string (- (match-end 1) (match-beginning 1))
- ?-) "|") t t line)))
- (and (string-match "\\+" line) (setq line (replace-match "|" t t line)))
- (beginning-of-line (if above 1 2))
- (insert line "\n")
- (beginning-of-line (if above 1 -1))
- (org-move-to-column col)
- (and org-table-overlay-coordinates (org-table-align))))
- ;;;###autoload
- (defun org-table-hline-and-move (&optional same-column)
- "Insert a hline and move to the row below that line."
- (interactive "P")
- (let ((col (org-table-current-column)))
- (org-table-maybe-eval-formula)
- (org-table-maybe-recalculate-line)
- (org-table-insert-hline)
- (end-of-line 2)
- (if (looking-at "\n[ \t]*|-")
- (progn (insert "\n|") (org-table-align))
- (org-table-next-field))
- (if same-column (org-table-goto-column col))))
- (defun org-table-clean-line (s)
- "Convert a table line S into a string with only \"|\" and space.
- In particular, this does handle wide and invisible characters."
- (if (string-match "^[ \t]*|-" s)
- ;; It's a hline, just map the characters
- (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s ""))
- (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s)
- (setq s (replace-match
- (concat "|" (make-string (org-string-width (match-string 1 s))
- ?\ ) "|")
- t t s)))
- s))
- ;;;###autoload
- (defun org-table-kill-row ()
- "Delete the current row or horizontal line from the table."
- (interactive)
- (if (not (org-at-table-p))
- (user-error "Not at a table"))
- (let ((col (current-column))
- (dline (and (not (org-match-line org-table-hline-regexp))
- (org-table-current-dline))))
- (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max)))
- (if (not (org-at-table-p)) (beginning-of-line 0))
- (org-move-to-column col)
- (when (and dline
- (or (not org-table-fix-formulas-confirm)
- (funcall org-table-fix-formulas-confirm "Fix formulas? ")))
- (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID"))
- dline -1 dline))))
- ;;;###autoload
- (defun org-table-sort-lines
- (&optional with-case sorting-type getkey-func compare-func interactive?)
- "Sort table lines according to the column at point.
- The position of point indicates the column to be used for
- sorting, and the range of lines is the range between the nearest
- horizontal separator lines, or the entire table of no such lines
- exist. If point is before the first column, you will be prompted
- for the sorting column. If there is an active region, the mark
- specifies the first line and the sorting column, while point
- should be in the last line to be included into the sorting.
- The command then prompts for the sorting type which can be
- alphabetically, numerically, or by time (as given in a time stamp
- in the field, or as a HH:MM value). Sorting in reverse order is
- also possible.
- With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive.
- If SORTING-TYPE is specified when this function is called from a Lisp
- program, no prompting will take place. SORTING-TYPE must be a character,
- any of (?a ?A ?n ?N ?t ?T ?f ?F) where the capital letters indicate that
- sorting should be done in reverse order.
- If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies
- a function to be called to extract the key. It must return a value
- that is compatible with COMPARE-FUNC, the function used to compare
- entries.
- A non-nil value for INTERACTIVE? is used to signal that this
- function is being called interactively."
- (interactive (list current-prefix-arg nil nil nil t))
- (when (org-region-active-p) (goto-char (region-beginning)))
- ;; Point must be either within a field or before a data line.
- (save-excursion
- (skip-chars-backward " \t")
- (when (bolp) (search-forward "|" (line-end-position) t))
- (org-table-check-inside-data-field))
- ;; Set appropriate case sensitivity and column used for sorting.
- (let ((column (let ((c (org-table-current-column)))
- (cond ((> c 0) c)
- (interactive?
- (read-number "Use column N for sorting: "))
- (t 1))))
- (sorting-type
- (or sorting-type
- (read-char-exclusive "Sort Table: [a]lphabetic, [n]umeric, \
- \[t]ime, [f]unc. A/N/T/F means reversed: "))))
- (save-restriction
- ;; Narrow buffer to appropriate sorting area.
- (if (org-region-active-p)
- (progn (goto-char (region-beginning))
- (narrow-to-region
- (point)
- (save-excursion (goto-char (region-end))
- (line-beginning-position 2))))
- (let ((start (org-table-begin))
- (end (org-table-end)))
- (narrow-to-region
- (save-excursion
- (if (re-search-backward org-table-hline-regexp start t)
- (line-beginning-position 2)
- start))
- (if (save-excursion (re-search-forward org-table-hline-regexp end t))
- (match-beginning 0)
- end))))
- ;; Determine arguments for `sort-subr'. Also record original
- ;; position. `org-table-save-field' cannot help here since
- ;; sorting is too much destructive.
- (let* ((sort-fold-case (not with-case))
- (coordinates
- (cons (count-lines (point-min) (line-beginning-position))
- (current-column)))
- (extract-key-from-field
- ;; Function to be called on the contents of the field
- ;; used for sorting in the current row.
- (cl-case sorting-type
- ((?n ?N) #'string-to-number)
- ((?a ?A) #'org-sort-remove-invisible)
- ((?t ?T)
- (lambda (f)
- (cond ((string-match org-ts-regexp-both f)
- (float-time
- (org-time-string-to-time (match-string 0 f))))
- ((org-duration-p f) (org-duration-to-minutes f))
- ((string-match "\\<[0-9]+:[0-9]\\{2\\}\\>" f)
- (org-duration-to-minutes (match-string 0 f)))
- (t 0))))
- ((?f ?F)
- (or getkey-func
- (and interactive?
- (org-read-function "Function for extracting keys: "))
- (error "Missing key extractor to sort rows")))
- (t (user-error "Invalid sorting type `%c'" sorting-type))))
- (predicate
- (cl-case sorting-type
- ((?n ?N ?t ?T) #'<)
- ((?a ?A) #'string<)
- ((?f ?F)
- (or compare-func
- (and interactive?
- (org-read-function
- (concat "Function for comparing keys "
- "(empty for default `sort-subr' predicate): ")
- 'allow-empty)))))))
- (goto-char (point-min))
- (sort-subr (memq sorting-type '(?A ?N ?T ?F))
- (lambda ()
- (forward-line)
- (while (and (not (eobp))
- (not (looking-at org-table-dataline-regexp)))
- (forward-line)))
- #'end-of-line
- (lambda ()
- (funcall extract-key-from-field
- (org-trim (org-table-get-field column))))
- nil
- predicate)
- ;; Move back to initial field.
- (forward-line (car coordinates))
- (move-to-column (cdr coordinates))))))
- ;;;###autoload
- (defun org-table-cut-region (beg end)
- "Copy region in table to the clipboard and blank all relevant fields.
- If there is no active region, use just the field at point."
- (interactive (list
- (if (org-region-active-p) (region-beginning) (point))
- (if (org-region-active-p) (region-end) (point))))
- (org-table-copy-region beg end 'cut))
- ;;;###autoload
- (defun org-table-copy-region (beg end &optional cut)
- "Copy rectangular region in table to clipboard.
- A special clipboard is used which can only be accessed
- with `org-table-paste-rectangle'."
- (interactive (list
- (if (org-region-active-p) (region-beginning) (point))
- (if (org-region-active-p) (region-end) (point))
- current-prefix-arg))
- (goto-char (min beg end))
- (org-table-check-inside-data-field)
- (let ((beg (line-beginning-position))
- (c01 (org-table-current-column))
- region)
- (goto-char (max beg end))
- (org-table-check-inside-data-field)
- (let* ((end (copy-marker (line-end-position)))
- (c02 (org-table-current-column))
- (column-start (min c01 c02))
- (column-end (max c01 c02))
- (column-number (1+ (- column-end column-start)))
- (rpl (and cut " ")))
- (goto-char beg)
- (while (< (point) end)
- (unless (org-at-table-hline-p)
- ;; Collect every cell between COLUMN-START and COLUMN-END.
- (let (cols)
- (dotimes (c column-number)
- (push (org-table-get-field (+ c column-start) rpl) cols))
- (push (nreverse cols) region)))
- (forward-line))
- (set-marker end nil))
- (when cut (org-table-align))
- (setq org-table-clip (nreverse region))))
- ;;;###autoload
- (defun org-table-paste-rectangle ()
- "Paste a rectangular region into a table.
- The upper right corner ends up in the current field. All involved fields
- will be overwritten. If the rectangle does not fit into the present table,
- the table is enlarged as needed. The process ignores horizontal separator
- lines."
- (interactive)
- (unless (consp org-table-clip)
- (user-error "First cut/copy a region to paste!"))
- (org-table-check-inside-data-field)
- (let* ((column (org-table-current-column))
- (org-table-automatic-realign nil))
- (org-table-save-field
- (dolist (row org-table-clip)
- (while (org-at-table-hline-p) (forward-line))
- ;; If we left the table, create a new row.
- (when (and (bolp) (not (looking-at "[ \t]*|")))
- (end-of-line 0)
- (org-table-next-field))
- (let ((c column))
- (dolist (field row)
- (org-table-goto-column c nil 'force)
- (org-table-get-field nil field)
- (cl-incf c)))
- (forward-line)))
- (org-table-align)))
- ;;;###autoload
- (defun org-table-convert ()
- "Convert from `org-mode' table to table.el and back.
- Obviously, this only works within limits. When an Org table is converted
- to table.el, all horizontal separator lines get lost, because table.el uses
- these as cell boundaries and has no notion of horizontal lines. A table.el
- table can be converted to an Org table only if it does not do row or column
- spanning. Multiline cells will become multiple cells. Beware, Org mode
- does not test if the table can be successfully converted - it blindly
- applies a recipe that works for simple tables."
- (interactive)
- (require 'table)
- (if (org-at-table.el-p)
- ;; convert to Org table
- (let ((beg (copy-marker (org-table-begin t)))
- (end (copy-marker (org-table-end t))))
- (table-unrecognize-region beg end)
- (goto-char beg)
- (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t)
- (replace-match ""))
- (goto-char beg))
- (if (org-at-table-p)
- ;; convert to table.el table
- (let ((beg (copy-marker (org-table-begin)))
- (end (copy-marker (org-table-end))))
- ;; first, get rid of all horizontal lines
- (goto-char beg)
- (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t)
- (replace-match ""))
- ;; insert a hline before first
- (goto-char beg)
- (org-table-insert-hline 'above)
- (beginning-of-line -1)
- ;; insert a hline after each line
- (while (progn (beginning-of-line 3) (< (point) end))
- (org-table-insert-hline))
- (goto-char beg)
- (setq end (move-marker end (org-table-end)))
- ;; replace "+" at beginning and ending of hlines
- (while (re-search-forward "^\\([ \t]*\\)|-" end t)
- (replace-match "\\1+-"))
- (goto-char beg)
- (while (re-search-forward "-|[ \t]*$" end t)
- (replace-match "-+"))
- (goto-char beg)))))
- (defun org-table-transpose-table-at-point ()
- "Transpose Org table at point and eliminate hlines.
- So a table like
- | 1 | 2 | 4 | 5 |
- |---+---+---+---|
- | a | b | c | d |
- | e | f | g | h |
- will be transposed as
- | 1 | a | e |
- | 2 | b | f |
- | 4 | c | g |
- | 5 | d | h |
- Note that horizontal lines disappear."
- (interactive)
- (let* ((table (delete 'hline (org-table-to-lisp)))
- (dline_old (org-table-current-line))
- (col_old (org-table-current-column))
- (contents (mapcar (lambda (_)
- (let ((tp table))
- (mapcar
- (lambda (_)
- (prog1
- (pop (car tp))
- (setq tp (cdr tp))))
- table)))
- (car table))))
- (goto-char (org-table-begin))
- (re-search-forward "|")
- (backward-char)
- (delete-region (point) (org-table-end))
- (insert (mapconcat
- (lambda(x)
- (concat "| " (mapconcat 'identity x " | " ) " |\n" ))
- contents ""))
- (org-table-goto-line col_old)
- (org-table-goto-column dline_old))
- (org-table-align))
- ;;;###autoload
- (defun org-table-wrap-region (arg)
- "Wrap several fields in a column like a paragraph.
- This is useful if you'd like to spread the contents of a field over several
- lines, in order to keep the table compact.
- If there is an active region, and both point and mark are in the same column,
- the text in the column is wrapped to minimum width for the given number of
- lines. Generally, this makes the table more compact. A prefix ARG may be
- used to change the number of desired lines. For example, \
- `C-2 \\[org-table-wrap-region]'
- formats the selected text to two lines. If the region was longer than two
- lines, the remaining lines remain empty. A negative prefix argument reduces
- the current number of lines by that amount. The wrapped text is pasted back
- into the table. If you formatted it to more lines than it was before, fields
- further down in the table get overwritten - so you might need to make space in
- the table first.
- If there is no region, the current field is split at the cursor position and
- the text fragment to the right of the cursor is prepended to the field one
- line down.
- If there is no region, but you specify a prefix ARG, the current field gets
- blank, and the content is appended to the field above."
- (interactive "P")
- (org-table-check-inside-data-field)
- (if (org-region-active-p)
- ;; There is a region: fill as a paragraph.
- (let ((start (region-beginning)))
- (org-table-cut-region (region-beginning) (region-end))
- (when (> (length (car org-table-clip)) 1)
- (user-error "Region must be limited to single column"))
- (let ((nlines (cond ((not arg) (length org-table-clip))
- ((< arg 1) (+ (length org-table-clip) arg))
- (t arg))))
- (setq org-table-clip
- (mapcar #'list
- (org-wrap (mapconcat #'car org-table-clip " ")
- nil
- nlines))))
- (goto-char start)
- (org-table-paste-rectangle))
- ;; No region, split the current field at point.
- (unless (org-get-alist-option org-M-RET-may-split-line 'table)
- (skip-chars-forward "^\r\n|"))
- (cond
- (arg ; Combine with field above.
- (let ((s (org-table-blank-field))
- (col (org-table-current-column)))
- (forward-line -1)
- (while (org-at-table-hline-p) (forward-line -1))
- (org-table-goto-column col)
- (skip-chars-forward "^|")
- (skip-chars-backward " ")
- (insert " " (org-trim s))
- (org-table-align)))
- ((looking-at "\\([^|]+\\)+|") ; Split field.
- (let ((s (match-string 1)))
- (replace-match " |")
- (goto-char (match-beginning 0))
- (org-table-next-row)
- (insert (org-trim s) " ")
- (org-table-align)))
- (t (org-table-next-row)))))
- (defvar org-field-marker nil)
- ;;;###autoload
- (defun org-table-edit-field (arg)
- "Edit table field in a different window.
- This is mainly useful for fields that contain hidden parts.
- When called with a `\\[universal-argument]' prefix, just make the full field
- visible so that it can be edited in place.
- When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
- toggle `org-table-follow-field-mode'."
- (interactive "P")
- (unless (org-at-table-p) (user-error "Not at a table"))
- (cond
- ((equal arg '(16))
- (org-table-follow-field-mode (if org-table-follow-field-mode -1 1)))
- (arg
- (let ((b (save-excursion (skip-chars-backward "^|") (point)))
- (e (save-excursion (skip-chars-forward "^|\r\n") (point))))
- (remove-text-properties b e '(org-cwidth t invisible t
- display t intangible t))
- (if (and (boundp 'font-lock-mode) font-lock-mode)
- (font-lock-fontify-block))))
- (t
- (let ((pos (point-marker))
- (coord
- (if (eq org-table-use-standard-references t)
- (concat (org-number-to-letters (org-table-current-column))
- (int-to-string (org-table-current-dline)))
- (concat "@" (int-to-string (org-table-current-dline))
- "$" (int-to-string (org-table-current-column)))))
- (field (org-table-get-field))
- (cw (current-window-configuration))
- p)
- (goto-char pos)
- (org-switch-to-buffer-other-window "*Org Table Edit Field*")
- (when (and (local-variable-p 'org-field-marker)
- (markerp org-field-marker))
- (move-marker org-field-marker nil))
- (erase-buffer)
- (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n")
- (let ((org-inhibit-startup t)) (org-mode))
- (auto-fill-mode -1)
- (setq truncate-lines nil)
- (setq word-wrap t)
- (goto-char (setq p (point-max)))
- (insert (org-trim field))
- (remove-text-properties p (point-max)
- '(invisible t org-cwidth t display t
- intangible t))
- (goto-char p)
- (setq-local org-finish-function 'org-table-finish-edit-field)
- (setq-local org-window-configuration cw)
- (setq-local org-field-marker pos)
- (message "Edit and finish with C-c C-c")))))
- (defun org-table-finish-edit-field ()
- "Finish editing a table data field.
- Remove all newline characters, insert the result into the table, realign
- the table and kill the editing buffer."
- (let ((pos org-field-marker)
- (cw org-window-configuration)
- (cb (current-buffer))
- text)
- (goto-char (point-min))
- (while (re-search-forward "^#.*\n?" nil t) (replace-match ""))
- (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t)
- (replace-match " "))
- (setq text (org-trim (buffer-string)))
- (set-window-configuration cw)
- (kill-buffer cb)
- (select-window (get-buffer-window (marker-buffer pos)))
- (goto-char pos)
- (move-marker pos nil)
- (org-table-check-inside-data-field)
- (org-table-get-field nil text)
- (org-table-align)
- (message "New field value inserted")))
- (define-minor-mode org-table-follow-field-mode
- "Minor mode to make the table field editor window follow the cursor.
- When this mode is active, the field editor window will always show the
- current field. The mode exits automatically when the cursor leaves the
- table (but see `org-table-exit-follow-field-mode-when-leaving-table')."
- nil " TblFollow" nil
- (if org-table-follow-field-mode
- (add-hook 'post-command-hook 'org-table-follow-fields-with-editor
- 'append 'local)
- (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local)
- (let* ((buf (get-buffer "*Org Table Edit Field*"))
- (win (and buf (get-buffer-window buf))))
- (when win (delete-window win))
- (when buf
- (with-current-buffer buf
- (move-marker org-field-marker nil))
- (kill-buffer buf)))))
- (defun org-table-follow-fields-with-editor ()
- (if (and org-table-exit-follow-field-mode-when-leaving-table
- (not (org-at-table-p)))
- ;; We have left the table, exit the follow mode
- (org-table-follow-field-mode -1)
- (when (org-table-check-inside-data-field 'noerror)
- (let ((win (selected-window)))
- (org-table-edit-field nil)
- (org-fit-window-to-buffer)
- (select-window win)))))
- (defvar org-timecnt) ; dynamically scoped parameter
- ;;;###autoload
- (defun org-table-sum (&optional beg end nlast)
- "Sum numbers in region of current table column.
- The result will be displayed in the echo area, and will be available
- as kill to be inserted with \\[yank].
- If there is an active region, it is interpreted as a rectangle and all
- numbers in that rectangle will be summed. If there is no active
- region and point is located in a table column, sum all numbers in that
- column.
- If at least one number looks like a time HH:MM or HH:MM:SS, all other
- numbers are assumed to be times as well (in decimal hours) and the
- numbers are added as such.
- If NLAST is a number, only the NLAST fields will actually be summed."
- (interactive)
- (save-excursion
- (let (col (org-timecnt 0) diff h m s org-table-clip)
- (cond
- ((and beg end)) ; beg and end given explicitly
- ((org-region-active-p)
- (setq beg (region-beginning) end (region-end)))
- (t
- (setq col (org-table-current-column))
- (goto-char (org-table-begin))
- (unless (re-search-forward "^[ \t]*|[^-]" nil t)
- (user-error "No table data"))
- (org-table-goto-column col)
- (setq beg (point))
- (goto-char (org-table-end))
- (unless (re-search-backward "^[ \t]*|[^-]" nil t)
- (user-error "No table data"))
- (org-table-goto-column col)
- (setq end (point))))
- (let* ((items (apply 'append (org-table-copy-region beg end)))
- (items1 (cond ((not nlast) items)
- ((>= nlast (length items)) items)
- (t (setq items (reverse items))
- (setcdr (nthcdr (1- nlast) items) nil)
- (nreverse items))))
- (numbers (delq nil (mapcar 'org-table-get-number-for-summing
- items1)))
- (res (apply '+ numbers))
- (sres (if (= org-timecnt 0)
- (number-to-string res)
- (setq diff (* 3600 res)
- h (floor (/ diff 3600)) diff (mod diff 3600)
- m (floor (/ diff 60)) diff (mod diff 60)
- s diff)
- (format "%.0f:%02.0f:%02.0f" h m s))))
- (kill-new sres)
- (when (called-interactively-p 'interactive)
- (message "%s" (substitute-command-keys
- (format "Sum of %d items: %-20s \
- \(\\[yank] will insert result into buffer)" (length numbers) sres))))
- sres))))
- (defun org-table-get-number-for-summing (s)
- (let (n)
- (if (string-match "^ *|? *" s)
- (setq s (replace-match "" nil nil s)))
- (if (string-match " *|? *$" s)
- (setq s (replace-match "" nil nil s)))
- (setq n (string-to-number s))
- (cond
- ((and (string-match "0" s)
- (string-match "\\`[-+ \t0.edED]+\\'" s)) 0)
- ((string-match "\\`[ \t]+\\'" s) nil)
- ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s)
- (let ((h (string-to-number (or (match-string 1 s) "0")))
- (m (string-to-number (or (match-string 2 s) "0")))
- (s (string-to-number (or (match-string 4 s) "0"))))
- (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt)))
- (* 1.0 (+ h (/ m 60.0) (/ s 3600.0)))))
- ((equal n 0) nil)
- (t n))))
- (defun org-table-current-field-formula (&optional key noerror)
- "Return the formula active for the current field.
- Assumes that table is already analyzed. If KEY is given, return
- the key to this formula. Otherwise return the formula preceded
- with \"=\" or \":=\"."
- (let* ((line (count-lines org-table-current-begin-pos
- (line-beginning-position)))
- (row (org-table-line-to-dline line)))
- (cond
- (row
- (let* ((col (org-table-current-column))
- (name (car (rassoc (list line col)
- org-table-named-field-locations)))
- (scol (format "$%d" col))
- (ref (format "@%d$%d" (org-table-current-dline) col))
- (stored-list (org-table-get-stored-formulas noerror))
- (ass (or (assoc name stored-list)
- (assoc ref stored-list)
- (assoc scol stored-list))))
- (cond (key (car ass))
- (ass (concat (if (string-match-p "^[0-9]+$" (car ass)) "=" ":=")
- (cdr ass))))))
- (noerror nil)
- (t (error "No formula active for the current field")))))
- (defun org-table-get-formula (&optional equation named)
- "Read a formula from the minibuffer, offer stored formula as default.
- When NAMED is non-nil, look for a named equation."
- (let* ((stored-list (org-table-get-stored-formulas))
- (name (car (rassoc (list (count-lines org-table-current-begin-pos
- (line-beginning-position))
- (org-table-current-column))
- org-table-named-field-locations)))
- (ref (format "@%d$%d"
- (org-table-current-dline)
- (org-table-current-column)))
- (scol (cond
- ((not named) (format "$%d" (org-table-current-column)))
- ((and name (not (string-match "\\`LR[0-9]+\\'" name))) name)
- (t ref)))
- (name (or name ref))
- (org-table-may-need-update nil)
- (stored (cdr (assoc scol stored-list)))
- (eq (cond
- ((and stored equation (string-match-p "^ *=? *$" equation))
- stored)
- ((stringp equation)
- equation)
- (t (org-table-formula-from-user
- (read-string
- (org-table-formula-to-user
- (format "%s formula %s="
- (if named "Field" "Column")
- scol))
- (if stored (org-table-formula-to-user stored) "")
- 'org-table-formula-history
- )))))
- mustsave)
- (when (not (string-match "\\S-" eq))
- ;; remove formula
- (setq stored-list (delq (assoc scol stored-list) stored-list))
- (org-table-store-formulas stored-list)
- (user-error "Formula removed"))
- (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq)))
- (if (string-match " *$" eq) (setq eq (replace-match "" t t eq)))
- (if (and name (not named))
- ;; We set the column equation, delete the named one.
- (setq stored-list (delq (assoc name stored-list) stored-list)
- mustsave t))
- (if stored
- (setcdr (assoc scol stored-list) eq)
- (setq stored-list (cons (cons scol eq) stored-list)))
- (if (or mustsave (not (equal stored eq)))
- (org-table-store-formulas stored-list))
- eq))
- (defun org-table-store-formulas (alist &optional location)
- "Store the list of formulas below the current table.
- If optional argument LOCATION is a buffer position, insert it at
- LOCATION instead."
- (save-excursion
- (if location
- (progn (goto-char location) (beginning-of-line))
- (goto-char (org-table-end)))
- (let ((case-fold-search t))
- (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+TBLFM:\\)\\(.*\n?\\)")
- (progn
- ;; Don't overwrite TBLFM, we might use text properties to
- ;; store stuff.
- (goto-char (match-beginning 3))
- (delete-region (match-beginning 3) (match-end 0)))
- (org-indent-line)
- (insert (or (match-string 2) "#+TBLFM:")))
- (insert " "
- (mapconcat (lambda (x) (concat (car x) "=" (cdr x)))
- (sort alist #'org-table-formula-less-p)
- "::")
- "\n"))))
- (defsubst org-table-formula-make-cmp-string (a)
- (when (string-match "\\`$[<>]" a)
- (let ((arrow (string-to-char (substring a 1))))
- ;; Fake a high number to make sure this is sorted at the end.
- (setq a (org-table-formula-handle-first/last-rc a))
- (setq a (format "$%d" (+ 10000
- (if (= arrow ?<) -1000 0)
- (string-to-number (substring a 1)))))))
- (when (string-match
- "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?"
- a)
- (concat
- (if (match-end 2)
- (format "@%05d" (string-to-number (match-string 2 a))) "")
- (if (match-end 4)
- (format "$%05d" (string-to-number (match-string 4 a))) "")
- (if (match-end 5)
- (concat "@@" (match-string 5 a))))))
- (defun org-table-formula-less-p (a b)
- "Compare two formulas for sorting."
- (let ((as (org-table-formula-make-cmp-string (car a)))
- (bs (org-table-formula-make-cmp-string (car b))))
- (and as bs (string< as bs))))
- ;;;###autoload
- (defun org-table-get-stored-formulas (&optional noerror location)
- "Return an alist with the stored formulas directly after current table.
- By default, only return active formulas, i.e., formulas located
- on the first line after the table. However, if optional argument
- LOCATION is a buffer position, consider the formulas there."
- (save-excursion
- (if location
- (progn (goto-char location) (beginning-of-line))
- (goto-char (org-table-end)))
- (let ((case-fold-search t))
- (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+TBLFM: *\\(.*\\)")
- (let ((strings (org-split-string (match-string-no-properties 2)
- " *:: *"))
- eq-alist seen)
- (dolist (string strings (nreverse eq-alist))
- (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|\\$\\([_a-zA-Z0-9]+\\|\
- [<>]+\\)\\) *= *\\(.*[^ \t]\\)"
- string)
- (let ((lhs
- (let ((m (match-string 1 string)))
- (cond
- ((not (match-end 2)) m)
- ;; Is it a column reference?
- ((string-match-p "\\`$\\([0-9]+\\|[<>]+\\)\\'" m) m)
- ;; Since named columns are not possible in
- ;; LHS, assume this is a named field.
- (t (match-string 2 string)))))
- (rhs (match-string 3 string)))
- (push (cons lhs rhs) eq-alist)
- (cond
- ((not (member lhs seen)) (push lhs seen))
- (noerror
- (message
- "Double definition `%s=' in TBLFM line, please fix by hand"
- lhs)
- (ding)
- (sit-for 2))
- (t
- (user-error
- "Double definition `%s=' in TBLFM line, please fix by hand"
- lhs)))))))))))
- (defun org-table-fix-formulas (key replace &optional limit delta remove)
- "Modify the equations after the table structure has been edited.
- KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace.
- For all numbers larger than LIMIT, shift them by DELTA."
- (save-excursion
- (goto-char (org-table-end))
- (while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:"))
- (let ((msg "The formulas in #+TBLFM have been updated")
- (re (concat key "\\([0-9]+\\)"))
- (re2
- (when remove
- (if (or (equal key "$") (equal key "$LR"))
- (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)"
- (regexp-quote key) remove)
- (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove))))
- s n a)
- (when remove
- (while (re-search-forward re2 (point-at-eol) t)
- (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
- (if (equal (char-before (match-beginning 0)) ?.)
- (user-error
- "Change makes TBLFM term %s invalid, use undo to recover"
- (match-string 0))
- (replace-match "")))))
- (while (re-search-forward re (point-at-eol) t)
- (unless (save-match-data (org-in-regexp "remote([^)]+?)"))
- (setq s (match-string 1) n (string-to-number s))
- (cond
- ((setq a (assoc s replace))
- (replace-match (concat key (cdr a)) t t)
- (message msg))
- ((and limit (> n limit))
- (replace-match (concat key (int-to-string (+ n delta))) t t)
- (message msg))))))
- (forward-line))))
- ;;;###autoload
- (defun org-table-maybe-eval-formula ()
- "Check if the current field starts with \"=\" or \":=\".
- If yes, store the formula and apply it."
- ;; We already know we are in a table. Get field will only return a formula
- ;; when appropriate. It might return a separator line, but no problem.
- (when org-table-formula-evaluate-inline
- (let* ((field (org-trim (or (org-table-get-field) "")))
- named eq)
- (when (string-match "^:?=\\(.*[^=]\\)$" field)
- (setq named (equal (string-to-char field) ?:)
- eq (match-string 1 field))
- (org-table-eval-formula (and named '(4))
- (org-table-formula-from-user eq))))))
- (defvar org-recalc-commands nil
- "List of commands triggering the recalculation of a line.
- Will be filled automatically during use.")
- (defvar org-recalc-marks
- '((" " . "Unmarked: no special line, no automatic recalculation")
- ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line")
- ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'")
- ("!" . "Column name definition line. Reference in formula as $name.")
- ("$" . "Parameter definition line name=value. Reference in formula as $name.")
- ("_" . "Names for values in row below this one.")
- ("^" . "Names for values in row above this one.")))
- ;;;###autoload
- (defun org-table-rotate-recalc-marks (&optional newchar)
- "Rotate the recalculation mark in the first column.
- If in any row, the first field is not consistent with a mark,
- insert a new column for the markers.
- When there is an active region, change all the lines in the region,
- after prompting for the marking character.
- After each change, a message will be displayed indicating the meaning
- of the new mark."
- (interactive)
- (unless (org-at-table-p) (user-error "Not at a table"))
- (let* ((region (org-region-active-p))
- (l1 (and region
- (save-excursion (goto-char (region-beginning))
- (copy-marker (line-beginning-position)))))
- (l2 (and region
- (save-excursion (goto-char (region-end))
- (copy-marker (line-beginning-position)))))
- (l (copy-marker (line-beginning-position)))
- (col (org-table-current-column))
- (newchar (if region
- (char-to-string
- (read-char-exclusive
- "Change region to what mark? Type # * ! $ or SPC: "))
- newchar))
- (no-special-column
- (save-excursion
- (goto-char (org-table-begin))
- (re-search-forward
- "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" (org-table-end) t))))
- (when (and newchar (not (assoc newchar org-recalc-marks)))
- (user-error "Invalid character `%s' in `org-table-rotate-recalc-marks'"
- newchar))
- (when l1 (goto-char l1))
- (save-excursion
- (beginning-of-line)
- (unless (looking-at org-table-dataline-regexp)
- (user-error "Not at a table data line")))
- (when no-special-column
- (org-table-goto-column 1)
- (org-table-insert-column))
- (let ((previous-line-end (line-end-position))
- (newchar
- (save-excursion
- (beginning-of-line)
- (cond ((not (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|")) "#")
- (newchar)
- (t (cadr (member (match-string 1)
- (append (mapcar #'car org-recalc-marks)
- '(" ")))))))))
- ;; Rotate mark in first row.
- (org-table-get-field 1 (format " %s " newchar))
- ;; Rotate marks in additional rows if a region is active.
- (when region
- (save-excursion
- (forward-line)
- (while (<= (point) l2)
- (when (looking-at org-table-dataline-regexp)
- (org-table-get-field 1 (format " %s " newchar)))
- (forward-line))))
- ;; Only align if rotation actually changed lines' length.
- (when (/= previous-line-end (line-end-position)) (org-table-align)))
- (goto-char l)
- (org-table-goto-column (if no-special-column (1+ col) col))
- (when l1 (set-marker l1 nil))
- (when l2 (set-marker l2 nil))
- (set-marker l nil)
- (when (called-interactively-p 'interactive)
- (message "%s" (cdr (assoc newchar org-recalc-marks))))))
- ;;;###autoload
- (defun org-table-analyze ()
- "Analyze table at point and store results.
- This function sets up the following dynamically scoped variables:
- `org-table-column-name-regexp',
- `org-table-column-names',
- `org-table-current-begin-pos',
- `org-table-current-line-types',
- `org-table-current-ncol',
- `org-table-dlines',
- `org-table-hlines',
- `org-table-local-parameters',
- `org-table-named-field-locations'."
- (let ((beg (org-table-begin))
- (end (org-table-end)))
- (save-excursion
- (goto-char beg)
- ;; Extract column names.
- (setq org-table-column-names nil)
- (when (save-excursion
- (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t))
- (let ((c 1))
- (dolist (name (org-split-string (match-string 1) " *| *"))
- (cl-incf c)
- (when (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" name)
- (push (cons name (int-to-string c)) org-table-column-names)))))
- (setq org-table-column-names (nreverse org-table-column-names))
- (setq org-table-column-name-regexp
- (format "\\$\\(%s\\)\\>"
- (regexp-opt (mapcar #'car org-table-column-names) t)))
- ;; Extract local parameters.
- (setq org-table-local-parameters nil)
- (save-excursion
- (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t)
- (dolist (field (org-split-string (match-string 1) " *| *"))
- (when (string-match
- "\\`\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field)
- (push (cons (match-string 1 field) (match-string 2 field))
- org-table-local-parameters)))))
- ;; Update named fields locations. We minimize `count-lines'
- ;; processing by storing last known number of lines in LAST.
- (setq org-table-named-field-locations nil)
- (save-excursion
- (let ((last (cons (point) 0)))
- (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t)
- (let ((c (match-string 1))
- (fields (org-split-string (match-string 2) " *| *")))
- (save-excursion
- (forward-line (if (equal c "_") 1 -1))
- (let ((fields1
- (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)")
- (org-split-string (match-string 1) " *| *")))
- (line (cl-incf (cdr last) (count-lines (car last) (point))))
- (col 1))
- (setcar last (point)) ; Update last known position.
- (while (and fields fields1)
- (let ((field (pop fields))
- (v (pop fields1)))
- (cl-incf col)
- (when (and (stringp field)
- (stringp v)
- (string-match "\\`[a-zA-Z][_a-zA-Z0-9]*\\'"
- field))
- (push (cons field v) org-table-local-parameters)
- (push (list field line col)
- org-table-named-field-locations))))))))))
- ;; Re-use existing markers when possible.
- (if (markerp org-table-current-begin-pos)
- (move-marker org-table-current-begin-pos (point))
- (setq org-table-current-begin-pos (point-marker)))
- ;; Analyze the line types.
- (let ((l 0) hlines dlines types)
- (while (looking-at "[ \t]*|\\(-\\)?")
- (push (if (match-end 1) 'hline 'dline) types)
- (if (match-end 1) (push l hlines) (push l dlines))
- (forward-line)
- (cl-incf l))
- (push 'hline types) ; Add an imaginary extra hline to the end.
- (setq org-table-current-line-types (apply #'vector (nreverse types)))
- (setq org-table-dlines (apply #'vector (cons nil (nreverse dlines))))
- (setq org-table-hlines (apply #'vector (cons nil (nreverse hlines)))))
- ;; Get the number of columns from the first data line in table.
- (goto-char beg)
- (forward-line (aref org-table-dlines 1))
- (let* ((fields
- (org-split-string
- (buffer-substring (line-beginning-position) (line-end-position))
- "[ \t]*|[ \t]*"))
- (nfields (length fields))
- al al2)
- (setq org-table-current-ncol nfields)
- (let ((last-dline
- (aref org-table-dlines (1- (length org-table-dlines)))))
- (dotimes (i nfields)
- (let ((column (1+ i)))
- (push (list (format "LR%d" column) last-dline column) al)
- (push (cons (format "LR%d" column) (nth i fields)) al2))))
- (setq org-table-named-field-locations
- (append org-table-named-field-locations al))
- (setq org-table-local-parameters
- (append org-table-local-parameters al2))))))
- (defun org-table-goto-field (ref &optional create-column-p)
- "Move point to a specific field in the current table.
- REF is either the name of a field its absolute reference, as
- a string. No column is created unless CREATE-COLUMN-P is
- non-nil. If it is a function, it is called with the column
- number as its argument as is used as a predicate to know if the
- column can be created.
- This function assumes the table is already analyzed (i.e., using
- `org-table-analyze')."
- (let* ((coordinates
- (cond
- ((cdr (assoc ref org-table-named-field-locations)))
- ((string-match "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'" ref)
- (list (condition-case nil
- (aref org-table-dlines
- (string-to-number (match-string 1 ref)))
- (error (user-error "Invalid row number in %s" ref)))
- (string-to-number (match-string 2 ref))))
- (t (user-error "Unknown field: %s" ref))))
- (line (car coordinates))
- (column (nth 1 coordinates))
- (create-new-column (if (functionp create-column-p)
- (funcall create-column-p column)
- create-column-p)))
- (when coordinates
- (goto-char org-table-current-begin-pos)
- (forward-line line)
- (org-table-goto-column column nil create-new-column))))
- ;;;###autoload
- (defun org-table-maybe-recalculate-line ()
- "Recompute the current line if marked for it, and if we haven't just done it."
- (interactive)
- (and org-table-allow-automatic-line-recalculation
- (not (and (memq last-command org-recalc-commands)
- (eq org-last-recalc-line (line-beginning-position))))
- (save-excursion (beginning-of-line 1)
- (looking-at org-table-auto-recalculate-regexp))
- (org-table-recalculate) t))
- (defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula'
- (defsubst org-set-calc-mode (var &optional value)
- (if (stringp var)
- (setq var (assoc var '(("D" calc-angle-mode deg)
- ("R" calc-angle-mode rad)
- ("F" calc-prefer-frac t)
- ("S" calc-symbolic-mode t)))
- value (nth 2 var) var (nth 1 var)))
- (if (memq var org-tbl-calc-modes)
- (setcar (cdr (memq var org-tbl-calc-modes)) value)
- (cons var (cons value org-tbl-calc-modes)))
- org-tbl-calc-modes)
- ;;;###autoload
- (defun org-table-eval-formula (&optional arg equation
- suppress-align suppress-const
- suppress-store suppress-analysis)
- "Replace the table field value at the cursor by the result of a calculation.
- In a table, this command replaces the value in the current field with the
- result of a formula. It also installs the formula as the \"current\" column
- formula, by storing it in a special line below the table. When called
- with a `\\[universal-argument]' prefix the formula is installed as a \
- field formula.
- When called with a `\\[universal-argument] \\[universal-argument]' prefix, \
- insert the active equation for the field
- back into the current field, so that it can be edited there. This is \
- useful
- in order to use \\<org-table-fedit-map>`\\[org-table-show-reference]' to \
- check the referenced fields.
- When called, the command first prompts for a formula, which is read in
- the minibuffer. Previously entered formulas are available through the
- history list, and the last used formula is offered as a default.
- These stored formulas are adapted correctly when moving, inserting, or
- deleting columns with the corresponding commands.
- The formula can be any algebraic expression understood by the Calc package.
- For details, see the Org mode manual.
- This function can also be called from Lisp programs and offers
- additional arguments: EQUATION can be the formula to apply. If this
- argument is given, the user will not be prompted.
- SUPPRESS-ALIGN is used to speed-up recursive calls by by-passing
- unnecessary aligns.
- SUPPRESS-CONST suppresses the interpretation of constants in the
- formula, assuming that this has been done already outside the
- function.
- SUPPRESS-STORE means the formula should not be stored, either
- because it is already stored, or because it is a modified
- equation that should not overwrite the stored one.
- SUPPRESS-ANALYSIS prevents analyzing the table and checking
- location of point."
- (interactive "P")
- (unless suppress-analysis
- (org-table-check-inside-data-field)
- (org-table-analyze))
- (if (equal arg '(16))
- (let ((eq (org-table-current-field-formula)))
- (org-table-get-field nil eq)
- (org-table-align)
- (setq org-table-may-need-update t))
- (let* (fields
- (ndown (if (integerp arg) arg 1))
- (org-table-automatic-realign nil)
- (case-fold-search nil)
- (down (> ndown 1))
- (formula (if (and equation suppress-store)
- equation
- (org-table-get-formula equation (equal arg '(4)))))
- (n0 (org-table-current-column))
- (org-tbl-calc-modes (copy-sequence org-calc-default-modes))
- (numbers nil) ; was a variable, now fixed default
- (keep-empty nil)
- n form form0 formrpl formrg bw fmt x ev orig c lispp literal
- duration duration-output-format)
- ;; Parse the format string. Since we have a lot of modes, this is
- ;; a lot of work. However, I think calc still uses most of the time.
- (if (string-match ";" formula)
- (let ((tmp (org-split-string formula ";")))
- (setq formula (car tmp)
- fmt (concat (cdr (assoc "%" org-table-local-parameters))
- (nth 1 tmp)))
- (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt)
- (setq c (string-to-char (match-string 1 fmt))
- n (string-to-number (match-string 2 fmt)))
- (if (= c ?p)
- (setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n))
- (setq org-tbl-calc-modes
- (org-set-calc-mode
- 'calc-float-format
- (list (cdr (assoc c '((?n . float) (?f . fix)
- (?s . sci) (?e . eng))))
- n))))
- (setq fmt (replace-match "" t t fmt)))
- (if (string-match "[tTU]" fmt)
- (let ((ff (match-string 0 fmt)))
- (setq duration t numbers t
- duration-output-format
- (cond ((equal ff "T") nil)
- ((equal ff "t") org-table-duration-custom-format)
- ((equal ff "U") 'hh:mm))
- fmt (replace-match "" t t fmt))))
- (if (string-match "N" fmt)
- (setq numbers t
- fmt (replace-match "" t t fmt)))
- (if (string-match "L" fmt)
- (setq literal t
- fmt (replace-match "" t t fmt)))
- (if (string-match "E" fmt)
- (setq keep-empty t
- fmt (replace-match "" t t fmt)))
- (while (string-match "[DRFS]" fmt)
- (setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt)))
- (setq fmt (replace-match "" t t fmt)))
- (unless (string-match "\\S-" fmt)
- (setq fmt nil))))
- (when (and (not suppress-const) org-table-formula-use-constants)
- (setq formula (org-table-formula-substitute-names formula)))
- (setq orig (or (get-text-property 1 :orig-formula formula) "?"))
- (setq formula (org-table-formula-handle-first/last-rc formula))
- (while (> ndown 0)
- (setq fields (org-split-string
- (org-trim
- (buffer-substring-no-properties
- (line-beginning-position) (line-end-position)))
- " *| *"))
- ;; replace fields with duration values if relevant
- (if duration
- (setq fields
- (mapcar (lambda (x) (org-table-time-string-to-seconds x))
- fields)))
- (if (eq numbers t)
- (setq fields (mapcar
- (lambda (x)
- (if (string-match "\\S-" x)
- (number-to-string (string-to-number x))
- x))
- fields)))
- (setq ndown (1- ndown))
- (setq form (copy-sequence formula)
- lispp (and (> (length form) 2) (equal (substring form 0 2) "'(")))
- (if (and lispp literal) (setq lispp 'literal))
- ;; Insert row and column number of formula result field
- (while (string-match "[@$]#" form)
- (setq form
- (replace-match
- (format "%d"
- (save-match-data
- (if (equal (substring form (match-beginning 0)
- (1+ (match-beginning 0)))
- "@")
- (org-table-current-dline)
- (org-table-current-column))))
- t t form)))
- ;; Check for old vertical references
- (org-table--error-on-old-row-references form)
- ;; Insert remote references
- (setq form (org-table-remote-reference-indirection form))
- (while (string-match "\\<remote([ \t]*\\([^,)]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form)
- (setq form
- (replace-match
- (save-match-data
- (org-table-make-reference
- (let ((rmtrng (org-table-get-remote-range
- (match-string 1 form) (match-string 2 form))))
- (if duration
- (if (listp rmtrng)
- (mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng)
- (org-table-time-string-to-seconds rmtrng))
- rmtrng))
- keep-empty numbers lispp))
- t t form)))
- ;; Insert complex ranges
- (while (and (string-match org-table-range-regexp form)
- (> (length (match-string 0 form)) 1))
- (setq formrg
- (save-match-data
- (org-table-get-range
- (match-string 0 form) org-table-current-begin-pos n0)))
- (setq formrpl
- (save-match-data
- (org-table-make-reference
- ;; possibly handle durations
- (if duration
- (if (listp formrg)
- (mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg)
- (org-table-time-string-to-seconds formrg))
- formrg)
- keep-empty numbers lispp)))
- (if (not (save-match-data
- (string-match (regexp-quote form) formrpl)))
- (setq form (replace-match formrpl t t form))
- (user-error "Spreadsheet error: invalid reference \"%s\"" form)))
- ;; Insert simple ranges, i.e. included in the current row.
- (while (string-match
- "\\$\\(\\([-+]\\)?[0-9]+\\)\\.\\.\\$\\(\\([-+]\\)?[0-9]+\\)"
- form)
- (setq form
- (replace-match
- (save-match-data
- (org-table-make-reference
- (cl-subseq fields
- (+ (if (match-end 2) n0 0)
- (string-to-number (match-string 1 form))
- -1)
- (+ (if (match-end 4) n0 0)
- (string-to-number (match-string 3 form))))
- keep-empty numbers lispp))
- t t form)))
- (setq form0 form)
- ;; Insert the references to fields in same row
- (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form)
- (setq n (+ (string-to-number (match-string 1 form))
- (if (match-end 2) n0 0))
- x (nth (1- (if (= n 0) n0 (max n 1))) fields)
- formrpl (save-match-data
- (org-table-make-reference
- x keep-empty numbers lispp)))
- (when (or (not x)
- (save-match-data
- (string-match (regexp-quote formula) formrpl)))
- (user-error "Invalid field specifier \"%s\""
- (match-string 0 form)))
- (setq form (replace-match formrpl t t form)))
- (if lispp
- (setq ev (condition-case nil
- (eval (eval (read form)))
- (error "#ERROR"))
- ev (if (numberp ev) (number-to-string ev) ev)
- ev (if duration (org-table-time-seconds-to-string
- (string-to-number ev)
- duration-output-format) ev))
- ;; Use <...> time-stamps so that Calc can handle them.
- (setq form
- (replace-regexp-in-string org-ts-regexp-inactive "<\\1>" form))
- ;; Internationalize local time-stamps by setting locale to
- ;; "C".
- (setq form
- (replace-regexp-in-string
- org-ts-regexp
- (lambda (ts)
- (let ((system-time-locale "C"))
- (format-time-string
- (org-time-stamp-format
- (string-match-p "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))
- (apply #'encode-time
- (save-match-data (org-parse-time-string ts))))))
- form t t))
- (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form))
- form
- (calc-eval (cons form org-tbl-calc-modes)
- (when (and (not keep-empty) numbers) 'num)))
- ev (if duration (org-table-time-seconds-to-string
- (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev)
- (string-to-number (org-table-time-string-to-seconds ev))
- (string-to-number ev))
- duration-output-format)
- ev)))
- (when org-table-formula-debug
- (with-output-to-temp-buffer "*Substitution History*"
- (princ (format "Substitution history of formula
- Orig: %s
- $xyz-> %s
- @r$c-> %s
- $1-> %s\n" orig formula form0 form))
- (if (consp ev)
- (princ (format " %s^\nError: %s"
- (make-string (car ev) ?\-) (nth 1 ev)))
- (princ (format "Result: %s\nFormat: %s\nFinal: %s"
- ev (or fmt "NONE")
- (if fmt (format fmt (string-to-number ev)) ev)))))
- (setq bw (get-buffer-window "*Substitution History*"))
- (org-fit-window-to-buffer bw)
- (unless (and (called-interactively-p 'any) (not ndown))
- (unless (let (inhibit-redisplay)
- (y-or-n-p "Debugging Formula. Continue to next? "))
- (org-table-align)
- (user-error "Abort"))
- (delete-window bw)
- (message "")))
- (when (consp ev) (setq fmt nil ev "#ERROR"))
- (org-table-justify-field-maybe
- (format org-table-formula-field-format
- (cond
- ((not (stringp ev)) ev)
- (fmt (format fmt (string-to-number ev)))
- ;; Replace any active time stamp in the result with
- ;; an inactive one. Dates in tables are likely
- ;; piece of regular data, not meant to appear in the
- ;; agenda.
- (t (replace-regexp-in-string org-ts-regexp "[\\1]" ev)))))
- (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]"))
- (call-interactively 'org-return)
- (setq ndown 0)))
- (and down (org-table-maybe-recalculate-line))
- (or suppress-align (and org-table-may-need-update
- (org-table-align))))))
- (defun org-table-put-field-property (prop value)
- (save-excursion
- (put-text-property (progn (skip-chars-backward "^|") (point))
- (progn (skip-chars-forward "^|") (point))
- prop value)))
- (defun org-table-get-range (desc &optional tbeg col highlight corners-only)
- "Get a calc vector from a column, according to descriptor DESC.
- Optional arguments TBEG and COL can give the beginning of the table and
- the current column, to avoid unnecessary parsing.
- HIGHLIGHT means just highlight the range.
- When CORNERS-ONLY is set, only return the corners of the range as
- a list (line1 column1 line2 column2) where line1 and line2 are
- line numbers relative to beginning of table, or TBEG, and column1
- and column2 are table column numbers."
- (let* ((desc (if (string-match-p "\\`\\$[0-9]+\\.\\.\\$[0-9]+\\'" desc)
- (replace-regexp-in-string "\\$" "@0$" desc)
- desc))
- (col (or col (org-table-current-column)))
- (tbeg (or tbeg (org-table-begin)))
- (thisline (count-lines tbeg (line-beginning-position))))
- (unless (string-match org-table-range-regexp desc)
- (user-error "Invalid table range specifier `%s'" desc))
- (let ((rangep (match-end 3))
- (r1 (let ((r (and (match-end 1) (match-string 1 desc))))
- (or (save-match-data
- (and (org-string-nw-p r)
- (org-table--descriptor-line r thisline)))
- thisline)))
- (r2 (let ((r (and (match-end 4) (match-string 4 desc))))
- (or (save-match-data
- (and (org-string-nw-p r)
- (org-table--descriptor-line r thisline)))
- thisline)))
- (c1 (let ((c (and (match-end 2) (substring (match-string 2 desc) 1))))
- (if (or (not c) (= (string-to-number c) 0)) col
- (+ (string-to-number c)
- (if (memq (string-to-char c) '(?- ?+)) col 0)))))
- (c2 (let ((c (and (match-end 5) (substring (match-string 5 desc) 1))))
- (if (or (not c) (= (string-to-number c) 0)) col
- (+ (string-to-number c)
- (if (memq (string-to-char c) '(?- ?+)) col 0))))))
- (save-excursion
- (if (and (not corners-only)
- (or (not rangep) (and (= r1 r2) (= c1 c2))))
- ;; Just one field.
- (progn
- (forward-line (- r1 thisline))
- (while (not (looking-at org-table-dataline-regexp))
- (forward-line))
- (prog1 (org-trim (org-table-get-field c1))
- (when highlight (org-table-highlight-rectangle))))
- ;; A range, return a vector. First sort the numbers to get
- ;; a regular rectangle.
- (let ((first-row (min r1 r2))
- (last-row (max r1 r2))
- (first-column (min c1 c2))
- (last-column (max c1 c2)))
- (if corners-only (list first-row first-column last-row last-column)
- ;; Copy the range values into a list.
- (forward-line (- first-row thisline))
- (while (not (looking-at org-table-dataline-regexp))
- (forward-line)
- (cl-incf first-row))
- (org-table-goto-column first-column)
- (let ((beg (point)))
- (forward-line (- last-row first-row))
- (while (not (looking-at org-table-dataline-regexp))
- (forward-line -1))
- (org-table-goto-column last-column)
- (let ((end (point)))
- (when highlight
- (org-table-highlight-rectangle
- beg (progn (skip-chars-forward "^|\n") (point))))
- ;; Return string representation of calc vector.
- (mapcar #'org-trim
- (apply #'append
- (org-table-copy-region beg end))))))))))))
- (defun org-table--descriptor-line (desc cline)
- "Return relative line number corresponding to descriptor DESC.
- The cursor is currently in relative line number CLINE."
- (if (string-match "\\`[0-9]+\\'" desc)
- (aref org-table-dlines (string-to-number desc))
- (when (or (not (string-match
- "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?"
- ;; 1 2 3 4 5 6
- desc))
- (and (not (match-end 3)) (not (match-end 6)))
- (and (match-end 3) (match-end 6) (not (match-end 5))))
- (user-error "Invalid row descriptor `%s'" desc))
- (let* ((hn (and (match-end 3) (- (match-end 3) (match-beginning 3))))
- (hdir (match-string 2 desc))
- (odir (match-string 5 desc))
- (on (and (match-end 6) (string-to-number (match-string 6 desc))))
- (rel (and (match-end 6)
- (or (and (match-end 1) (not (match-end 3)))
- (match-end 5)))))
- (when (and hn (not hdir))
- (setq cline 0)
- (setq hdir "+")
- (when (eq (aref org-table-current-line-types 0) 'hline) (cl-decf hn)))
- (when (and (not hn) on (not odir)) (user-error "Should never happen"))
- (when hn
- (setq cline
- (org-table--row-type 'hline hn cline (equal hdir "-") nil desc)))
- (when on
- (setq cline
- (org-table--row-type 'dline on cline (equal odir "-") rel desc)))
- cline)))
- (defun org-table--row-type (type n i backwards relative desc)
- "Return relative line of Nth row with type TYPE.
- Search starts from relative line I. When BACKWARDS in non-nil,
- look before I. When RELATIVE is non-nil, the reference is
- relative. DESC is the original descriptor that started the
- search, as a string."
- (let ((l (length org-table-current-line-types)))
- (catch :exit
- (dotimes (_ n)
- (while (and (cl-incf i (if backwards -1 1))
- (>= i 0)
- (< i l)
- (not (eq (aref org-table-current-line-types i) type))
- ;; We are going to cross a hline. Check if this is
- ;; an authorized move.
- (cond
- ((not relative))
- ((not (eq (aref org-table-current-line-types i) 'hline)))
- ((eq org-table-relative-ref-may-cross-hline t))
- ((eq org-table-relative-ref-may-cross-hline 'error)
- (user-error "Row descriptor %s crosses hline" desc))
- (t (cl-decf i (if backwards -1 1)) ; Step back.
- (throw :exit nil)))))))
- (cond ((or (< i 0) (>= i l))
- (user-error "Row descriptor %s leads outside table" desc))
- ;; The last hline doesn't exist. Instead, point to last row
- ;; in table.
- ((= i (1- l)) (1- i))
- (t i))))
- (defun org-table--error-on-old-row-references (s)
- (when (string-match "&[-+0-9I]" s)
- (user-error "Formula contains old &row reference, please rewrite using @-syntax")))
- (defun org-table-make-reference (elements keep-empty numbers lispp)
- "Convert list ELEMENTS to something appropriate to insert into formula.
- KEEP-EMPTY indicated to keep empty fields, default is to skip them.
- NUMBERS indicates that everything should be converted to numbers.
- LISPP non-nil means to return something appropriate for a Lisp
- list, `literal' is for the format specifier L."
- ;; Calc nan (not a number) is used for the conversion of the empty
- ;; field to a reference for several reasons: (i) It is accepted in a
- ;; Calc formula (e. g. "" or "()" would result in a Calc error).
- ;; (ii) In a single field (not in range) it can be distinguished
- ;; from "(nan)" which is the reference made from a single field
- ;; containing "nan".
- (if (stringp elements)
- ;; field reference
- (if lispp
- (if (eq lispp 'literal)
- elements
- (if (and (eq elements "") (not keep-empty))
- ""
- (prin1-to-string
- (if numbers (string-to-number elements) elements))))
- (if (string-match "\\S-" elements)
- (progn
- (when numbers (setq elements (number-to-string
- (string-to-number elements))))
- (concat "(" elements ")"))
- (if (or (not keep-empty) numbers) "(0)" "nan")))
- ;; range reference
- (unless keep-empty
- (setq elements
- (delq nil
- (mapcar (lambda (x) (if (string-match "\\S-" x) x nil))
- elements))))
- (setq elements (or elements '())) ; if delq returns nil then we need '()
- (if lispp
- (mapconcat
- (lambda (x)
- (if (eq lispp 'literal)
- x
- (prin1-to-string (if numbers (string-to-number x) x))))
- elements " ")
- (concat "[" (mapconcat
- (lambda (x)
- (if (string-match "\\S-" x)
- (if numbers
- (number-to-string (string-to-number x))
- x)
- (if (or (not keep-empty) numbers) "0" "nan")))
- elements
- ",") "]"))))
- (defun org-table-message-once-per-second (t1 &rest args)
- "If there has been more than one second since T1, display message.
- ARGS are passed as arguments to the `message' function. Returns
- current time if a message is printed, otherwise returns T1. If
- T1 is nil, always messages."
- (let ((curtime (current-time)))
- (if (or (not t1) (< 0 (nth 1 (time-subtract curtime t1))))
- (progn (apply 'message args)
- curtime)
- t1)))
- ;;;###autoload
- (defun org-table-recalculate (&optional all noalign)
- "Recalculate the current table line by applying all stored formulas.
- With prefix arg ALL, do this for all lines in the table.
- When called with a `\\[universal-argument] \\[universal-argument]' prefix, or \
- if ALL is the symbol `iterate',
- recompute the table until it no longer changes.
- If NOALIGN is not nil, do not re-align the table after the computations
- are done. This is typically used internally to save time, if it is
- known that the table will be realigned a little later anyway."
- (interactive "P")
- (unless (memq this-command org-recalc-commands)
- (push this-command org-recalc-commands))
- (unless (org-at-table-p) (user-error "Not at a table"))
- (if (or (eq all 'iterate) (equal all '(16)))
- (org-table-iterate)
- (org-table-analyze)
- (let* ((eqlist (sort (org-table-get-stored-formulas)
- (lambda (a b) (string< (car a) (car b)))))
- (inhibit-redisplay (not debug-on-error))
- (line-re org-table-dataline-regexp)
- (log-first-time (current-time))
- (log-last-time log-first-time)
- (cnt 0)
- beg end eqlcol eqlfield)
- ;; Insert constants in all formulas.
- (when eqlist
- (org-table-save-field
- ;; Expand equations, then split the equation list between
- ;; column formulas and field formulas.
- (dolist (eq eqlist)
- (let* ((rhs (org-table-formula-substitute-names
- (org-table-formula-handle-first/last-rc (cdr eq))))
- (old-lhs (car eq))
- (lhs
- (org-table-formula-handle-first/last-rc
- (cond
- ((string-match "\\`@-?I+" old-lhs)
- (user-error "Can't assign to hline relative reference"))
- ((string-match "\\`$[<>]" old-lhs)
- (let ((new (org-table-formula-handle-first/last-rc
- old-lhs)))
- (when (assoc new eqlist)
- (user-error "\"%s=\" formula tries to overwrite \
- existing formula for column %s"
- old-lhs
- new))
- new))
- (t old-lhs)))))
- (if (string-match-p "\\`\\$[0-9]+\\'" lhs)
- (push (cons lhs rhs) eqlcol)
- (push (cons lhs rhs) eqlfield))))
- (setq eqlcol (nreverse eqlcol))
- ;; Expand ranges in lhs of formulas
- (setq eqlfield (org-table-expand-lhs-ranges (nreverse eqlfield)))
- ;; Get the correct line range to process.
- (if all
- (progn
- (setq end (copy-marker (org-table-end)))
- (goto-char (setq beg org-table-current-begin-pos))
- (cond
- ((re-search-forward org-table-calculate-mark-regexp end t)
- ;; This is a table with marked lines, compute selected
- ;; lines.
- (setq line-re org-table-recalculate-regexp))
- ;; Move forward to the first non-header line.
- ((and (re-search-forward org-table-dataline-regexp end t)
- (re-search-forward org-table-hline-regexp end t)
- (re-search-forward org-table-dataline-regexp end t))
- (setq beg (match-beginning 0)))
- ;; Just leave BEG at the start of the table.
- (t nil)))
- (setq beg (line-beginning-position)
- end (copy-marker (line-beginning-position 2))))
- (goto-char beg)
- ;; Mark named fields untouchable. Also check if several
- ;; field/range formulas try to set the same field.
- (remove-text-properties beg end '(:org-untouchable t))
- (let ((current-line (count-lines org-table-current-begin-pos
- (line-beginning-position)))
- seen-fields)
- (dolist (eq eqlfield)
- (let* ((name (car eq))
- (location (assoc name org-table-named-field-locations))
- (eq-line (or (nth 1 location)
- (and (string-match "\\`@\\([0-9]+\\)" name)
- (aref org-table-dlines
- (string-to-number
- (match-string 1 name))))))
- (reference
- (if location
- ;; Turn field coordinates associated to NAME
- ;; into an absolute reference.
- (format "@%d$%d"
- (org-table-line-to-dline eq-line)
- (nth 2 location))
- name)))
- (when (member reference seen-fields)
- (user-error "Several field/range formulas try to set %s"
- reference))
- (push reference seen-fields)
- (when (or all (eq eq-line current-line))
- (org-table-goto-field name)
- (org-table-put-field-property :org-untouchable t)))))
- ;; Evaluate the column formulas, but skip fields covered by
- ;; field formulas.
- (goto-char beg)
- (while (re-search-forward line-re end t)
- (unless (string-match "\\` *[_^!$/] *\\'" (org-table-get-field 1))
- ;; Unprotected line, recalculate.
- (cl-incf cnt)
- (when all
- (setq log-last-time
- (org-table-message-once-per-second
- log-last-time
- "Re-applying formulas to full table...(line %d)" cnt)))
- (if (markerp org-last-recalc-line)
- (move-marker org-last-recalc-line (line-beginning-position))
- (setq org-last-recalc-line
- (copy-marker (line-beginning-position))))
- (dolist (entry eqlcol)
- (goto-char org-last-recalc-line)
- (org-table-goto-column
- (string-to-number (substring (car entry) 1)) nil 'force)
- (unless (get-text-property (point) :org-untouchable)
- (org-table-eval-formula
- nil (cdr entry) 'noalign 'nocst 'nostore 'noanalysis)))))
- ;; Evaluate the field formulas.
- (dolist (eq eqlfield)
- (let ((reference (car eq))
- (formula (cdr eq)))
- (setq log-last-time
- (org-table-message-once-per-second
- (and all log-last-time)
- "Re-applying formula to field: %s" (car eq)))
- (org-table-goto-field
- reference
- ;; Possibly create a new column, as long as
- ;; `org-table-formula-create-columns' allows it.
- (let ((column-count (progn (end-of-line)
- (1- (org-table-current-column)))))
- (lambda (column)
- (when (> column 1000)
- (user-error "Formula column target too large"))
- (and (> column column-count)
- (or (eq org-table-formula-create-columns t)
- (and (eq org-table-formula-create-columns 'warn)
- (progn
- (org-display-warning
- "Out-of-bounds formula added columns")
- t))
- (and (eq org-table-formula-create-columns 'prompt)
- (yes-or-no-p
- "Out-of-bounds formula. Add columns? "))
- (user-error
- "Missing columns in the table. Aborting"))))))
- (org-table-eval-formula nil formula t t t t))))
- ;; Clean up markers and internal text property.
- (remove-text-properties (point-min) (point-max) '(org-untouchable t))
- (set-marker end nil)
- (unless noalign
- (when org-table-may-need-update (org-table-align))
- (when all
- (org-table-message-once-per-second
- log-first-time "Re-applying formulas to %d lines... done" cnt)))
- (org-table-message-once-per-second
- (and all log-first-time) "Re-applying formulas... done")))))
- ;;;###autoload
- (defun org-table-iterate (&optional arg)
- "Recalculate the table until it does not change anymore.
- The maximum number of iterations is 10, but you can choose a different value
- with the prefix ARG."
- (interactive "P")
- (let ((imax (if arg (prefix-numeric-value arg) 10))
- (i 0)
- (lasttbl (buffer-substring (org-table-begin) (org-table-end)))
- thistbl)
- (catch 'exit
- (while (< i imax)
- (setq i (1+ i))
- (org-table-recalculate 'all)
- (setq thistbl (buffer-substring (org-table-begin) (org-table-end)))
- (if (not (string= lasttbl thistbl))
- (setq lasttbl thistbl)
- (if (> i 1)
- (message "Convergence after %d iterations" i)
- (message "Table was already stable"))
- (throw 'exit t)))
- (user-error "No convergence after %d iterations" i))))
- ;;;###autoload
- (defun org-table-recalculate-buffer-tables ()
- "Recalculate all tables in the current buffer."
- (interactive)
- (org-with-wide-buffer
- (org-table-map-tables
- (lambda ()
- ;; Reason for separate `org-table-align': When repeating
- ;; (org-table-recalculate t) `org-table-may-need-update' gets in
- ;; the way.
- (org-table-recalculate t t)
- (org-table-align))
- t)))
- ;;;###autoload
- (defun org-table-iterate-buffer-tables ()
- "Iterate all tables in the buffer, to converge inter-table dependencies."
- (interactive)
- (let* ((imax 10)
- (i imax)
- (checksum (md5 (buffer-string)))
- c1)
- (org-with-wide-buffer
- (catch 'exit
- (while (> i 0)
- (setq i (1- i))
- (org-table-map-tables (lambda () (org-table-recalculate t t)) t)
- (if (equal checksum (setq c1 (md5 (buffer-string))))
- (progn
- (org-table-map-tables #'org-table-align t)
- (message "Convergence after %d iterations" (- imax i))
- (throw 'exit t))
- (setq checksum c1)))
- (org-table-map-tables #'org-table-align t)
- (user-error "No convergence after %d iterations" imax)))))
- (defun org-table-calc-current-TBLFM (&optional arg)
- "Apply the #+TBLFM in the line at point to the table."
- (interactive "P")
- (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line"))
- (let ((formula (buffer-substring
- (line-beginning-position)
- (line-end-position))))
- (save-excursion
- ;; Insert a temporary formula at right after the table
- (goto-char (org-table-TBLFM-begin))
- (let ((s (point-marker)))
- (insert formula "\n")
- (let ((e (point-marker)))
- ;; Recalculate the table.
- (beginning-of-line 0) ; move to the inserted line
- (skip-chars-backward " \r\n\t")
- (unwind-protect
- (org-call-with-arg #'org-table-recalculate (or arg t))
- ;; Delete the formula inserted temporarily.
- (delete-region s e)
- (set-marker s nil)
- (set-marker e nil)))))))
- (defun org-table-TBLFM-begin ()
- "Find the beginning of the TBLFM lines and return its position.
- Return nil when the beginning of TBLFM line was not found."
- (save-excursion
- (when (progn (forward-line 1)
- (re-search-backward org-table-TBLFM-begin-regexp nil t))
- (line-beginning-position 2))))
- (defun org-table-expand-lhs-ranges (equations)
- "Expand list of formulas.
- If some of the RHS in the formulas are ranges or a row reference,
- expand them to individual field equations for each field. This
- function assumes the table is already analyzed (i.e., using
- `org-table-analyze')."
- (let (res)
- (dolist (e equations (nreverse res))
- (let ((lhs (car e))
- (rhs (cdr e)))
- (cond
- ((string-match-p "\\`@-?[-+0-9]+\\$-?[0-9]+\\'" lhs)
- ;; This just refers to one fixed field.
- (push e res))
- ((string-match-p "\\`[a-zA-Z][_a-zA-Z0-9]*\\'" lhs)
- ;; This just refers to one fixed named field.
- (push e res))
- ((string-match-p "\\`\\$[0-9]+\\'" lhs)
- ;; Column formulas are treated specially and are not
- ;; expanded.
- (push e res))
- ((string-match "\\`@[0-9]+\\'" lhs)
- (dotimes (ic org-table-current-ncol)
- (push (cons (propertize (format "%s$%d" lhs (1+ ic)) :orig-eqn e)
- rhs)
- res)))
- (t
- (let* ((range (org-table-get-range
- lhs org-table-current-begin-pos 1 nil 'corners))
- (r1 (org-table-line-to-dline (nth 0 range)))
- (c1 (nth 1 range))
- (r2 (org-table-line-to-dline (nth 2 range) 'above))
- (c2 (nth 3 range)))
- (cl-loop for ir from r1 to r2 do
- (cl-loop for ic from c1 to c2 do
- (push (cons (propertize
- (format "@%d$%d" ir ic) :orig-eqn e)
- rhs)
- res))))))))))
- (defun org-table-formula-handle-first/last-rc (s)
- "Replace @<, @>, $<, $> with first/last row/column of the table.
- So @< and $< will always be replaced with @1 and $1, respectively.
- The advantage of these special markers are that structure editing of
- the table will not change them, while @1 and $1 will be modified
- when a line/row is swapped out of that privileged position. So for
- formulas that use a range of rows or columns, it may often be better
- to anchor the formula with \"I\" row markers, or to offset from the
- borders of the table using the @< @> $< $> makers."
- (let (n nmax len char (start 0))
- (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^)]+)\\)"
- s start)
- (if (match-end 3)
- (setq start (match-end 3))
- (setq nmax (if (equal (match-string 1 s) "@")
- (1- (length org-table-dlines))
- org-table-current-ncol)
- len (- (match-end 2) (match-beginning 2))
- char (string-to-char (match-string 2 s))
- n (if (= char ?<)
- len
- (- nmax len -1)))
- (if (or (< n 1) (> n nmax))
- (user-error "Reference \"%s\" in expression \"%s\" points outside table"
- (match-string 0 s) s))
- (setq start (match-beginning 0))
- (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s)))))
- s)
- (defun org-table-formula-substitute-names (f)
- "Replace $const with values in string F."
- (let ((start 0)
- (pp (/= (string-to-char f) ?'))
- (duration (string-match-p ";.*[Tt].*\\'" f))
- (new (replace-regexp-in-string ; Check for column names.
- org-table-column-name-regexp
- (lambda (m)
- (concat "$" (cdr (assoc (match-string 1 m)
- org-table-column-names))))
- f t t)))
- ;; Parameters and constants.
- (while (setq start
- (string-match
- "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)"
- new start))
- (if (match-end 2) (setq start (match-end 2))
- (cl-incf start)
- ;; When a duration is expected, convert value on the fly.
- (let ((value
- (save-match-data
- (let ((v (org-table-get-constant (match-string 1 new))))
- (if (and (org-string-nw-p v) duration)
- (org-table-time-string-to-seconds v)
- v)))))
- (when value
- (setq new (replace-match
- (concat (and pp "(") value (and pp ")")) t t new))))))
- (if org-table-formula-debug (propertize new :orig-formula f) new)))
- (defun org-table-get-constant (const)
- "Find the value for a parameter or constant in a formula.
- Parameters get priority."
- (or (cdr (assoc const org-table-local-parameters))
- (cdr (assoc const org-table-formula-constants-local))
- (cdr (assoc const org-table-formula-constants))
- (and (fboundp 'constants-get) (constants-get const))
- (and (string= (substring const 0 (min 5 (length const))) "PROP_")
- (org-entry-get nil (substring const 5) 'inherit))
- "#UNDEFINED_NAME"))
- (defvar org-table-fedit-map
- (let ((map (make-sparse-keymap)))
- (org-defkey map "\C-x\C-s" 'org-table-fedit-finish)
- (org-defkey map "\C-c\C-s" 'org-table-fedit-finish)
- (org-defkey map "\C-c\C-c" 'org-table-fedit-finish)
- (org-defkey map "\C-c'" 'org-table-fedit-finish)
- (org-defkey map "\C-c\C-q" 'org-table-fedit-abort)
- (org-defkey map "\C-c?" 'org-table-show-reference)
- (org-defkey map [(meta shift up)] 'org-table-fedit-line-up)
- (org-defkey map [(meta shift down)] 'org-table-fedit-line-down)
- (org-defkey map [(shift up)] 'org-table-fedit-ref-up)
- (org-defkey map [(shift down)] 'org-table-fedit-ref-down)
- (org-defkey map [(shift left)] 'org-table-fedit-ref-left)
- (org-defkey map [(shift right)] 'org-table-fedit-ref-right)
- (org-defkey map [(meta up)] 'org-table-fedit-scroll-down)
- (org-defkey map [(meta down)] 'org-table-fedit-scroll)
- (org-defkey map [(meta tab)] 'lisp-complete-symbol)
- (org-defkey map "\M-\C-i" 'lisp-complete-symbol)
- (org-defkey map [(tab)] 'org-table-fedit-lisp-indent)
- (org-defkey map "\C-i" 'org-table-fedit-lisp-indent)
- (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type)
- (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates)
- map))
- (easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu"
- '("Edit-Formulas"
- ["Finish and Install" org-table-fedit-finish t]
- ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"]
- ["Abort" org-table-fedit-abort t]
- "--"
- ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t]
- ["Complete Lisp Symbol" lisp-complete-symbol t]
- "--"
- "Shift Reference at Point"
- ["Up" org-table-fedit-ref-up t]
- ["Down" org-table-fedit-ref-down t]
- ["Left" org-table-fedit-ref-left t]
- ["Right" org-table-fedit-ref-right t]
- "-"
- "Change Test Row for Column Formulas"
- ["Up" org-table-fedit-line-up t]
- ["Down" org-table-fedit-line-down t]
- "--"
- ["Scroll Table Window" org-table-fedit-scroll t]
- ["Scroll Table Window down" org-table-fedit-scroll-down t]
- ["Show Table Grid" org-table-fedit-toggle-coordinates
- :style toggle :selected (with-current-buffer (marker-buffer org-pos)
- org-table-overlay-coordinates)]
- "--"
- ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type
- :style toggle :selected org-table-buffer-is-an]))
- (defvar org-pos)
- (defvar org-table--fedit-source nil
- "Position of the TBLFM line being edited.")
- ;;;###autoload
- (defun org-table-edit-formulas ()
- "Edit the formulas of the current table in a separate buffer."
- (interactive)
- (let ((at-tblfm (org-at-TBLFM-p)))
- (unless (or at-tblfm (org-at-table-p))
- (user-error "Not at a table"))
- (save-excursion
- ;; Move point within the table before analyzing it.
- (when at-tblfm (re-search-backward "^[ \t]*|"))
- (org-table-analyze))
- (let ((key (org-table-current-field-formula 'key 'noerror))
- (eql (sort (org-table-get-stored-formulas t (and at-tblfm (point)))
- #'org-table-formula-less-p))
- (pos (point-marker))
- (source (copy-marker (line-beginning-position)))
- (startline 1)
- (wc (current-window-configuration))
- (sel-win (selected-window))
- (titles '((column . "# Column Formulas\n")
- (field . "# Field and Range Formulas\n")
- (named . "# Named Field Formulas\n"))))
- (org-switch-to-buffer-other-window "*Edit Formulas*")
- (erase-buffer)
- ;; Keep global-font-lock-mode from turning on font-lock-mode
- (let ((font-lock-global-modes '(not fundamental-mode)))
- (fundamental-mode))
- (setq-local font-lock-global-modes (list 'not major-mode))
- (setq-local org-pos pos)
- (setq-local org-table--fedit-source source)
- (setq-local org-window-configuration wc)
- (setq-local org-selected-window sel-win)
- (use-local-map org-table-fedit-map)
- (add-hook 'post-command-hook #'org-table-fedit-post-command t t)
- (easy-menu-add org-table-fedit-menu)
- (setq startline (org-current-line))
- (dolist (entry eql)
- (let* ((type (cond
- ((string-match "\\`$\\([0-9]+\\|[<>]+\\)\\'" (car entry))
- 'column)
- ((equal (string-to-char (car entry)) ?@) 'field)
- (t 'named)))
- (title (assq type titles)))
- (when title
- (unless (bobp) (insert "\n"))
- (insert
- (org-add-props (cdr title) nil 'face font-lock-comment-face))
- (setq titles (remove title titles)))
- (when (equal key (car entry)) (setq startline (org-current-line)))
- (let ((s (concat
- (if (memq (string-to-char (car entry)) '(?@ ?$)) "" "$")
- (car entry) " = " (cdr entry) "\n")))
- (remove-text-properties 0 (length s) '(face nil) s)
- (insert s))))
- (when (eq org-table-use-standard-references t)
- (org-table-fedit-toggle-ref-type))
- (org-goto-line startline)
- (message "%s" (substitute-command-keys "\\<org-mode-map>\
- Edit formulas, finish with `\\[org-ctrl-c-ctrl-c]' or `\\[org-edit-special]'. \
- See menu for more commands.")))))
- (defun org-table-fedit-post-command ()
- (when (not (memq this-command '(lisp-complete-symbol)))
- (let ((win (selected-window)))
- (save-excursion
- (ignore-errors (org-table-show-reference))
- (select-window win)))))
- (defun org-table-formula-to-user (s)
- "Convert a formula from internal to user representation."
- (if (eq org-table-use-standard-references t)
- (org-table-convert-refs-to-an s)
- s))
- (defun org-table-formula-from-user (s)
- "Convert a formula from user to internal representation."
- (if org-table-use-standard-references
- (org-table-convert-refs-to-rc s)
- s))
- (defun org-table-convert-refs-to-rc (s)
- "Convert spreadsheet references from A7 to @7$28.
- Works for single references, but also for entire formulas and even the
- full TBLFM line."
- (let ((start 0))
- (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start)
- (cond
- ((match-end 3)
- ;; format match, just advance
- (setq start (match-end 0)))
- ((and (> (match-beginning 0) 0)
- (equal ?. (aref s (max (1- (match-beginning 0)) 0)))
- (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0)))))
- ;; 3.e5 or something like this.
- (setq start (match-end 0)))
- ((or (> (- (match-end 1) (match-beginning 1)) 2)
- ;; (member (match-string 1 s)
- ;; '("arctan" "exp" "expm" "lnp" "log" "stir"))
- )
- ;; function name, just advance
- (setq start (match-end 0)))
- (t
- (setq start (match-beginning 0)
- s (replace-match
- (if (equal (match-string 2 s) "&")
- (format "$%d" (org-letters-to-number (match-string 1 s)))
- (format "@%d$%d"
- (string-to-number (match-string 2 s))
- (org-letters-to-number (match-string 1 s))))
- t t s)))))
- s))
- (defun org-table-convert-refs-to-an (s)
- "Convert spreadsheet references from to @7$28 to AB7.
- Works for single references, but also for entire formulas and even the
- full TBLFM line."
- (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s)
- (setq s (replace-match
- (format "%s%d"
- (org-number-to-letters
- (string-to-number (match-string 2 s)))
- (string-to-number (match-string 1 s)))
- t t s)))
- (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s)
- (setq s (replace-match (concat "\\1"
- (org-number-to-letters
- (string-to-number (match-string 2 s))) "&")
- t nil s)))
- s)
- (defun org-letters-to-number (s)
- "Convert a base 26 number represented by letters into an integer.
- For example: AB -> 28."
- (let ((n 0))
- (setq s (upcase s))
- (while (> (length s) 0)
- (setq n (+ (* n 26) (string-to-char s) (- ?A) 1)
- s (substring s 1)))
- n))
- (defun org-number-to-letters (n)
- "Convert an integer into a base 26 number represented by letters.
- For example: 28 -> AB."
- (let ((s ""))
- (while (> n 0)
- (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s)
- n (/ (1- n) 26)))
- s))
- (defun org-table-time-string-to-seconds (s)
- "Convert a time string into numerical duration in seconds.
- S can be a string matching either -?HH:MM:SS or -?HH:MM.
- If S is a string representing a number, keep this number."
- (if (equal s "")
- s
- (let (hour minus min sec res)
- (cond
- ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s))
- (setq minus (< 0 (length (match-string 1 s)))
- hour (string-to-number (match-string 2 s))
- min (string-to-number (match-string 3 s))
- sec (string-to-number (match-string 4 s)))
- (if minus
- (setq res (- (+ (* hour 3600) (* min 60) sec)))
- (setq res (+ (* hour 3600) (* min 60) sec))))
- ((and (not (string-match org-ts-regexp-both s))
- (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s))
- (setq minus (< 0 (length (match-string 1 s)))
- hour (string-to-number (match-string 2 s))
- min (string-to-number (match-string 3 s)))
- (if minus
- (setq res (- (+ (* hour 3600) (* min 60))))
- (setq res (+ (* hour 3600) (* min 60)))))
- (t (setq res (string-to-number s))))
- (number-to-string res))))
- (defun org-table-time-seconds-to-string (secs &optional output-format)
- "Convert a number of seconds to a time string.
- If OUTPUT-FORMAT is non-nil, return a number of days, hours,
- minutes or seconds."
- (let* ((secs0 (abs secs))
- (res
- (cond ((eq output-format 'days)
- (format "%.3f" (/ (float secs0) 86400)))
- ((eq output-format 'hours)
- (format "%.2f" (/ (float secs0) 3600)))
- ((eq output-format 'minutes)
- (format "%.1f" (/ (float secs0) 60)))
- ((eq output-format 'seconds)
- (format "%d" secs0))
- ((eq output-format 'hh:mm)
- ;; Ignore seconds
- (substring (format-seconds
- (if org-table-duration-hour-zero-padding
- "%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
- secs0)
- 0 -3))
- (t (format-seconds
- (if org-table-duration-hour-zero-padding
- "%.2h:%.2m:%.2s" "%h:%.2m:%.2s")
- secs0)))))
- (if (< secs 0) (concat "-" res) res)))
- (defun org-table-fedit-convert-buffer (function)
- "Convert all references in this buffer, using FUNCTION."
- (let ((origin (copy-marker (line-beginning-position))))
- (goto-char (point-min))
- (while (not (eobp))
- (insert (funcall function (buffer-substring (point) (line-end-position))))
- (delete-region (point) (line-end-position))
- (forward-line))
- (goto-char origin)
- (set-marker origin nil)))
- (defun org-table-fedit-toggle-ref-type ()
- "Convert all references in the buffer from B3 to @3$2 and back."
- (interactive)
- (setq-local org-table-buffer-is-an (not org-table-buffer-is-an))
- (org-table-fedit-convert-buffer
- (if org-table-buffer-is-an
- 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc))
- (message "Reference type switched to %s"
- (if org-table-buffer-is-an "A1 etc" "@row$column")))
- (defun org-table-fedit-ref-up ()
- "Shift the reference at point one row/hline up."
- (interactive)
- (org-table-fedit-shift-reference 'up))
- (defun org-table-fedit-ref-down ()
- "Shift the reference at point one row/hline down."
- (interactive)
- (org-table-fedit-shift-reference 'down))
- (defun org-table-fedit-ref-left ()
- "Shift the reference at point one field to the left."
- (interactive)
- (org-table-fedit-shift-reference 'left))
- (defun org-table-fedit-ref-right ()
- "Shift the reference at point one field to the right."
- (interactive)
- (org-table-fedit-shift-reference 'right))
- (defun org-table-fedit-shift-reference (dir)
- (cond
- ((org-in-regexp "\\(\\<[a-zA-Z]\\)&")
- (if (memq dir '(left right))
- (org-rematch-and-replace 1 (eq dir 'left))
- (user-error "Cannot shift reference in this direction")))
- ((org-in-regexp "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)")
- ;; A B3-like reference
- (if (memq dir '(up down))
- (org-rematch-and-replace 2 (eq dir 'up))
- (org-rematch-and-replace 1 (eq dir 'left))))
- ((org-in-regexp
- "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?")
- ;; An internal reference
- (if (memq dir '(up down))
- (org-rematch-and-replace 2 (eq dir 'up) (match-end 3))
- (org-rematch-and-replace 5 (eq dir 'left))))))
- (defun org-rematch-and-replace (n &optional decr hline)
- "Re-match the group N, and replace it with the shifted reference."
- (or (match-end n) (user-error "Cannot shift reference in this direction"))
- (goto-char (match-beginning n))
- (and (looking-at (regexp-quote (match-string n)))
- (replace-match (org-table-shift-refpart (match-string 0) decr hline)
- t t)))
- (defun org-table-shift-refpart (ref &optional decr hline)
- "Shift a reference part REF.
- If DECR is set, decrease the references row/column, else increase.
- If HLINE is set, this may be a hline reference, it certainly is not
- a translation reference."
- (save-match-data
- (let* ((sign (string-match "^[-+]" ref)) n)
- (if sign (setq sign (substring ref 0 1) ref (substring ref 1)))
- (cond
- ((and hline (string-match "^I+" ref))
- (setq n (string-to-number (concat sign (number-to-string (length ref)))))
- (setq n (+ n (if decr -1 1)))
- (if (= n 0) (setq n (+ n (if decr -1 1))))
- (if sign
- (setq sign (if (< n 0) "-" "+") n (abs n))
- (setq n (max 1 n)))
- (concat sign (make-string n ?I)))
- ((string-match "^[0-9]+" ref)
- (setq n (string-to-number (concat sign ref)))
- (setq n (+ n (if decr -1 1)))
- (if sign
- (concat (if (< n 0) "-" "+") (number-to-string (abs n)))
- (number-to-string (max 1 n))))
- ((string-match "^[a-zA-Z]+" ref)
- (org-number-to-letters
- (max 1 (+ (org-letters-to-number ref) (if decr -1 1)))))
- (t (user-error "Cannot shift reference"))))))
- (defun org-table-fedit-toggle-coordinates ()
- "Toggle the display of coordinates in the referenced table."
- (interactive)
- (let ((pos (marker-position org-pos)))
- (with-current-buffer (marker-buffer org-pos)
- (save-excursion
- (goto-char pos)
- (org-table-toggle-coordinate-overlays)))))
- (defun org-table-fedit-finish (&optional arg)
- "Parse the buffer for formula definitions and install them.
- With prefix ARG, apply the new formulas to the table."
- (interactive "P")
- (org-table-remove-rectangle-highlight)
- (when org-table-use-standard-references
- (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc)
- (setq org-table-buffer-is-an nil))
- (let ((pos org-pos)
- (sel-win org-selected-window)
- (source org-table--fedit-source)
- eql)
- (goto-char (point-min))
- (while (re-search-forward
- "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)"
- nil t)
- (let ((var (match-string 1))
- (form (org-trim (match-string 3))))
- (unless (equal form "")
- (while (string-match "[ \t]*\n[ \t]*" form)
- (setq form (replace-match " " t t form)))
- (when (assoc var eql)
- (user-error "Double formulas for %s" var))
- (push (cons var form) eql))))
- (set-window-configuration org-window-configuration)
- (select-window sel-win)
- (goto-char source)
- (org-table-store-formulas eql)
- (set-marker pos nil)
- (set-marker source nil)
- (kill-buffer "*Edit Formulas*")
- (if arg
- (org-table-recalculate 'all)
- (message "New formulas installed - press C-u C-c C-c to apply."))))
- (defun org-table-fedit-abort ()
- "Abort editing formulas, without installing the changes."
- (interactive)
- (org-table-remove-rectangle-highlight)
- (let ((pos org-pos) (sel-win org-selected-window))
- (set-window-configuration org-window-configuration)
- (select-window sel-win)
- (goto-char pos)
- (move-marker pos nil)
- (message "Formula editing aborted without installing changes")))
- (defun org-table-fedit-lisp-indent ()
- "Pretty-print and re-indent Lisp expressions in the Formula Editor."
- (interactive)
- (let ((pos (point)) beg end ind)
- (beginning-of-line 1)
- (cond
- ((looking-at "[ \t]")
- (goto-char pos)
- (call-interactively 'lisp-indent-line))
- ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos))
- ((not (fboundp 'pp-buffer))
- (user-error "Cannot pretty-print. Command `pp-buffer' is not available"))
- ((looking-at "[$&@0-9a-zA-Z]+ *= *'(")
- (goto-char (- (match-end 0) 2))
- (setq beg (point))
- (setq ind (make-string (current-column) ?\ ))
- (condition-case nil (forward-sexp 1)
- (error
- (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis")))
- (setq end (point))
- (save-restriction
- (narrow-to-region beg end)
- (if (eq last-command this-command)
- (progn
- (goto-char (point-min))
- (setq this-command nil)
- (while (re-search-forward "[ \t]*\n[ \t]*" nil t)
- (replace-match " ")))
- (pp-buffer)
- (untabify (point-min) (point-max))
- (goto-char (1+ (point-min)))
- (while (re-search-forward "^." nil t)
- (beginning-of-line 1)
- (insert ind))
- (goto-char (point-max))
- (org-delete-backward-char 1)))
- (goto-char beg))
- (t nil))))
- (defvar org-show-positions nil)
- (defun org-table-show-reference (&optional local)
- "Show the location/value of the $ expression at point.
- When LOCAL is non-nil, show references for the table at point."
- (interactive)
- (org-table-remove-rectangle-highlight)
- (when local (org-table-analyze))
- (catch 'exit
- (let ((pos (if local (point) org-pos))
- (face2 'highlight)
- (org-inhibit-highlight-removal t)
- (win (selected-window))
- (org-show-positions nil)
- var name e what match dest)
- (setq what (cond
- ((org-in-regexp "^@[0-9]+[ \t=]")
- (setq match (concat (substring (match-string 0) 0 -1)
- "$1.."
- (substring (match-string 0) 0 -1)
- "$100"))
- 'range)
- ((or (org-in-regexp org-table-range-regexp2)
- (org-in-regexp org-table-translate-regexp)
- (org-in-regexp org-table-range-regexp))
- (setq match
- (save-match-data
- (org-table-convert-refs-to-rc (match-string 0))))
- 'range)
- ((org-in-regexp "\\$[a-zA-Z][a-zA-Z0-9]*") 'name)
- ((org-in-regexp "\\$[0-9]+") 'column)
- ((not local) nil)
- (t (user-error "No reference at point")))
- match (and what (or match (match-string 0))))
- (when (and match (not (equal (match-beginning 0) (point-at-bol))))
- (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0)
- 'secondary-selection))
- (add-hook 'before-change-functions
- #'org-table-remove-rectangle-highlight)
- (when (eq what 'name) (setq var (substring match 1)))
- (when (eq what 'range)
- (unless (eq (string-to-char match) ?@) (setq match (concat "@" match)))
- (setq match (org-table-formula-substitute-names match)))
- (unless local
- (save-excursion
- (end-of-line)
- (re-search-backward "^\\S-" nil t)
- (beginning-of-line)
- (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\
- \\([0-9]+\\|&\\)\\) *=")
- (setq dest
- (save-match-data
- (org-table-convert-refs-to-rc (match-string 1))))
- (org-table-add-rectangle-overlay
- (match-beginning 1) (match-end 1) face2))))
- (if (and (markerp pos) (marker-buffer pos))
- (if (get-buffer-window (marker-buffer pos))
- (select-window (get-buffer-window (marker-buffer pos)))
- (org-switch-to-buffer-other-window (get-buffer-window
- (marker-buffer pos)))))
- (goto-char pos)
- (org-table-force-dataline)
- (let ((table-start
- (if local org-table-current-begin-pos (org-table-begin))))
- (when dest
- (setq name (substring dest 1))
- (cond
- ((string-match-p "\\`\\$[a-zA-Z][a-zA-Z0-9]*" dest)
- (org-table-goto-field dest))
- ((string-match-p "\\`@\\([1-9][0-9]*\\)\\$\\([1-9][0-9]*\\)\\'"
- dest)
- (org-table-goto-field dest))
- (t (org-table-goto-column (string-to-number name))))
- (move-marker pos (point))
- (org-table-highlight-rectangle nil nil face2))
- (cond
- ((equal dest match))
- ((not match))
- ((eq what 'range)
- (ignore-errors (org-table-get-range match table-start nil 'highlight)))
- ((setq e (assoc var org-table-named-field-locations))
- (org-table-goto-field var)
- (org-table-highlight-rectangle)
- (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e)))
- ((setq e (assoc var org-table-column-names))
- (org-table-goto-column (string-to-number (cdr e)))
- (org-table-highlight-rectangle)
- (goto-char table-start)
- (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|")
- (org-table-end) t)
- (progn
- (goto-char (match-beginning 1))
- (org-table-highlight-rectangle)
- (message "Named column (column %s)" (cdr e)))
- (user-error "Column name not found")))
- ((eq what 'column)
- ;; Column number.
- (org-table-goto-column (string-to-number (substring match 1)))
- (org-table-highlight-rectangle)
- (message "Column %s" (substring match 1)))
- ((setq e (assoc var org-table-local-parameters))
- (goto-char table-start)
- (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t)
- (progn
- (goto-char (match-beginning 1))
- (org-table-highlight-rectangle)
- (message "Local parameter."))
- (user-error "Parameter not found")))
- ((not var) (user-error "No reference at point"))
- ((setq e (assoc var org-table-formula-constants-local))
- (message "Local Constant: $%s=%s in #+CONSTANTS line."
- var (cdr e)))
- ((setq e (assoc var org-table-formula-constants))
- (message "Constant: $%s=%s in `org-table-formula-constants'."
- var (cdr e)))
- ((setq e (and (fboundp 'constants-get) (constants-get var)))
- (message "Constant: $%s=%s, from `constants.el'%s."
- var e (format " (%s units)" constants-unit-system)))
- (t (user-error "Undefined name $%s" var)))
- (goto-char pos)
- (when (and org-show-positions
- (not (memq this-command '(org-table-fedit-scroll
- org-table-fedit-scroll-down))))
- (push pos org-show-positions)
- (push table-start org-show-positions)
- (let ((min (apply 'min org-show-positions))
- (max (apply 'max org-show-positions)))
- (set-window-start (selected-window) min)
- (goto-char max)
- (or (pos-visible-in-window-p max)
- (set-window-start (selected-window) max)))))
- (select-window win))))
- (defun org-table-force-dataline ()
- "Make sure the cursor is in a dataline in a table."
- (unless (save-excursion
- (beginning-of-line 1)
- (looking-at org-table-dataline-regexp))
- (let* ((re org-table-dataline-regexp)
- (p1 (save-excursion (re-search-forward re nil 'move)))
- (p2 (save-excursion (re-search-backward re nil 'move))))
- (cond ((and p1 p2)
- (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point))))
- p1 p2)))
- ((or p1 p2) (goto-char (or p1 p2)))
- (t (user-error "No table dataline around here"))))))
- (defun org-table-fedit-line-up ()
- "Move cursor one line up in the window showing the table."
- (interactive)
- (org-table-fedit-move 'previous-line))
- (defun org-table-fedit-line-down ()
- "Move cursor one line down in the window showing the table."
- (interactive)
- (org-table-fedit-move 'next-line))
- (defun org-table-fedit-move (command)
- "Move the cursor in the window showing the table.
- Use COMMAND to do the motion, repeat if necessary to end up in a data line."
- (let ((org-table-allow-automatic-line-recalculation nil)
- (pos org-pos) (win (selected-window)) p)
- (select-window (get-buffer-window (marker-buffer org-pos)))
- (setq p (point))
- (call-interactively command)
- (while (and (org-at-table-p)
- (org-at-table-hline-p))
- (call-interactively command))
- (or (org-at-table-p) (goto-char p))
- (move-marker pos (point))
- (select-window win)))
- (defun org-table-fedit-scroll (N)
- (interactive "p")
- (let ((other-window-scroll-buffer (marker-buffer org-pos)))
- (scroll-other-window N)))
- (defun org-table-fedit-scroll-down (N)
- (interactive "p")
- (org-table-fedit-scroll (- N)))
- (defvar org-table-rectangle-overlays nil)
- (defun org-table-add-rectangle-overlay (beg end &optional face)
- "Add a new overlay."
- (let ((ov (make-overlay beg end)))
- (overlay-put ov 'face (or face 'secondary-selection))
- (push ov org-table-rectangle-overlays)))
- (defun org-table-highlight-rectangle (&optional beg end face)
- "Highlight rectangular region in a table.
- When buffer positions BEG and END are provided, use them to
- delimit the region to highlight. Otherwise, refer to point. Use
- FACE, when non-nil, for the highlight."
- (let* ((beg (or beg (point)))
- (end (or end (point)))
- (b (min beg end))
- (e (max beg end))
- (start-coordinates
- (save-excursion
- (goto-char b)
- (cons (line-beginning-position) (org-table-current-column))))
- (end-coordinates
- (save-excursion
- (goto-char e)
- (cons (line-beginning-position) (org-table-current-column)))))
- (when (boundp 'org-show-positions)
- (setq org-show-positions (cons b (cons e org-show-positions))))
- (goto-char (car start-coordinates))
- (let ((column-start (min (cdr start-coordinates) (cdr end-coordinates)))
- (column-end (max (cdr start-coordinates) (cdr end-coordinates)))
- (last-row (car end-coordinates)))
- (while (<= (point) last-row)
- (when (looking-at org-table-dataline-regexp)
- (org-table-goto-column column-start)
- (skip-chars-backward "^|\n")
- (let ((p (point)))
- (org-table-goto-column column-end)
- (skip-chars-forward "^|\n")
- (org-table-add-rectangle-overlay p (point) face)))
- (forward-line)))
- (goto-char (car start-coordinates)))
- (add-hook 'before-change-functions #'org-table-remove-rectangle-highlight))
- (defun org-table-remove-rectangle-highlight (&rest _ignore)
- "Remove the rectangle overlays."
- (unless org-inhibit-highlight-removal
- (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight)
- (mapc 'delete-overlay org-table-rectangle-overlays)
- (setq org-table-rectangle-overlays nil)))
- (defvar-local org-table-coordinate-overlays nil
- "Collects the coordinate grid overlays, so that they can be removed.")
- (defun org-table-overlay-coordinates ()
- "Add overlays to the table at point, to show row/column coordinates."
- (interactive)
- (mapc 'delete-overlay org-table-coordinate-overlays)
- (setq org-table-coordinate-overlays nil)
- (save-excursion
- (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg)
- (goto-char (org-table-begin))
- (while (org-at-table-p)
- (setq eol (point-at-eol))
- (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol))))
- (push ov org-table-coordinate-overlays)
- (setq hline (looking-at org-table-hline-regexp))
- (setq str (if hline (format "I*%-2d" (setq ih (1+ ih)))
- (format "%4d" (setq id (1+ id)))))
- (org-overlay-before-string ov str 'org-special-keyword 'evaporate)
- (when hline
- (setq ic 0)
- (while (re-search-forward "[+|]\\(-+\\)" eol t)
- (setq beg (1+ (match-beginning 0))
- ic (1+ ic)
- s1 (concat "$" (int-to-string ic))
- s2 (org-number-to-letters ic)
- str (if (eq org-table-use-standard-references t) s2 s1))
- (setq ov (make-overlay beg (+ beg (length str))))
- (push ov org-table-coordinate-overlays)
- (org-overlay-display ov str 'org-special-keyword 'evaporate)))
- (beginning-of-line 2)))))
- ;;;###autoload
- (defun org-table-toggle-coordinate-overlays ()
- "Toggle the display of Row/Column numbers in tables."
- (interactive)
- (setq org-table-overlay-coordinates (not org-table-overlay-coordinates))
- (message "Tables Row/Column numbers display turned %s"
- (if org-table-overlay-coordinates "on" "off"))
- (if (and (org-at-table-p) org-table-overlay-coordinates)
- (org-table-align))
- (unless org-table-overlay-coordinates
- (mapc 'delete-overlay org-table-coordinate-overlays)
- (setq org-table-coordinate-overlays nil)))
- ;;;###autoload
- (defun org-table-toggle-formula-debugger ()
- "Toggle the formula debugger in tables."
- (interactive)
- (setq org-table-formula-debug (not org-table-formula-debug))
- (message "Formula debugging has been turned %s"
- (if org-table-formula-debug "on" "off")))
- ;;; The orgtbl minor mode
- ;; Define a minor mode which can be used in other modes in order to
- ;; integrate the Org table editor.
- ;; This is really a hack, because the Org table editor uses several
- ;; keys which normally belong to the major mode, for example the TAB
- ;; and RET keys. Here is how it works: The minor mode defines all the
- ;; keys necessary to operate the table editor, but wraps the commands
- ;; into a function which tests if the cursor is currently inside
- ;; a table. If that is the case, the table editor command is
- ;; executed. However, when any of those keys is used outside a table,
- ;; the function uses `key-binding' to look up if the key has an
- ;; associated command in another currently active keymap (minor modes,
- ;; major mode, global), and executes that command. There might be
- ;; problems if any of the keys used by the table editor is otherwise
- ;; used as a prefix key.
- ;; Another challenge is that the key binding for TAB can be tab or \C-i,
- ;; likewise the binding for RET can be return or \C-m. Orgtbl-mode
- ;; addresses this by checking explicitly for both bindings.
- ;; The optimized version (see variable `orgtbl-optimized') takes over
- ;; all keys which are bound to `self-insert-command' in the *global map*.
- ;; Some modes bind other commands to simple characters, for example
- ;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode
- ;; active, this binding is ignored inside tables and replaced with a
- ;; modified self-insert.
- (defvar orgtbl-mode-map (make-keymap)
- "Keymap for `orgtbl-mode'.")
- (defvar org-old-auto-fill-inhibit-regexp nil
- "Local variable used by `orgtbl-mode'.")
- (defconst orgtbl-line-start-regexp
- "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)"
- "Matches a line belonging to an orgtbl.")
- (defconst orgtbl-extra-font-lock-keywords
- (list (list (concat "^" orgtbl-line-start-regexp ".*")
- 0 (quote 'org-table) 'prepend))
- "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.")
- ;; Install it as a minor mode.
- (put 'orgtbl-mode :included t)
- (put 'orgtbl-mode :menu-tag "Org Table Mode")
- ;;;###autoload
- (define-minor-mode orgtbl-mode
- "The Org mode table editor as a minor mode for use in other modes."
- :lighter " OrgTbl" :keymap orgtbl-mode-map
- (org-load-modules-maybe)
- (cond
- ((derived-mode-p 'org-mode)
- ;; Exit without error, in case some hook functions calls this by
- ;; accident in Org mode.
- (message "Orgtbl mode is not useful in Org mode, command ignored"))
- (orgtbl-mode
- (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?!
- ;; Make sure we are first in minor-mode-map-alist
- (let ((c (assq 'orgtbl-mode minor-mode-map-alist)))
- ;; FIXME: maybe it should use emulation-mode-map-alists?
- (and c (setq minor-mode-map-alist
- (cons c (delq c minor-mode-map-alist)))))
- (setq-local org-table-may-need-update t)
- (add-hook 'before-change-functions 'org-before-change-function
- nil 'local)
- (setq-local org-old-auto-fill-inhibit-regexp
- auto-fill-inhibit-regexp)
- (setq-local auto-fill-inhibit-regexp
- (if auto-fill-inhibit-regexp
- (concat orgtbl-line-start-regexp "\\|"
- auto-fill-inhibit-regexp)
- orgtbl-line-start-regexp))
- (add-to-invisibility-spec '(org-cwidth))
- (when (fboundp 'font-lock-add-keywords)
- (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock))
- (easy-menu-add orgtbl-mode-menu))
- (t
- (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp)
- (org-table-cleanup-narrow-column-properties)
- (org-remove-from-invisibility-spec '(org-cwidth))
- (remove-hook 'before-change-functions 'org-before-change-function t)
- (when (fboundp 'font-lock-remove-keywords)
- (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords)
- (org-restart-font-lock))
- (easy-menu-remove orgtbl-mode-menu)
- (force-mode-line-update 'all))))
- (defun org-table-cleanup-narrow-column-properties ()
- "Remove all properties related to narrow-column invisibility."
- (let ((s (point-min)))
- (while (setq s (text-property-any s (point-max)
- 'display org-narrow-column-arrow))
- (remove-text-properties s (1+ s) '(display t)))
- (setq s (point-min))
- (while (setq s (text-property-any s (point-max) 'org-cwidth 1))
- (remove-text-properties s (1+ s) '(org-cwidth t)))
- (setq s (point-min))
- (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth))
- (remove-text-properties s (1+ s) '(invisible t)))))
- (defun orgtbl-make-binding (fun n &rest keys)
- "Create a function for binding in the table minor mode.
- FUN is the command to call inside a table. N is used to create a unique
- command name. KEYS are keys that should be checked in for a command
- to execute outside of tables."
- (eval
- (list 'defun
- (intern (concat "orgtbl-hijacker-command-" (int-to-string n)))
- '(arg)
- (concat "In tables, run `" (symbol-name fun) "'.\n"
- "Outside of tables, run the binding of `"
- (mapconcat #'key-description keys "' or `")
- "'.")
- '(interactive "p")
- (list 'if
- '(org-at-table-p)
- (list 'call-interactively (list 'quote fun))
- (list 'let '(orgtbl-mode)
- (list 'call-interactively
- (append '(or)
- (mapcar (lambda (k)
- (list 'key-binding k))
- keys)
- '('orgtbl-error))))))))
- (defun orgtbl-error ()
- "Error when there is no default binding for a table key."
- (interactive)
- (user-error "This key has no function outside tables"))
- (defun orgtbl-setup ()
- "Setup orgtbl keymaps."
- (let ((nfunc 0)
- (bindings
- '(([(meta shift left)] org-table-delete-column)
- ([(meta left)] org-table-move-column-left)
- ([(meta right)] org-table-move-column-right)
- ([(meta shift right)] org-table-insert-column)
- ([(meta shift up)] org-table-kill-row)
- ([(meta shift down)] org-table-insert-row)
- ([(meta up)] org-table-move-row-up)
- ([(meta down)] org-table-move-row-down)
- ("\C-c\C-w" org-table-cut-region)
- ("\C-c\M-w" org-table-copy-region)
- ("\C-c\C-y" org-table-paste-rectangle)
- ("\C-c\C-w" org-table-wrap-region)
- ("\C-c-" org-table-insert-hline)
- ("\C-c}" org-table-toggle-coordinate-overlays)
- ("\C-c{" org-table-toggle-formula-debugger)
- ("\C-m" org-table-next-row)
- ([(shift return)] org-table-copy-down)
- ("\C-c?" org-table-field-info)
- ("\C-c " org-table-blank-field)
- ("\C-c+" org-table-sum)
- ("\C-c=" org-table-eval-formula)
- ("\C-c'" org-table-edit-formulas)
- ("\C-c`" org-table-edit-field)
- ("\C-c*" org-table-recalculate)
- ("\C-c^" org-table-sort-lines)
- ("\M-a" org-table-beginning-of-field)
- ("\M-e" org-table-end-of-field)
- ([(control ?#)] org-table-rotate-recalc-marks)))
- elt key fun cmd)
- (while (setq elt (pop bindings))
- (setq nfunc (1+ nfunc))
- (setq key (org-key (car elt))
- fun (nth 1 elt)
- cmd (orgtbl-make-binding fun nfunc key))
- (org-defkey orgtbl-mode-map key cmd))
- ;; Special treatment needed for TAB, RET and DEL
- (org-defkey orgtbl-mode-map [(return)]
- (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m"))
- (org-defkey orgtbl-mode-map "\C-m"
- (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)]))
- (org-defkey orgtbl-mode-map [(tab)]
- (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i"))
- (org-defkey orgtbl-mode-map "\C-i"
- (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)]))
- (org-defkey orgtbl-mode-map [(shift tab)]
- (orgtbl-make-binding 'org-table-previous-field 104
- [(shift tab)] [(tab)] "\C-i"))
- (org-defkey orgtbl-mode-map [backspace]
- (orgtbl-make-binding 'org-delete-backward-char 109
- [backspace] (kbd "DEL")))
- (org-defkey orgtbl-mode-map [S-iso-lefttab]
- (orgtbl-make-binding 'org-table-previous-field 107
- [S-iso-lefttab] [backtab] [(shift tab)]
- [(tab)] "\C-i"))
- (org-defkey orgtbl-mode-map [backtab]
- (orgtbl-make-binding 'org-table-previous-field 108
- [backtab] [S-iso-lefttab] [(shift tab)]
- [(tab)] "\C-i"))
- (org-defkey orgtbl-mode-map "\M-\C-m"
- (orgtbl-make-binding 'org-table-wrap-region 105
- "\M-\C-m" [(meta return)]))
- (org-defkey orgtbl-mode-map [(meta return)]
- (orgtbl-make-binding 'org-table-wrap-region 106
- [(meta return)] "\M-\C-m"))
- (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c)
- (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region)
- (when orgtbl-optimized
- ;; If the user wants maximum table support, we need to hijack
- ;; some standard editing functions
- (org-remap orgtbl-mode-map
- 'self-insert-command 'orgtbl-self-insert-command
- 'delete-char 'org-delete-char
- 'delete-backward-char 'org-delete-backward-char)
- (org-defkey orgtbl-mode-map "|" 'org-force-self-insert))
- (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu"
- '("OrgTbl"
- ["Create or convert" org-table-create-or-convert-from-region
- :active (not (org-at-table-p)) :keys "C-c |" ]
- "--"
- ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"]
- ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"]
- ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"]
- ["Next Row" org-return :active (org-at-table-p) :keys "RET"]
- "--"
- ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"]
- ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "]
- ["Copy Field from Above"
- org-table-copy-down :active (org-at-table-p) :keys "S-RET"]
- "--"
- ("Column"
- ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"]
- ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"]
- ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"]
- ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"])
- ("Row"
- ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"]
- ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"]
- ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"]
- ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"]
- ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"]
- "--"
- ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"])
- ("Rectangle"
- ["Copy Rectangle" org-copy-special :active (org-at-table-p)]
- ["Cut Rectangle" org-cut-special :active (org-at-table-p)]
- ["Paste Rectangle" org-paste-special :active (org-at-table-p)]
- ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)])
- "--"
- ("Radio tables"
- ["Insert table template" orgtbl-insert-radio-table
- (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates)]
- ["Comment/uncomment table" orgtbl-toggle-comment t])
- "--"
- ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="]
- ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="]
- ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"]
- ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"]
- ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"]
- ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"]
- ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"]
- ["Sum Column/Rectangle" org-table-sum
- :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"]
- ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"]
- ["Debug Formulas"
- org-table-toggle-formula-debugger :active (org-at-table-p)
- :keys "C-c {"
- :style toggle :selected org-table-formula-debug]
- ["Show Col/Row Numbers"
- org-table-toggle-coordinate-overlays :active (org-at-table-p)
- :keys "C-c }"
- :style toggle :selected org-table-overlay-coordinates]
- "--"
- ("Plot"
- ["Ascii plot" orgtbl-ascii-plot :active (org-at-table-p) :keys "C-c \" a"]
- ["Gnuplot" org-plot/gnuplot :active (org-at-table-p) :keys "C-c \" g"])))
- t))
- (defun orgtbl-ctrl-c-ctrl-c (arg)
- "If the cursor is inside a table, realign the table.
- If it is a table to be sent away to a receiver, do it.
- With prefix arg, also recompute table."
- (interactive "P")
- (let ((case-fold-search t) (pos (point)) action)
- (save-excursion
- (beginning-of-line 1)
- (setq action (cond
- ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0))
- ((looking-at "[ \t]*|") pos)
- ((looking-at "[ \t]*#\\+tblfm:") 'recalc))))
- (cond
- ((integerp action)
- (goto-char action)
- (org-table-maybe-eval-formula)
- (if arg
- (call-interactively 'org-table-recalculate)
- (org-table-maybe-recalculate-line))
- (call-interactively 'org-table-align)
- (when (orgtbl-send-table 'maybe)
- (run-hooks 'orgtbl-after-send-table-hook)))
- ((eq action 'recalc)
- (save-excursion
- (beginning-of-line 1)
- (skip-chars-backward " \r\n\t")
- (if (org-at-table-p)
- (org-call-with-arg 'org-table-recalculate t))))
- (t (let (orgtbl-mode)
- (call-interactively (key-binding "\C-c\C-c")))))))
- (defun orgtbl-create-or-convert-from-region (_arg)
- "Create table or convert region to table, if no conflicting binding.
- This installs the table binding `C-c |', but only if there is no
- conflicting binding to this key outside orgtbl-mode."
- (interactive "P")
- (let* (orgtbl-mode (cmd (key-binding "\C-c|")))
- (if cmd
- (call-interactively cmd)
- (call-interactively 'org-table-create-or-convert-from-region))))
- (defun orgtbl-tab (arg)
- "Justification and field motion for `orgtbl-mode'."
- (interactive "P")
- (if arg (org-table-edit-field t)
- (org-table-justify-field-maybe)
- (org-table-next-field)))
- (defun orgtbl-ret ()
- "Justification and field motion for `orgtbl-mode'."
- (interactive)
- (if (bobp)
- (newline)
- (org-table-justify-field-maybe)
- (org-table-next-row)))
- (defun orgtbl-self-insert-command (N)
- "Like `self-insert-command', use overwrite-mode for whitespace in tables.
- If the cursor is in a table looking at whitespace, the whitespace is
- overwritten, and the table is not marked as requiring realignment."
- (interactive "p")
- (if (and (org-at-table-p)
- (or
- (and org-table-auto-blank-field
- (member last-command
- '(orgtbl-hijacker-command-100
- orgtbl-hijacker-command-101
- orgtbl-hijacker-command-102
- orgtbl-hijacker-command-103
- orgtbl-hijacker-command-104
- orgtbl-hijacker-command-105
- yas/expand))
- (org-table-blank-field))
- t)
- (eq N 1)
- (looking-at "[^|\n]* \\( \\)|"))
- (let (org-table-may-need-update)
- (delete-region (match-beginning 1) (match-end 1))
- (self-insert-command N))
- (setq org-table-may-need-update t)
- (let* (orgtbl-mode
- a
- (cmd (or (key-binding
- (or (and (listp function-key-map)
- (setq a (assoc last-input-event function-key-map))
- (cdr a))
- (vector last-input-event)))
- 'self-insert-command)))
- (call-interactively cmd)
- (if (and org-self-insert-cluster-for-undo
- (eq cmd 'self-insert-command))
- (if (not (eq last-command 'orgtbl-self-insert-command))
- (setq org-self-insert-command-undo-counter 1)
- (if (>= org-self-insert-command-undo-counter 20)
- (setq org-self-insert-command-undo-counter 1)
- (and (> org-self-insert-command-undo-counter 0)
- buffer-undo-list
- (not (cadr buffer-undo-list)) ; remove nil entry
- (setcdr buffer-undo-list (cddr buffer-undo-list)))
- (setq org-self-insert-command-undo-counter
- (1+ org-self-insert-command-undo-counter))))))))
- ;;;###autoload
- (defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$"
- "Regular expression matching exponentials as produced by calc.")
- (defun orgtbl-gather-send-defs ()
- "Gather a plist of :name, :transform, :params for each destination before
- a radio table."
- (save-excursion
- (goto-char (org-table-begin))
- (let (rtn)
- (beginning-of-line 0)
- (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?")
- (let ((name (org-no-properties (match-string 1)))
- (transform (intern (match-string 2)))
- (params (if (match-end 3)
- (read (concat "(" (match-string 3) ")")))))
- (push (list :name name :transform transform :params params)
- rtn)
- (beginning-of-line 0)))
- rtn)))
- (defun orgtbl-send-replace-tbl (name text)
- "Find and replace table NAME with TEXT."
- (save-excursion
- (goto-char (point-min))
- (let* ((location-flag nil)
- (name (regexp-quote name))
- (begin-re (format "BEGIN +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name))
- (end-re (format "END +RECEIVE +ORGTBL +%s\\([ \t]\\|$\\)" name)))
- (while (re-search-forward begin-re nil t)
- (unless location-flag (setq location-flag t))
- (let ((beg (line-beginning-position 2)))
- (unless (re-search-forward end-re nil t)
- (user-error "Cannot find end of receiver location at %d" beg))
- (beginning-of-line)
- (delete-region beg (point))
- (insert text "\n")))
- (unless location-flag
- (user-error "No valid receiver location found in the buffer")))))
- ;;;###autoload
- (defun org-table-to-lisp (&optional txt)
- "Convert the table at point to a Lisp structure.
- The structure will be a list. Each item is either the symbol `hline'
- for a horizontal separator line, or a list of field values as strings.
- The table is taken from the parameter TXT, or from the buffer at point."
- (unless (or txt (org-at-table-p)) (user-error "No table at point"))
- (let ((txt (or txt
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end)))))
- (mapcar (lambda (x)
- (if (string-match org-table-hline-regexp x) 'hline
- (org-split-string (org-trim x) "\\s-*|\\s-*")))
- (org-split-string txt "[ \t]*\n[ \t]*"))))
- (defun orgtbl-send-table (&optional maybe)
- "Send a transformed version of table at point to the receiver position.
- With argument MAYBE, fail quietly if no transformation is defined
- for this table."
- (interactive)
- (catch 'exit
- (unless (org-at-table-p) (user-error "Not at a table"))
- ;; when non-interactive, we assume align has just happened.
- (when (called-interactively-p 'any) (org-table-align))
- (let ((dests (orgtbl-gather-send-defs))
- (table (org-table-to-lisp
- (buffer-substring-no-properties (org-table-begin)
- (org-table-end))))
- (ntbl 0))
- (unless dests
- (if maybe (throw 'exit nil)
- (user-error "Don't know how to transform this table")))
- (dolist (dest dests)
- (let ((name (plist-get dest :name))
- (transform (plist-get dest :transform))
- (params (plist-get dest :params)))
- (unless (fboundp transform)
- (user-error "No such transformation function %s" transform))
- (orgtbl-send-replace-tbl name (funcall transform table params)))
- (cl-incf ntbl))
- (message "Table converted and installed at %d receiver location%s"
- ntbl (if (> ntbl 1) "s" ""))
- (and (> ntbl 0) ntbl))))
- (defun org-remove-by-index (list indices &optional i0)
- "Remove the elements in LIST with indices in INDICES.
- First element has index 0, or I0 if given."
- (if (not indices)
- list
- (if (integerp indices) (setq indices (list indices)))
- (setq i0 (1- (or i0 0)))
- (delq :rm (mapcar (lambda (x)
- (setq i0 (1+ i0))
- (if (memq i0 indices) :rm x))
- list))))
- (defun orgtbl-toggle-comment ()
- "Comment or uncomment the orgtbl at point."
- (interactive)
- (let* ((case-fold-search t)
- (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp))
- (re2 (concat "^" orgtbl-line-start-regexp))
- (commented (save-excursion (beginning-of-line 1)
- (cond ((looking-at re1) t)
- ((looking-at re2) nil)
- (t (user-error "Not at an org table")))))
- (re (if commented re1 re2))
- beg end)
- (save-excursion
- (beginning-of-line 1)
- (while (looking-at re) (beginning-of-line 0))
- (beginning-of-line 2)
- (setq beg (point))
- (while (looking-at re) (beginning-of-line 2))
- (setq end (point)))
- (comment-region beg end (if commented '(4) nil))))
- (defun orgtbl-insert-radio-table ()
- "Insert a radio table template appropriate for this major mode."
- (interactive)
- (let* ((e (cl-assoc-if #'derived-mode-p orgtbl-radio-table-templates))
- (txt (nth 1 e))
- name pos)
- (unless e (user-error "No radio table setup defined for %s" major-mode))
- (setq name (read-string "Table name: "))
- (while (string-match "%n" txt)
- (setq txt (replace-match name t t txt)))
- (or (bolp) (insert "\n"))
- (setq pos (point))
- (insert txt)
- (goto-char pos)))
- ;;;###autoload
- (defun orgtbl-to-generic (table params)
- "Convert the orgtbl-mode TABLE to some other format.
- This generic routine can be used for many standard cases.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that
- line. PARAMS is a property list of parameters that can
- influence the conversion.
- Valid parameters are:
- :backend, :raw
- Export back-end used as a basis to transcode elements of the
- table, when no specific parameter applies to it. It is also
- used to translate cells contents. You can prevent this by
- setting :raw property to a non-nil value.
- :splice
- When non-nil, only convert rows, not the table itself. This is
- equivalent to setting to the empty string both :tstart
- and :tend, which see.
- :skip
- When set to an integer N, skip the first N lines of the table.
- Horizontal separation lines do count for this parameter!
- :skipcols
- List of columns that should be skipped. If the table has
- a column with calculation marks, that column is automatically
- discarded beforehand.
- :hline
- String to be inserted on horizontal separation lines. May be
- nil to ignore these lines altogether.
- :sep
- Separator between two fields, as a string.
- Each in the following group may be either a string or a function
- of no arguments returning a string:
- :tstart, :tend
- Strings to start and end the table. Ignored when :splice is t.
- :lstart, :lend
- Strings to start and end a new table line.
- :llstart, :llend
- Strings to start and end the last table line. Default,
- respectively, to :lstart and :lend.
- Each in the following group may be a string or a function of one
- argument (either the cells in the current row, as a list of
- strings, or the current cell) returning a string:
- :lfmt
- Format string for an entire row, with enough %s to capture all
- fields. When non-nil, :lstart, :lend, and :sep are ignored.
- :llfmt
- Format for the entire last line, defaults to :lfmt.
- :fmt
- A format to be used to wrap the field, should contain %s for
- the original field value. For example, to wrap everything in
- dollars, you could use :fmt \"$%s$\". This may also be
- a property list with column numbers and format strings, or
- functions, e.g.,
- (:fmt (2 \"$%s$\" 4 (lambda (c) (format \"$%s$\" c))))
- :hlstart :hllstart :hlend :hllend :hsep :hlfmt :hllfmt :hfmt
- Same as above, specific for the header lines in the table.
- All lines before the first hline are treated as header. If
- any of these is not present, the data line value is used.
- This may be either a string or a function of two arguments:
- :efmt
- Use this format to print numbers with exponential. The format
- should have %s twice for inserting mantissa and exponent, for
- example \"%s\\\\times10^{%s}\". This may also be a property
- list with column numbers and format strings or functions.
- :fmt will still be applied after :efmt."
- ;; Make sure `org-export-create-backend' is available.
- (require 'ox)
- (let* ((backend (plist-get params :backend))
- (custom-backend
- ;; Build a custom back-end according to PARAMS. Before
- ;; defining a translator, check if there is anything to do.
- ;; When there isn't, let BACKEND handle the element.
- (org-export-create-backend
- :parent (or backend 'org)
- :transcoders
- `((table . ,(org-table--to-generic-table params))
- (table-row . ,(org-table--to-generic-row params))
- (table-cell . ,(org-table--to-generic-cell params))
- ;; Macros are not going to be expanded. However, no
- ;; regular back-end has a transcoder for them. We
- ;; provide one so they are not ignored, but displayed
- ;; as-is instead.
- (macro . (lambda (m c i) (org-element-macro-interpreter m nil))))))
- data info)
- ;; Store TABLE as Org syntax in DATA. Tolerate non-string cells.
- ;; Initialize communication channel in INFO.
- (with-temp-buffer
- (let ((org-inhibit-startup t)) (org-mode))
- (let ((standard-output (current-buffer))
- (org-element-use-cache nil))
- (dolist (e table)
- (cond ((eq e 'hline) (princ "|--\n"))
- ((consp e)
- (princ "| ") (dolist (c e) (princ c) (princ " |"))
- (princ "\n")))))
- ;; Add back-end specific filters, but not user-defined ones. In
- ;; particular, make sure to call parse-tree filters on the
- ;; table.
- (setq info
- (let ((org-export-filters-alist nil))
- (org-export-install-filters
- (org-combine-plists
- (org-export-get-environment backend nil params)
- `(:back-end ,(org-export-get-backend backend))))))
- (setq data
- (org-export-filter-apply-functions
- (plist-get info :filter-parse-tree)
- (org-element-map (org-element-parse-buffer) 'table
- #'identity nil t)
- info)))
- (when (and backend (symbolp backend) (not (org-export-get-backend backend)))
- (user-error "Unknown :backend value"))
- (when (or (not backend) (plist-get info :raw)) (require 'ox-org))
- ;; Handle :skip parameter.
- (let ((skip (plist-get info :skip)))
- (when skip
- (unless (wholenump skip) (user-error "Wrong :skip value"))
- (let ((n 0))
- (org-element-map data 'table-row
- (lambda (row)
- (if (>= n skip) t
- (org-element-extract-element row)
- (cl-incf n)
- nil))
- nil t))))
- ;; Handle :skipcols parameter.
- (let ((skipcols (plist-get info :skipcols)))
- (when skipcols
- (unless (consp skipcols) (user-error "Wrong :skipcols value"))
- (org-element-map data 'table
- (lambda (table)
- (let ((specialp (org-export-table-has-special-column-p table)))
- (dolist (row (org-element-contents table))
- (when (eq (org-element-property :type row) 'standard)
- (let ((c 1))
- (dolist (cell (nthcdr (if specialp 1 0)
- (org-element-contents row)))
- (when (memq c skipcols)
- (org-element-extract-element cell))
- (cl-incf c))))))))))
- ;; Since we are going to export using a low-level mechanism,
- ;; ignore special column and special rows manually.
- (let ((special? (org-export-table-has-special-column-p data))
- ignore)
- (org-element-map data (if special? '(table-cell table-row) 'table-row)
- (lambda (datum)
- (when (if (eq (org-element-type datum) 'table-row)
- (org-export-table-row-is-special-p datum nil)
- (org-export-first-sibling-p datum nil))
- (push datum ignore))))
- (setq info (plist-put info :ignore-list ignore)))
- ;; We use a low-level mechanism to export DATA so as to skip all
- ;; usual pre-processing and post-processing, i.e., hooks, Babel
- ;; code evaluation, include keywords and macro expansion. Only
- ;; back-end specific filters are retained.
- (let ((output (org-export-data-with-backend data custom-backend info)))
- ;; Remove final newline.
- (if (org-string-nw-p output) (substring-no-properties output 0 -1) ""))))
- (defun org-table--generic-apply (value name &optional with-cons &rest args)
- (cond ((null value) nil)
- ((functionp value) `(funcall ',value ,@args))
- ((stringp value)
- (cond ((consp (car args)) `(apply #'format ,value ,@args))
- (args `(format ,value ,@args))
- (t value)))
- ((and with-cons (consp value))
- `(let ((val (cadr (memq column ',value))))
- (cond ((null val) contents)
- ((stringp val) (format val ,@args))
- ((functionp val) (funcall val ,@args))
- (t (user-error "Wrong %s value" ,name)))))
- (t (user-error "Wrong %s value" name))))
- (defun org-table--to-generic-table (params)
- "Return custom table transcoder according to PARAMS.
- PARAMS is a plist. See `orgtbl-to-generic' for more
- information."
- (let ((backend (plist-get params :backend))
- (splice (plist-get params :splice))
- (tstart (plist-get params :tstart))
- (tend (plist-get params :tend)))
- `(lambda (table contents info)
- (concat
- ,(and tstart (not splice)
- `(concat ,(org-table--generic-apply tstart ":tstart") "\n"))
- ,(if (or (not backend) tstart tend splice) 'contents
- `(org-export-with-backend ',backend table contents info))
- ,(org-table--generic-apply (and (not splice) tend) ":tend")))))
- (defun org-table--to-generic-row (params)
- "Return custom table row transcoder according to PARAMS.
- PARAMS is a plist. See `orgtbl-to-generic' for more
- information."
- (let* ((backend (plist-get params :backend))
- (lstart (plist-get params :lstart))
- (llstart (plist-get params :llstart))
- (hlstart (plist-get params :hlstart))
- (hllstart (plist-get params :hllstart))
- (lend (plist-get params :lend))
- (llend (plist-get params :llend))
- (hlend (plist-get params :hlend))
- (hllend (plist-get params :hllend))
- (lfmt (plist-get params :lfmt))
- (llfmt (plist-get params :llfmt))
- (hlfmt (plist-get params :hlfmt))
- (hllfmt (plist-get params :hllfmt)))
- `(lambda (row contents info)
- (if (eq (org-element-property :type row) 'rule)
- ,(cond
- ((plist-member params :hline)
- (org-table--generic-apply (plist-get params :hline) ":hline"))
- (backend `(org-export-with-backend ',backend row nil info)))
- (let ((headerp ,(and (or hlfmt hlstart hlend)
- '(org-export-table-row-in-header-p row info)))
- (last-header-p
- ,(and (or hllfmt hllstart hllend)
- '(org-export-table-row-ends-header-p row info)))
- (lastp (not (org-export-get-next-element row info))))
- (when contents
- ;; Check if we can apply `:lfmt', `:llfmt', `:hlfmt', or
- ;; `:hllfmt' to CONTENTS. Otherwise, fallback on
- ;; `:lstart', `:lend' and their relatives.
- ,(let ((cells
- '(org-element-map row 'table-cell
- (lambda (cell)
- ;; Export all cells, without separators.
- ;;
- ;; Use `org-export-data-with-backend'
- ;; instead of `org-export-data' to eschew
- ;; cached values, which
- ;; ignore :orgtbl-ignore-sep parameter.
- (org-export-data-with-backend
- cell
- (plist-get info :back-end)
- (org-combine-plists info '(:orgtbl-ignore-sep t))))
- info)))
- `(cond
- ,(and hllfmt
- `(last-header-p ,(org-table--generic-apply
- hllfmt ":hllfmt" nil cells)))
- ,(and hlfmt
- `(headerp ,(org-table--generic-apply
- hlfmt ":hlfmt" nil cells)))
- ,(and llfmt
- `(lastp ,(org-table--generic-apply
- llfmt ":llfmt" nil cells)))
- (t
- ,(if lfmt (org-table--generic-apply lfmt ":lfmt" nil cells)
- `(concat
- (cond
- ,(and
- (or hllstart hllend)
- `(last-header-p
- (concat
- ,(org-table--generic-apply hllstart ":hllstart")
- contents
- ,(org-table--generic-apply hllend ":hllend"))))
- ,(and
- (or hlstart hlend)
- `(headerp
- (concat
- ,(org-table--generic-apply hlstart ":hlstart")
- contents
- ,(org-table--generic-apply hlend ":hlend"))))
- ,(and
- (or llstart llend)
- `(lastp
- (concat
- ,(org-table--generic-apply llstart ":llstart")
- contents
- ,(org-table--generic-apply llend ":llend"))))
- (t
- ,(cond
- ((or lstart lend)
- `(concat
- ,(org-table--generic-apply lstart ":lstart")
- contents
- ,(org-table--generic-apply lend ":lend")))
- (backend
- `(org-export-with-backend
- ',backend row contents info))
- (t 'contents)))))))))))))))
- (defun org-table--to-generic-cell (params)
- "Return custom table cell transcoder according to PARAMS.
- PARAMS is a plist. See `orgtbl-to-generic' for more
- information."
- (let* ((backend (plist-get params :backend))
- (efmt (plist-get params :efmt))
- (fmt (plist-get params :fmt))
- (hfmt (plist-get params :hfmt))
- (sep (plist-get params :sep))
- (hsep (plist-get params :hsep)))
- `(lambda (cell contents info)
- ;; Make sure that contents are exported as Org data when :raw
- ;; parameter is non-nil.
- ,(when (and backend (plist-get params :raw))
- `(setq contents
- ;; Since we don't know what are the pseudo object
- ;; types defined in backend, we cannot pass them to
- ;; `org-element-interpret-data'. As a consequence,
- ;; they will be treated as pseudo elements, and will
- ;; have newlines appended instead of spaces.
- ;; Therefore, we must make sure :post-blank value is
- ;; really turned into spaces.
- (replace-regexp-in-string
- "\n" " "
- (org-trim
- (org-element-interpret-data
- (org-element-contents cell))))))
- (let ((headerp ,(and (or hfmt hsep)
- '(org-export-table-row-in-header-p
- (org-export-get-parent-element cell) info)))
- (column
- ;; Call costly `org-export-table-cell-address' only if
- ;; absolutely necessary, i.e., if one
- ;; of :fmt :efmt :hfmt has a "plist type" value.
- ,(and (cl-some (lambda (v) (integerp (car-safe v)))
- (list efmt hfmt fmt))
- '(1+ (cdr (org-export-table-cell-address cell info))))))
- (when contents
- ;; Check if we can apply `:efmt' on CONTENTS.
- ,(when efmt
- `(when (string-match orgtbl-exp-regexp contents)
- (let ((mantissa (match-string 1 contents))
- (exponent (match-string 2 contents)))
- (setq contents ,(org-table--generic-apply
- efmt ":efmt" t 'mantissa 'exponent)))))
- ;; Check if we can apply FMT (or HFMT) on CONTENTS.
- (cond
- ,(and hfmt `(headerp (setq contents ,(org-table--generic-apply
- hfmt ":hfmt" t 'contents))))
- ,(and fmt `(t (setq contents ,(org-table--generic-apply
- fmt ":fmt" t 'contents))))))
- ;; If a separator is provided, use it instead of BACKEND's.
- ;; Separators are ignored when LFMT (or equivalent) is
- ;; provided.
- ,(cond
- ((or hsep sep)
- `(if (or ,(and (not sep) '(not headerp))
- (plist-get info :orgtbl-ignore-sep)
- (not (org-export-get-next-element cell info)))
- ,(if (not backend) 'contents
- `(org-export-with-backend ',backend cell contents info))
- (concat contents
- ,(if (and sep hsep) `(if headerp ,hsep ,sep)
- (or hsep sep)))))
- (backend `(org-export-with-backend ',backend cell contents info))
- (t 'contents))))))
- ;;;###autoload
- (defun orgtbl-to-tsv (table params)
- "Convert the orgtbl-mode table to TAB separated material."
- (orgtbl-to-generic table (org-combine-plists '(:sep "\t") params)))
- ;;;###autoload
- (defun orgtbl-to-csv (table params)
- "Convert the orgtbl-mode table to CSV material.
- This does take care of the proper quoting of fields with comma or quotes."
- (orgtbl-to-generic table
- (org-combine-plists '(:sep "," :fmt org-quote-csv-field)
- params)))
- ;;;###autoload
- (defun orgtbl-to-latex (table params)
- "Convert the orgtbl-mode TABLE to LaTeX.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that line.
- PARAMS is a property list of parameters that can influence the
- conversion. All parameters from `orgtbl-to-generic' are
- supported. It is also possible to use the following ones:
- :booktabs
- When non-nil, use formal \"booktabs\" style.
- :environment
- Specify environment to use, as a string. If you use
- \"longtable\", you may also want to specify :language property,
- as a string, to get proper continuation strings."
- (require 'ox-latex)
- (orgtbl-to-generic
- table
- (org-combine-plists
- ;; Provide sane default values.
- (list :backend 'latex
- :latex-default-table-mode 'table
- :latex-tables-centered nil
- :latex-tables-booktabs (plist-get params :booktabs)
- :latex-table-scientific-notation nil
- :latex-default-table-environment
- (or (plist-get params :environment) "tabular"))
- params)))
- ;;;###autoload
- (defun orgtbl-to-html (table params)
- "Convert the orgtbl-mode TABLE to HTML.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that line.
- PARAMS is a property list of parameters that can influence the
- conversion. All parameters from `orgtbl-to-generic' are
- supported. It is also possible to use the following one:
- :attributes
- Attributes and values, as a plist, which will be used in
- <table> tag."
- (require 'ox-html)
- (orgtbl-to-generic
- table
- (org-combine-plists
- ;; Provide sane default values.
- (list :backend 'html
- :html-table-data-tags '("<td%s>" . "</td>")
- :html-table-use-header-tags-for-first-column nil
- :html-table-align-individual-fields t
- :html-table-row-tags '("<tr>" . "</tr>")
- :html-table-attributes
- (if (plist-member params :attributes)
- (plist-get params :attributes)
- '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups"
- :frame "hsides")))
- params)))
- ;;;###autoload
- (defun orgtbl-to-texinfo (table params)
- "Convert the orgtbl-mode TABLE to Texinfo.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that line.
- PARAMS is a property list of parameters that can influence the
- conversion. All parameters from `orgtbl-to-generic' are
- supported. It is also possible to use the following one:
- :columns
- Column widths, as a string. When providing column fractions,
- \"@columnfractions\" command can be omitted."
- (require 'ox-texinfo)
- (let ((output
- (orgtbl-to-generic
- table
- (org-combine-plists
- (list :backend 'texinfo
- :texinfo-tables-verbatim nil
- :texinfo-table-scientific-notation nil)
- params)))
- (columns (let ((w (plist-get params :columns)))
- (cond ((not w) nil)
- ((string-match-p "{\\|@columnfractions " w) w)
- (t (concat "@columnfractions " w))))))
- (if (not columns) output
- (replace-regexp-in-string
- "@multitable \\(.*\\)" columns output t nil 1))))
- ;;;###autoload
- (defun orgtbl-to-orgtbl (table params)
- "Convert the orgtbl-mode TABLE into another orgtbl-mode table.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that line.
- PARAMS is a property list of parameters that can influence the
- conversion. All parameters from `orgtbl-to-generic' are
- supported.
- Useful when slicing one table into many. The :hline, :sep,
- :lstart, and :lend provide orgtbl framing. :tstart and :tend can
- be set to provide ORGTBL directives for the generated table."
- (require 'ox-org)
- (orgtbl-to-generic table (org-combine-plists params (list :backend 'org))))
- (defun orgtbl-to-table.el (table params)
- "Convert the orgtbl-mode TABLE into a table.el table.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that line.
- PARAMS is a property list of parameters that can influence the
- conversion. All parameters from `orgtbl-to-generic' are
- supported."
- (with-temp-buffer
- (insert (orgtbl-to-orgtbl table params))
- (org-table-align)
- (replace-regexp-in-string
- "-|" "-+"
- (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size))))))
- (defun orgtbl-to-unicode (table params)
- "Convert the orgtbl-mode TABLE into a table with unicode characters.
- TABLE is a list, each entry either the symbol `hline' for
- a horizontal separator line, or a list of fields for that line.
- PARAMS is a property list of parameters that can influence the
- conversion. All parameters from `orgtbl-to-generic' are
- supported. It is also possible to use the following ones:
- :ascii-art
- When non-nil, use \"ascii-art-to-unicode\" package to translate
- the table. You can download it here:
- http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el.
- :narrow
- When non-nil, narrow columns width than provided width cookie,
- using \"=>\" as an ellipsis, just like in an Org mode buffer."
- (require 'ox-ascii)
- (orgtbl-to-generic
- table
- (org-combine-plists
- (list :backend 'ascii
- :ascii-charset 'utf-8
- :ascii-table-widen-columns (not (plist-get params :narrow))
- :ascii-table-use-ascii-art (plist-get params :ascii-art))
- params)))
- ;; Put the cursor in a column containing numerical values
- ;; of an Org table,
- ;; type C-c " a
- ;; A new column is added with a bar plot.
- ;; When the table is refreshed (C-u C-c *),
- ;; the plot is updated to reflect the new values.
- (defun orgtbl-ascii-draw (value min max &optional width characters)
- "Draw an ascii bar in a table.
- VALUE is the value to plot, it determines the width of the bar to draw.
- MIN is the value that will be displayed as empty (zero width bar).
- MAX is the value that will draw a bar filling all the WIDTH.
- WIDTH is the span in characters from MIN to MAX.
- CHARACTERS is a string that will compose the bar, with shades of grey
- from pure white to pure black. It defaults to a 10 characters string
- of regular ascii characters."
- (let* ((width (ceiling (or width 12)))
- (characters (or characters " .:;c!lhVHW"))
- (len (1- (length characters)))
- (value (float (if (numberp value)
- value (string-to-number value))))
- (relative (/ (- value min) (- max min)))
- (steps (round (* relative width len))))
- (cond ((< steps 0) "too small")
- ((> steps (* width len)) "too large")
- (t (let* ((int-division (/ steps len))
- (remainder (- steps (* int-division len))))
- (concat (make-string int-division (elt characters len))
- (string (elt characters remainder))))))))
- ;;;###autoload
- (defun orgtbl-ascii-plot (&optional ask)
- "Draw an ASCII bar plot in a column.
- With cursor in a column containing numerical values, this function
- will draw a plot in a new column.
- ASK, if given, is a numeric prefix to override the default 12
- characters width of the plot. ASK may also be the `\\[universal-argument]' \
- prefix,
- which will prompt for the width."
- (interactive "P")
- (let ((col (org-table-current-column))
- (min 1e999) ; 1e999 will be converted to infinity
- (max -1e999) ; which is the desired result
- (table (org-table-to-lisp))
- (length
- (cond ((consp ask)
- (read-number "Length of column " 12))
- ((numberp ask) ask)
- (t 12))))
- ;; Skip any hline a the top of table.
- (while (eq (car table) 'hline) (setq table (cdr table)))
- ;; Skip table header if any.
- (dolist (x (or (cdr (memq 'hline table)) table))
- (when (consp x)
- (setq x (nth (1- col) x))
- (when (string-match
- "^[-+]?\\([0-9]*[.]\\)?[0-9]*\\([eE][+-]?[0-9]+\\)?$"
- x)
- (setq x (string-to-number x))
- (when (> min x) (setq min x))
- (when (< max x) (setq max x)))))
- (org-table-insert-column)
- (org-table-move-column-right)
- (org-table-store-formulas
- (cons
- (cons
- (concat "$" (number-to-string (1+ col)))
- (format "'(%s $%s %s %s %s)"
- "orgtbl-ascii-draw" col min max length))
- (org-table-get-stored-formulas)))
- (org-table-recalculate t)))
- ;; Example of extension: unicode characters
- ;; Here are two examples of different styles.
- ;; Unicode block characters are used to give a smooth effect.
- ;; See http://en.wikipedia.org/wiki/Block_Elements
- ;; Use one of those drawing functions
- ;; - orgtbl-ascii-draw (the default ascii)
- ;; - orgtbl-uc-draw-grid (unicode with a grid effect)
- ;; - orgtbl-uc-draw-cont (smooth unicode)
- ;; This is best viewed with the "DejaVu Sans Mono" font
- ;; (use M-x set-default-font).
- (defun orgtbl-uc-draw-grid (value min max &optional width)
- "Draw a bar in a table using block unicode characters.
- It is a variant of orgtbl-ascii-draw with Unicode block
- characters, for a smooth display. Bars appear as grids (to the
- extent the font allows)."
- ;; http://en.wikipedia.org/wiki/Block_Elements
- ;; best viewed with the "DejaVu Sans Mono" font.
- (orgtbl-ascii-draw value min max width
- " \u258F\u258E\u258D\u258C\u258B\u258A\u2589"))
- (defun orgtbl-uc-draw-cont (value min max &optional width)
- "Draw a bar in a table using block unicode characters.
- It is a variant of orgtbl-ascii-draw with Unicode block
- characters, for a smooth display. Bars are solid (to the extent
- the font allows)."
- (orgtbl-ascii-draw value min max width
- " \u258F\u258E\u258D\u258C\u258B\u258A\u2589\u2588"))
- (defun org-table-get-remote-range (name-or-id form)
- "Get a field value or a list of values in a range from table at ID.
- NAME-OR-ID may be the name of a table in the current file as set
- by a \"#+NAME:\" directive. The first table following this line
- will then be used. Alternatively, it may be an ID referring to
- any entry, also in a different file. In this case, the first
- table in that entry will be referenced.
- FORM is a field or range descriptor like \"@2$3\" or \"B3\" or
- \"@I$2..@II$2\". All the references must be absolute, not relative.
- The return value is either a single string for a single field, or a
- list of the fields in the rectangle."
- (save-match-data
- (let ((case-fold-search t) (id-loc nil)
- ;; Protect a bunch of variables from being overwritten by
- ;; the context of the remote table.
- org-table-column-names org-table-column-name-regexp
- org-table-local-parameters org-table-named-field-locations
- org-table-current-line-types
- org-table-current-begin-pos org-table-dlines
- org-table-current-ncol
- org-table-hlines org-table-last-alignment
- org-table-last-column-widths org-table-last-alignment
- org-table-last-column-widths
- buffer loc)
- (setq form (org-table-convert-refs-to-rc form))
- (org-with-wide-buffer
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*"
- (regexp-quote name-or-id) "[ \t]*$")
- nil t)
- (setq buffer (current-buffer) loc (match-beginning 0))
- (setq id-loc (org-id-find name-or-id 'marker))
- (unless (and id-loc (markerp id-loc))
- (user-error "Can't find remote table \"%s\"" name-or-id))
- (setq buffer (marker-buffer id-loc)
- loc (marker-position id-loc))
- (move-marker id-loc nil))
- (with-current-buffer buffer
- (org-with-wide-buffer
- (goto-char loc)
- (forward-char 1)
- (unless (and (re-search-forward "^\\(\\*+ \\)\\|^[ \t]*|" nil t)
- (not (match-beginning 1)))
- (user-error "Cannot find a table at NAME or ID %s" name-or-id))
- (org-table-analyze)
- (setq form (org-table-formula-substitute-names
- (org-table-formula-handle-first/last-rc form)))
- (if (and (string-match org-table-range-regexp form)
- (> (length (match-string 0 form)) 1))
- (org-table-get-range
- (match-string 0 form) org-table-current-begin-pos 1)
- form)))))))
- (defun org-table-remote-reference-indirection (form)
- "Return formula with table remote references substituted by indirection.
- For example \"remote($1, @>$2)\" => \"remote(year_2013, @>$1)\".
- This indirection works only with the format @ROW$COLUMN. The
- format \"B3\" is not supported because it can not be
- distinguished from a plain table name or ID."
- (let ((regexp
- ;; Same as in `org-table-eval-formula'.
- (concat "\\<remote([ \t]*\\("
- ;; Allow "$1", "@<", "$-1", "@<<$1" etc.
- "[@$][^ \t,]+"
- "\\)[ \t]*,[ \t]*\\([^\n)]+\\))")))
- (replace-regexp-in-string
- regexp
- (lambda (m)
- (save-match-data
- (let ((eq (org-table-formula-handle-first/last-rc (match-string 1 m))))
- (org-table-get-range
- (if (string-match-p "\\`\\$[0-9]+\\'" eq)
- (concat "@0" eq)
- eq)))))
- form t t 1)))
- (defmacro org-define-lookup-function (mode)
- (let ((mode-str (symbol-name mode))
- (first-p (eq mode 'first))
- (all-p (eq mode 'all)))
- (let ((plural-str (if all-p "s" "")))
- `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate)
- ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST.
- If R-LIST is nil, return matching element%s of S-LIST.
- If PREDICATE is not nil, use it instead of `equal' to match VAL.
- Matching is done by (PREDICATE VAL S), where S is an element of S-LIST.
- This function is generated by a call to the macro `org-define-lookup-function'."
- mode-str plural-str plural-str plural-str)
- (let ,(let ((lvars '((p (or predicate 'equal))
- (sl s-list)
- (rl (or r-list s-list))
- (ret nil))))
- (if first-p (cons '(match-p nil) lvars) lvars))
- (while ,(if first-p '(and (not match-p) sl) 'sl)
- (when (funcall p val (car sl))
- ,(when first-p '(setq match-p t))
- (let ((rval (car rl)))
- (setq ret ,(if all-p '(append ret (list rval)) 'rval))))
- (setq sl (cdr sl) rl (cdr rl)))
- ret)))))
- (org-define-lookup-function first)
- (org-define-lookup-function last)
- (org-define-lookup-function all)
- (provide 'org-table)
- ;; Local variables:
- ;; generated-autoload-file: "org-loaddefs.el"
- ;; End:
- ;;; org-table.el ends here
|