12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506650765086509651065116512651365146515651665176518651965206521652265236524652565266527652865296530653165326533653465356536653765386539654065416542654365446545654665476548654965506551655265536554655565566557655865596560656165626563656465656566656765686569657065716572657365746575657665776578657965806581658265836584658565866587658865896590659165926593659465956596659765986599660066016602660366046605660666076608660966106611661266136614661566166617661866196620662166226623662466256626662766286629663066316632663366346635663666376638663966406641664266436644664566466647664866496650665166526653665466556656665766586659666066616662666366646665666666676668666966706671667266736674667566766677667866796680668166826683668466856686668766886689669066916692669366946695669666976698669967006701670267036704670567066707670867096710671167126713671467156716671767186719672067216722672367246725672667276728672967306731673267336734673567366737673867396740674167426743674467456746674767486749675067516752675367546755675667576758675967606761676267636764676567666767676867696770677167726773677467756776677767786779678067816782678367846785678667876788678967906791679267936794679567966797679867996800680168026803680468056806680768086809681068116812681368146815681668176818681968206821682268236824682568266827682868296830683168326833683468356836683768386839684068416842684368446845684668476848684968506851685268536854685568566857685868596860686168626863686468656866686768686869687068716872687368746875687668776878687968806881688268836884688568866887688868896890689168926893689468956896689768986899690069016902690369046905690669076908690969106911691269136914691569166917691869196920692169226923692469256926692769286929693069316932693369346935693669376938693969406941694269436944694569466947694869496950695169526953695469556956695769586959696069616962696369646965696669676968696969706971697269736974697569766977697869796980698169826983698469856986698769886989699069916992699369946995699669976998699970007001700270037004700570067007700870097010701170127013701470157016701770187019702070217022702370247025702670277028702970307031703270337034703570367037703870397040704170427043704470457046704770487049705070517052705370547055705670577058705970607061706270637064706570667067706870697070707170727073707470757076707770787079708070817082708370847085708670877088708970907091709270937094709570967097709870997100710171027103710471057106710771087109711071117112711371147115711671177118711971207121712271237124712571267127712871297130713171327133713471357136713771387139714071417142714371447145714671477148714971507151715271537154715571567157715871597160716171627163716471657166716771687169717071717172717371747175717671777178717971807181718271837184718571867187718871897190719171927193719471957196719771987199720072017202720372047205720672077208720972107211721272137214721572167217721872197220722172227223722472257226722772287229723072317232723372347235723672377238723972407241724272437244724572467247724872497250725172527253725472557256725772587259726072617262726372647265726672677268726972707271727272737274727572767277727872797280728172827283728472857286728772887289729072917292729372947295729672977298729973007301730273037304730573067307730873097310731173127313731473157316731773187319732073217322732373247325732673277328732973307331733273337334733573367337733873397340734173427343734473457346734773487349735073517352735373547355735673577358735973607361736273637364736573667367736873697370737173727373737473757376737773787379738073817382738373847385738673877388738973907391739273937394739573967397739873997400740174027403740474057406740774087409741074117412741374147415741674177418741974207421742274237424742574267427742874297430743174327433743474357436743774387439744074417442744374447445744674477448744974507451745274537454745574567457745874597460746174627463746474657466746774687469747074717472747374747475747674777478747974807481748274837484748574867487748874897490749174927493749474957496749774987499750075017502750375047505750675077508750975107511751275137514751575167517751875197520752175227523752475257526752775287529753075317532753375347535753675377538753975407541754275437544754575467547754875497550755175527553755475557556755775587559756075617562756375647565756675677568756975707571757275737574757575767577757875797580758175827583758475857586758775887589759075917592759375947595759675977598759976007601760276037604760576067607760876097610761176127613761476157616761776187619762076217622762376247625762676277628762976307631763276337634763576367637763876397640764176427643764476457646764776487649765076517652765376547655765676577658765976607661766276637664766576667667766876697670767176727673767476757676767776787679768076817682768376847685768676877688768976907691769276937694769576967697769876997700770177027703770477057706770777087709771077117712771377147715771677177718771977207721772277237724772577267727772877297730773177327733773477357736773777387739774077417742774377447745774677477748774977507751775277537754775577567757775877597760776177627763776477657766776777687769777077717772777377747775777677777778777977807781778277837784778577867787778877897790779177927793779477957796779777987799780078017802780378047805780678077808780978107811781278137814781578167817781878197820782178227823782478257826782778287829783078317832783378347835783678377838783978407841784278437844784578467847784878497850785178527853785478557856785778587859786078617862786378647865786678677868786978707871787278737874787578767877787878797880788178827883788478857886788778887889789078917892789378947895789678977898789979007901790279037904790579067907790879097910791179127913791479157916791779187919792079217922792379247925792679277928792979307931793279337934793579367937793879397940794179427943794479457946794779487949795079517952795379547955795679577958795979607961796279637964796579667967796879697970797179727973797479757976797779787979798079817982798379847985798679877988798979907991799279937994799579967997799879998000800180028003800480058006800780088009801080118012801380148015801680178018801980208021802280238024802580268027802880298030803180328033803480358036803780388039804080418042804380448045804680478048804980508051805280538054805580568057805880598060806180628063806480658066806780688069807080718072807380748075807680778078807980808081808280838084808580868087808880898090809180928093809480958096809780988099810081018102810381048105810681078108810981108111811281138114811581168117811881198120812181228123812481258126812781288129813081318132813381348135813681378138813981408141814281438144814581468147814881498150815181528153815481558156815781588159816081618162816381648165816681678168816981708171817281738174817581768177817881798180818181828183818481858186818781888189819081918192819381948195819681978198819982008201820282038204820582068207820882098210821182128213821482158216821782188219822082218222822382248225822682278228822982308231823282338234823582368237823882398240824182428243824482458246824782488249825082518252825382548255825682578258825982608261826282638264826582668267826882698270827182728273827482758276827782788279828082818282828382848285828682878288828982908291829282938294829582968297829882998300830183028303830483058306830783088309831083118312831383148315831683178318831983208321832283238324832583268327832883298330833183328333833483358336833783388339834083418342834383448345834683478348834983508351835283538354835583568357835883598360836183628363836483658366836783688369837083718372837383748375837683778378837983808381838283838384838583868387838883898390839183928393839483958396839783988399840084018402840384048405840684078408840984108411841284138414841584168417841884198420842184228423842484258426842784288429843084318432843384348435843684378438843984408441844284438444844584468447844884498450845184528453845484558456845784588459846084618462846384648465846684678468846984708471847284738474847584768477847884798480848184828483848484858486848784888489849084918492849384948495849684978498849985008501850285038504850585068507850885098510851185128513851485158516851785188519852085218522852385248525852685278528852985308531853285338534853585368537853885398540854185428543854485458546854785488549855085518552855385548555855685578558855985608561856285638564856585668567856885698570857185728573857485758576857785788579858085818582858385848585858685878588858985908591859285938594859585968597859885998600860186028603860486058606860786088609861086118612861386148615861686178618861986208621862286238624862586268627862886298630863186328633863486358636863786388639864086418642864386448645864686478648864986508651865286538654865586568657865886598660866186628663866486658666866786688669867086718672867386748675867686778678867986808681868286838684868586868687868886898690869186928693869486958696869786988699870087018702870387048705870687078708870987108711871287138714871587168717871887198720872187228723872487258726872787288729873087318732873387348735873687378738873987408741874287438744874587468747874887498750875187528753875487558756875787588759876087618762876387648765876687678768876987708771877287738774877587768777877887798780878187828783878487858786878787888789879087918792879387948795879687978798879988008801880288038804880588068807880888098810881188128813881488158816881788188819882088218822882388248825882688278828882988308831883288338834883588368837883888398840884188428843884488458846884788488849885088518852885388548855885688578858885988608861886288638864886588668867886888698870887188728873887488758876887788788879888088818882888388848885888688878888888988908891889288938894889588968897889888998900890189028903890489058906890789088909891089118912891389148915891689178918891989208921892289238924892589268927892889298930893189328933893489358936893789388939894089418942894389448945894689478948894989508951895289538954895589568957895889598960896189628963896489658966896789688969897089718972897389748975897689778978897989808981898289838984898589868987898889898990899189928993899489958996899789988999900090019002900390049005900690079008900990109011901290139014901590169017901890199020902190229023902490259026902790289029903090319032903390349035903690379038903990409041904290439044904590469047904890499050905190529053905490559056905790589059906090619062906390649065906690679068906990709071907290739074907590769077907890799080908190829083908490859086908790889089909090919092909390949095909690979098909991009101910291039104910591069107910891099110911191129113911491159116911791189119912091219122912391249125912691279128912991309131913291339134913591369137913891399140914191429143914491459146914791489149915091519152915391549155915691579158915991609161916291639164916591669167916891699170917191729173917491759176917791789179918091819182918391849185918691879188918991909191919291939194919591969197919891999200920192029203920492059206920792089209921092119212921392149215921692179218921992209221922292239224922592269227922892299230923192329233923492359236923792389239924092419242924392449245924692479248924992509251925292539254925592569257925892599260926192629263926492659266926792689269927092719272927392749275927692779278927992809281928292839284928592869287928892899290929192929293929492959296929792989299930093019302930393049305930693079308930993109311931293139314931593169317931893199320932193229323932493259326932793289329933093319332933393349335933693379338933993409341934293439344934593469347934893499350935193529353935493559356935793589359936093619362936393649365936693679368936993709371937293739374937593769377937893799380938193829383938493859386938793889389939093919392939393949395939693979398939994009401940294039404940594069407940894099410941194129413941494159416941794189419942094219422942394249425942694279428942994309431943294339434943594369437943894399440944194429443944494459446944794489449945094519452945394549455945694579458945994609461946294639464946594669467946894699470947194729473947494759476947794789479948094819482948394849485948694879488948994909491949294939494949594969497949894999500950195029503950495059506950795089509951095119512951395149515951695179518951995209521952295239524952595269527952895299530953195329533953495359536953795389539954095419542954395449545954695479548954995509551955295539554955595569557955895599560956195629563956495659566956795689569957095719572957395749575957695779578957995809581958295839584958595869587958895899590959195929593959495959596959795989599960096019602960396049605960696079608960996109611961296139614961596169617961896199620962196229623962496259626962796289629963096319632963396349635963696379638963996409641964296439644964596469647964896499650965196529653965496559656965796589659966096619662966396649665966696679668966996709671967296739674967596769677967896799680968196829683968496859686968796889689969096919692969396949695969696979698969997009701970297039704970597069707970897099710971197129713971497159716971797189719972097219722972397249725972697279728972997309731973297339734973597369737973897399740974197429743974497459746974797489749975097519752975397549755975697579758975997609761976297639764976597669767976897699770977197729773977497759776977797789779978097819782978397849785978697879788978997909791979297939794979597969797979897999800980198029803980498059806980798089809981098119812981398149815981698179818981998209821982298239824982598269827982898299830983198329833983498359836983798389839984098419842984398449845984698479848984998509851985298539854985598569857985898599860986198629863986498659866986798689869987098719872987398749875987698779878987998809881988298839884988598869887988898899890989198929893989498959896989798989899990099019902990399049905990699079908990999109911991299139914991599169917991899199920992199229923992499259926992799289929993099319932993399349935993699379938993999409941994299439944994599469947994899499950995199529953995499559956995799589959996099619962996399649965996699679968996999709971997299739974997599769977997899799980998199829983998499859986998799889989999099919992999399949995999699979998999910000100011000210003100041000510006100071000810009100101001110012100131001410015100161001710018100191002010021100221002310024100251002610027100281002910030100311003210033100341003510036100371003810039100401004110042100431004410045100461004710048100491005010051100521005310054100551005610057100581005910060100611006210063100641006510066100671006810069100701007110072100731007410075100761007710078100791008010081100821008310084100851008610087100881008910090100911009210093100941009510096100971009810099101001010110102101031010410105101061010710108 |
- ;;; org-agenda.el --- Dynamic task and appointment lists for Org
- ;; Copyright (C) 2004-2014 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 <http://www.gnu.org/licenses/>.
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;;; Commentary:
- ;; This file contains the code for creating and using the Agenda for Org-mode.
- ;;
- ;; The functions `org-batch-agenda', `org-batch-agenda-csv', and
- ;; `org-batch-store-agenda-views' are implemented as macros to provide
- ;; a convenient way for extracting agenda information from the command
- ;; line. The Lisp does not evaluate parameters of a macro call; thus
- ;; it is not necessary to quote the parameters passed to one of those
- ;; functions. E.g. you can write:
- ;;
- ;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)'
- ;;
- ;; To export an agenda spanning 7 days. If `org-batch-agenda' would
- ;; have been implemented as a regular function you'd have to quote the
- ;; symbol org-agenda-span. Moreover: To use a symbol as parameter
- ;; value you would have to double quote the symbol.
- ;;
- ;; This is a hack, but it works even when running Org byte-compiled.
- ;;
- ;;; Code:
- (require 'org)
- (require 'org-macs)
- (eval-when-compile
- (require 'cl))
- (declare-function diary-add-to-list "diary-lib"
- (date string specifier &optional marker globcolor literal))
- (declare-function calendar-absolute-from-iso "cal-iso" (date))
- (declare-function calendar-astro-date-string "cal-julian" (&optional date))
- (declare-function calendar-bahai-date-string "cal-bahai" (&optional date))
- (declare-function calendar-chinese-date-string "cal-china" (&optional date))
- (declare-function calendar-coptic-date-string "cal-coptic" (&optional date))
- (declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date))
- (declare-function calendar-french-date-string "cal-french" (&optional date))
- (declare-function calendar-goto-date "cal-move" (date))
- (declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date))
- (declare-function calendar-islamic-date-string "cal-islam" (&optional date))
- (declare-function calendar-iso-date-string "cal-iso" (&optional date))
- (declare-function calendar-iso-from-absolute "cal-iso" (date))
- (declare-function calendar-julian-date-string "cal-julian" (&optional date))
- (declare-function calendar-mayan-date-string "cal-mayan" (&optional date))
- (declare-function calendar-persian-date-string "cal-persia" (&optional date))
- (declare-function calendar-check-holidays "holidays" (date))
- (declare-function org-datetree-find-date-create "org-datetree"
- (date &optional keep-restriction))
- (declare-function org-columns-quit "org-colview" ())
- (declare-function diary-date-display-form "diary-lib" (&optional type))
- (declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file))
- (declare-function org-habit-insert-consistency-graphs
- "org-habit" (&optional line))
- (declare-function org-is-habit-p "org-habit" (&optional pom))
- (declare-function org-habit-parse-todo "org-habit" (&optional pom))
- (declare-function org-habit-get-priority "org-habit" (habit &optional moment))
- (declare-function org-pop-to-buffer-same-window "org-compat"
- (&optional buffer-or-name norecord label))
- (declare-function org-agenda-columns "org-colview" ())
- (declare-function org-add-archive-files "org-archive" (files))
- (declare-function org-capture "org-capture" (&optional goto keys))
- (defvar calendar-mode-map) ; defined in calendar.el
- (defvar org-clock-current-task nil) ; defined in org-clock.el
- (defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el
- (defvar org-habit-show-habits) ; defined in org-habit.el
- (defvar org-habit-show-habits-only-for-today)
- (defvar org-habit-show-all-today)
- ;; Defined somewhere in this file, but used before definition.
- (defvar org-agenda-buffer-name "*Org Agenda*")
- (defvar org-agenda-overriding-header nil)
- (defvar org-agenda-title-append nil)
- (org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
- (org-no-warnings (defvar date)) ;; unprefixed, from calendar.el
- (defvar original-date) ; dynamically scoped, calendar.el does scope this
- (defvar org-agenda-undo-list nil
- "List of undoable operations in the agenda since last refresh.")
- (defvar org-agenda-pending-undo-list nil
- "In a series of undo commands, this is the list of remaining undo items.")
- (defcustom org-agenda-confirm-kill 1
- "When set, remote killing from the agenda buffer needs confirmation.
- When t, a confirmation is always needed. When a number N, confirmation is
- only needed when the text to be killed contains more than N non-white lines."
- :group 'org-agenda
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)
- (integer :tag "When more than N lines")))
- (defcustom org-agenda-compact-blocks nil
- "Non-nil means make the block agenda more compact.
- This is done globally by leaving out lines like the agenda span
- name and week number or the separator lines."
- :group 'org-agenda
- :type 'boolean)
- (defcustom org-agenda-block-separator ?=
- "The separator between blocks in the agenda.
- If this is a string, it will be used as the separator, with a newline added.
- If it is a character, it will be repeated to fill the window width.
- If nil the separator is disabled. In `org-agenda-custom-commands' this
- addresses the separator between the current and the previous block."
- :group 'org-agenda
- :type '(choice
- (const :tag "Disabled" nil)
- (character)
- (string)))
- (defgroup org-agenda-export nil
- "Options concerning exporting agenda views in Org-mode."
- :tag "Org Agenda Export"
- :group 'org-agenda)
- (defcustom org-agenda-with-colors t
- "Non-nil means use colors in agenda views."
- :group 'org-agenda-export
- :type 'boolean)
- (defcustom org-agenda-exporter-settings nil
- "Alist of variable/value pairs that should be active during agenda export.
- This is a good place to set options for ps-print and for htmlize.
- Note that the way this is implemented, the values will be evaluated
- before assigned to the variables. So make sure to quote values you do
- *not* want evaluated, for example
- (setq org-agenda-exporter-settings
- '((ps-print-color-p 'black-white)))"
- :group 'org-agenda-export
- :type '(repeat
- (list
- (variable)
- (sexp :tag "Value"))))
- (defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text)
- "Hook run in a temporary buffer before writing the agenda to an export file.
- A useful function for this hook is `org-agenda-add-entry-text'."
- :group 'org-agenda-export
- :type 'hook
- :options '(org-agenda-add-entry-text))
- (defcustom org-agenda-add-entry-text-maxlines 0
- "Maximum number of entry text lines to be added to agenda.
- This is only relevant when `org-agenda-add-entry-text' is part of
- `org-agenda-before-write-hook', which is the default.
- When this is 0, nothing will happen. When it is greater than 0, it
- specifies the maximum number of lines that will be added for each entry
- that is listed in the agenda view.
- Note that this variable is not used during display, only when exporting
- the agenda. For agenda display, see the variables `org-agenda-entry-text-mode'
- and `org-agenda-entry-text-maxlines'."
- :group 'org-agenda
- :type 'integer)
- (defcustom org-agenda-add-entry-text-descriptive-links t
- "Non-nil means export org-links as descriptive links in agenda added text.
- This variable applies to the text added to the agenda when
- `org-agenda-add-entry-text-maxlines' is larger than 0.
- When this variable nil, the URL will (also) be shown."
- :group 'org-agenda
- :type 'boolean)
- (defcustom org-agenda-export-html-style nil
- "The style specification for exported HTML Agenda files.
- If this variable contains a string, it will replace the default <style>
- section as produced by `htmlize'.
- Since there are different ways of setting style information, this variable
- needs to contain the full HTML structure to provide a style, including the
- surrounding HTML tags. The style specifications should include definitions
- the fonts used by the agenda, here is an example:
- <style type=\"text/css\">
- p { font-weight: normal; color: gray; }
- .org-agenda-structure {
- font-size: 110%;
- color: #003399;
- font-weight: 600;
- }
- .org-todo {
- color: #cc6666;
- font-weight: bold;
- }
- .org-agenda-done {
- color: #339933;
- }
- .org-done {
- color: #339933;
- }
- .title { text-align: center; }
- .todo, .deadline { color: red; }
- .done { color: green; }
- </style>
- or, if you want to keep the style in a file,
- <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\">
- As the value of this option simply gets inserted into the HTML <head> header,
- you can \"misuse\" it to also add other text to the header."
- :group 'org-agenda-export
- :group 'org-export-html
- :type '(choice
- (const nil)
- (string)))
- (defcustom org-agenda-persistent-filter nil
- "When set, keep filters from one agenda view to the next."
- :group 'org-agenda
- :type 'boolean)
- (defgroup org-agenda-custom-commands nil
- "Options concerning agenda views in Org-mode."
- :tag "Org Agenda Custom Commands"
- :group 'org-agenda)
- (defconst org-sorting-choice
- '(choice
- (const time-up) (const time-down)
- (const timestamp-up) (const timestamp-down)
- (const scheduled-up) (const scheduled-down)
- (const deadline-up) (const deadline-down)
- (const ts-up) (const ts-down)
- (const tsia-up) (const tsia-down)
- (const category-keep) (const category-up) (const category-down)
- (const tag-down) (const tag-up)
- (const priority-up) (const priority-down)
- (const todo-state-up) (const todo-state-down)
- (const effort-up) (const effort-down)
- (const habit-up) (const habit-down)
- (const alpha-up) (const alpha-down)
- (const user-defined-up) (const user-defined-down))
- "Sorting choices.")
- ;; Keep custom values for `org-agenda-filter-preset' compatible with
- ;; the new variable `org-agenda-tag-filter-preset'.
- (org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
- (org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter)
- (defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp)
- "List of types searched for when creating the daily/weekly agenda.
- This variable is a list of symbols that controls the types of
- items that appear in the daily/weekly agenda. Allowed symbols in this
- list are are
- :timestamp List items containing a date stamp or date range matching
- the selected date. This includes sexp entries in angular
- brackets.
- :sexp List entries resulting from plain diary-like sexps.
- :deadline List deadline due on that date. When the date is today,
- also list any deadlines past due, or due within
- `org-deadline-warning-days'. `:deadline' must appear before
- `:scheduled' if the setting of
- `org-agenda-skip-scheduled-if-deadline-is-shown' is to have
- any effect.
- :deadline* Same as above, but only include the deadline if it has an
- hour specification as [h]h:mm.
- :scheduled List all items which are scheduled for the given date.
- The diary for *today* also contains items which were
- scheduled earlier and are not yet marked DONE.
- :scheduled* Same as above, but only include the scheduled item if it
- has an hour specification as [h]h:mm.
- By default, all four non-starred types are turned on.
- When :scheduled* or :deadline* are included, :schedule or :deadline
- will be ignored.
- Never set this variable globally using `setq', because then it
- will apply to all future agenda commands. Instead, bind it with
- `let' to scope it dynamically into the agenda-constructing
- command. A good way to set it is through options in
- `org-agenda-custom-commands'. For a more flexible (though
- somewhat less efficient) way of determining what is included in
- the daily/weekly agenda, see `org-agenda-skip-function'.")
- (defconst org-agenda-custom-commands-local-options
- `(repeat :tag "Local settings for this command. Remember to quote values"
- (choice :tag "Setting"
- (list :tag "Heading for this block"
- (const org-agenda-overriding-header)
- (string :tag "Headline"))
- (list :tag "Files to be searched"
- (const org-agenda-files)
- (list
- (const :format "" quote)
- (repeat (file))))
- (list :tag "Sorting strategy"
- (const org-agenda-sorting-strategy)
- (list
- (const :format "" quote)
- (repeat
- ,org-sorting-choice)))
- (list :tag "Prefix format"
- (const org-agenda-prefix-format :value " %-12:c%?-12t% s")
- (string))
- (list :tag "Number of days in agenda"
- (const org-agenda-span)
- (choice (const :tag "Day" day)
- (const :tag "Week" week)
- (const :tag "Fortnight" fortnight)
- (const :tag "Month" month)
- (const :tag "Year" year)
- (integer :tag "Custom")))
- (list :tag "Fixed starting date"
- (const org-agenda-start-day)
- (string :value "2007-11-01"))
- (list :tag "Start on day of week"
- (const org-agenda-start-on-weekday)
- (choice :value 1
- (const :tag "Today" nil)
- (integer :tag "Weekday No.")))
- (list :tag "Include data from diary"
- (const org-agenda-include-diary)
- (boolean))
- (list :tag "Deadline Warning days"
- (const org-deadline-warning-days)
- (integer :value 1))
- (list :tag "Category filter preset"
- (const org-agenda-category-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+category or -category"))))
- (list :tag "Tags filter preset"
- (const org-agenda-tag-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+tag or -tag"))))
- (list :tag "Regexp filter preset"
- (const org-agenda-regexp-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+regexp or -regexp"))))
- (list :tag "Set daily/weekly entry types"
- (const org-agenda-entry-types)
- (list
- (const :format "" quote)
- (set :greedy t :value ,org-agenda-entry-types
- (const :deadline)
- (const :scheduled)
- (const :deadline*)
- (const :scheduled*)
- (const :timestamp)
- (const :sexp))))
- (list :tag "Standard skipping condition"
- :value (org-agenda-skip-function '(org-agenda-skip-entry-if))
- (const org-agenda-skip-function)
- (list
- (const :format "" quote)
- (list
- (choice
- :tag "Skipping range"
- (const :tag "Skip entry" org-agenda-skip-entry-if)
- (const :tag "Skip subtree" org-agenda-skip-subtree-if))
- (repeat :inline t :tag "Conditions for skipping"
- (choice
- :tag "Condition type"
- (list :tag "Regexp matches" :inline t (const :format "" regexp) (regexp))
- (list :tag "Regexp does not match" :inline t (const :format "" notregexp) (regexp))
- (list :tag "TODO state is" :inline t
- (const todo)
- (choice
- (const :tag "any not-done state" todo)
- (const :tag "any done state" done)
- (const :tag "any state" any)
- (list :tag "Keyword list"
- (const :format "" quote)
- (repeat (string :tag "Keyword")))))
- (list :tag "TODO state is not" :inline t
- (const nottodo)
- (choice
- (const :tag "any not-done state" todo)
- (const :tag "any done state" done)
- (const :tag "any state" any)
- (list :tag "Keyword list"
- (const :format "" quote)
- (repeat (string :tag "Keyword")))))
- (const :tag "scheduled" scheduled)
- (const :tag "not scheduled" notscheduled)
- (const :tag "deadline" deadline)
- (const :tag "no deadline" notdeadline)
- (const :tag "timestamp" timestamp)
- (const :tag "no timestamp" nottimestamp))))))
- (list :tag "Non-standard skipping condition"
- :value (org-agenda-skip-function)
- (const org-agenda-skip-function)
- (sexp :tag "Function or form (quoted!)"))
- (list :tag "Any variable"
- (variable :tag "Variable")
- (sexp :tag "Value (sexp)"))))
- "Selection of examples for agenda command settings.
- This will be spliced into the custom type of
- `org-agenda-custom-commands'.")
- (defcustom org-agenda-custom-commands
- '(("n" "Agenda and all TODO's" ((agenda "") (alltodo ""))))
- "Custom commands for the agenda.
- These commands will be offered on the splash screen displayed by the
- agenda dispatcher \\[org-agenda]. Each entry is a list like this:
- (key desc type match settings files)
- key The key (one or more characters as a string) to be associated
- with the command.
- desc A description of the command, when omitted or nil, a default
- description is built using MATCH.
- type The command type, any of the following symbols:
- agenda The daily/weekly agenda.
- todo Entries with a specific TODO keyword, in all agenda files.
- search Entries containing search words entry or headline.
- tags Tags/Property/TODO match in all agenda files.
- tags-todo Tags/P/T match in all agenda files, TODO entries only.
- todo-tree Sparse tree of specific TODO keyword in *current* file.
- tags-tree Sparse tree with all tags matches in *current* file.
- occur-tree Occur sparse tree for *current* file.
- ... A user-defined function.
- match What to search for:
- - a single keyword for TODO keyword searches
- - a tags match expression for tags searches
- - a word search expression for text searches.
- - a regular expression for occur searches
- For all other commands, this should be the empty string.
- settings A list of option settings, similar to that in a let form, so like
- this: ((opt1 val1) (opt2 val2) ...). The values will be
- evaluated at the moment of execution, so quote them when needed.
- files A list of files file to write the produced agenda buffer to
- with the command `org-store-agenda-views'.
- If a file name ends in \".html\", an HTML version of the buffer
- is written out. If it ends in \".ps\", a postscript version is
- produced. Otherwise, only the plain text is written to the file.
- You can also define a set of commands, to create a composite agenda buffer.
- In this case, an entry looks like this:
- (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files)
- where
- desc A description string to be displayed in the dispatcher menu.
- cmd An agenda command, similar to the above. However, tree commands
- are not allowed, but instead you can get agenda and global todo list.
- So valid commands for a set are:
- (agenda \"\" settings)
- (alltodo \"\" settings)
- (stuck \"\" settings)
- (todo \"match\" settings files)
- (search \"match\" settings files)
- (tags \"match\" settings files)
- (tags-todo \"match\" settings files)
- Each command can carry a list of options, and another set of options can be
- given for the whole set of commands. Individual command options take
- precedence over the general options.
- When using several characters as key to a command, the first characters
- are prefix commands. For the dispatcher to display useful information, you
- should provide a description for the prefix, like
- (setq org-agenda-custom-commands
- '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\"
- (\"hl\" tags \"+HOME+Lisa\")
- (\"hp\" tags \"+HOME+Peter\")
- (\"hk\" tags \"+HOME+Kim\")))"
- :group 'org-agenda-custom-commands
- :type `(repeat
- (choice :value ("x" "Describe command here" tags "" nil)
- (list :tag "Single command"
- (string :tag "Access Key(s) ")
- (option (string :tag "Description"))
- (choice
- (const :tag "Agenda" agenda)
- (const :tag "TODO list" alltodo)
- (const :tag "Search words" search)
- (const :tag "Stuck projects" stuck)
- (const :tag "Tags/Property match (all agenda files)" tags)
- (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo)
- (const :tag "TODO keyword search (all agenda files)" todo)
- (const :tag "Tags sparse tree (current buffer)" tags-tree)
- (const :tag "TODO keyword tree (current buffer)" todo-tree)
- (const :tag "Occur tree (current buffer)" occur-tree)
- (sexp :tag "Other, user-defined function"))
- (string :tag "Match (only for some commands)")
- ,org-agenda-custom-commands-local-options
- (option (repeat :tag "Export" (file :tag "Export to"))))
- (list :tag "Command series, all agenda files"
- (string :tag "Access Key(s)")
- (string :tag "Description ")
- (repeat :tag "Component"
- (choice
- (list :tag "Agenda"
- (const :format "" agenda)
- (const :tag "" :format "" "")
- ,org-agenda-custom-commands-local-options)
- (list :tag "TODO list (all keywords)"
- (const :format "" alltodo)
- (const :tag "" :format "" "")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Search words"
- (const :format "" search)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Stuck projects"
- (const :format "" stuck)
- (const :tag "" :format "" "")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Tags search"
- (const :format "" tags)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Tags search, TODO entries only"
- (const :format "" tags-todo)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "TODO keyword search"
- (const :format "" todo)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Other, user-defined function"
- (symbol :tag "function")
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)))
- (repeat :tag "Settings for entire command set"
- (list (variable :tag "Any variable")
- (sexp :tag "Value")))
- (option (repeat :tag "Export" (file :tag "Export to"))))
- (cons :tag "Prefix key documentation"
- (string :tag "Access Key(s)")
- (string :tag "Description ")))))
- (defcustom org-agenda-query-register ?o
- "The register holding the current query string.
- The purpose of this is that if you construct a query string interactively,
- you can then use it to define a custom command."
- :group 'org-agenda-custom-commands
- :type 'character)
- (defcustom org-stuck-projects
- '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "")
- "How to identify stuck projects.
- This is a list of four items:
- 1. A tags/todo/property matcher string that is used to identify a project.
- See the manual for a description of tag and property searches.
- The entire tree below a headline matched by this is considered one project.
- 2. A list of TODO keywords identifying non-stuck projects.
- If the project subtree contains any headline with one of these todo
- keywords, the project is considered to be not stuck. If you specify
- \"*\" as a keyword, any TODO keyword will mark the project unstuck.
- 3. A list of tags identifying non-stuck projects.
- If the project subtree contains any headline with one of these tags,
- the project is considered to be not stuck. If you specify \"*\" as
- a tag, any tag will mark the project unstuck. Note that this is about
- the explicit presence of a tag somewhere in the subtree, inherited
- tags do not count here. If inherited tags make a project not stuck,
- use \"-TAG\" in the tags part of the matcher under (1.) above.
- 4. An arbitrary regular expression matching non-stuck projects.
- If the project turns out to be not stuck, search continues also in the
- subtree to see if any of the subtasks have project status.
- See also the variable `org-tags-match-list-sublevels' which applies
- to projects matched by this search as well.
- After defining this variable, you may use \\[org-agenda-list-stuck-projects]
- or `C-c a #' to produce the list."
- :group 'org-agenda-custom-commands
- :type '(list
- (string :tag "Tags/TODO match to identify a project")
- (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string))
- (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string))
- (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree")))
- (defcustom org-agenda-filter-effort-default-operator "<"
- "The default operator for effort estimate filtering.
- If you select an effort estimate limit without first pressing an operator,
- this one will be used."
- :group 'org-agenda-custom-commands
- :type '(choice (const :tag "less or equal" "<")
- (const :tag "greater or equal"">")
- (const :tag "equal" "=")))
- (defgroup org-agenda-skip nil
- "Options concerning skipping parts of agenda files."
- :tag "Org Agenda Skip"
- :group 'org-agenda)
- (defcustom org-agenda-skip-function-global nil
- "Function to be called at each match during agenda construction.
- If this function returns nil, the current match should not be skipped.
- If the function decided to skip an agenda match, is must return the
- buffer position from which the search should be continued.
- This may also be a Lisp form, which will be evaluated.
- This variable will be applied to every agenda match, including
- tags/property searches and TODO lists. So try to make the test function
- do its checking as efficiently as possible. To implement a skipping
- condition just for specific agenda commands, use the variable
- `org-agenda-skip-function' which can be set in the options section
- of custom agenda commands."
- :group 'org-agenda-skip
- :type 'sexp)
- (defgroup org-agenda-daily/weekly nil
- "Options concerning the daily/weekly agenda."
- :tag "Org Agenda Daily/Weekly"
- :group 'org-agenda)
- (defgroup org-agenda-todo-list nil
- "Options concerning the global todo list agenda view."
- :tag "Org Agenda Todo List"
- :group 'org-agenda)
- (defgroup org-agenda-match-view nil
- "Options concerning the general tags/property/todo match agenda view."
- :tag "Org Agenda Match View"
- :group 'org-agenda)
- (defgroup org-agenda-search-view nil
- "Options concerning the general tags/property/todo match agenda view."
- :tag "Org Agenda Match View"
- :group 'org-agenda)
- (defvar org-agenda-archives-mode nil
- "Non-nil means the agenda will include archived items.
- If this is the symbol `trees', trees in the selected agenda scope
- that are marked with the ARCHIVE tag will be included anyway. When this is
- t, also all archive files associated with the current selection of agenda
- files will be included.")
- (defcustom org-agenda-restriction-lock-highlight-subtree t
- "Non-nil means highlight the whole subtree when restriction is active.
- Otherwise only highlight the headline. Highlighting the whole subtree is
- useful to ensure no edits happen beyond the restricted region."
- :group 'org-agenda
- :type 'boolean)
- (defcustom org-agenda-skip-comment-trees t
- "Non-nil means skip trees that start with the COMMENT keyword.
- When nil, these trees are also scanned by agenda commands."
- :group 'org-agenda-skip
- :type 'boolean)
- (defcustom org-agenda-todo-list-sublevels t
- "Non-nil means check also the sublevels of a TODO entry for TODO entries.
- When nil, the sublevels of a TODO entry are not checked, resulting in
- potentially much shorter TODO lists."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :type 'boolean)
- (defcustom org-agenda-todo-ignore-with-date nil
- "Non-nil means don't show entries with a date in the global todo list.
- You can use this if you prefer to mark mere appointments with a TODO keyword,
- but don't want them to show up in the TODO list.
- When this is set, it also covers deadlines and scheduled items, the settings
- of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines'
- will be ignored.
- See also the variable `org-agenda-tags-todo-honor-ignore-options'."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :type 'boolean)
- (defcustom org-agenda-todo-ignore-timestamp nil
- "Non-nil means don't show entries with a timestamp.
- This applies when creating the global todo list.
- Valid values are:
- past Don't show entries for today or in the past.
- future Don't show entries with a timestamp in the future.
- The idea behind this is that if it has a future
- timestamp, you don't want to think about it until the
- date.
- all Don't show any entries with a timestamp in the global todo list.
- The idea behind this is that by setting a timestamp, you
- have already \"taken care\" of this item.
- This variable can also have an integer as a value. If positive (N),
- todos with a timestamp N or more days in the future will be ignored. If
- negative (-N), todos with a timestamp N or more days in the past will be
- ignored. If 0, todos with a timestamp either today or in the future will
- be ignored. For example, a value of -1 will exclude todos with a
- timestamp in the past (yesterday or earlier), while a value of 7 will
- exclude todos with a timestamp a week or more in the future.
- See also `org-agenda-todo-ignore-with-date'.
- See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
- to make his option also apply to the tags-todo list."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :version "24.1"
- :type '(choice
- (const :tag "Ignore future timestamp todos" future)
- (const :tag "Ignore past or present timestamp todos" past)
- (const :tag "Ignore all timestamp todos" all)
- (const :tag "Show timestamp todos" nil)
- (integer :tag "Ignore if N or more days in past(-) or future(+).")))
- (defcustom org-agenda-todo-ignore-scheduled nil
- "Non-nil means, ignore some scheduled TODO items when making TODO list.
- This applies when creating the global todo list.
- Valid values are:
- past Don't show entries scheduled today or in the past.
- future Don't show entries scheduled in the future.
- The idea behind this is that by scheduling it, you don't want to
- think about it until the scheduled date.
- all Don't show any scheduled entries in the global todo list.
- The idea behind this is that by scheduling it, you have already
- \"taken care\" of this item.
- t Same as `all', for backward compatibility.
- This variable can also have an integer as a value. See
- `org-agenda-todo-ignore-timestamp' for more details.
- See also `org-agenda-todo-ignore-with-date'.
- See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
- to make his option also apply to the tags-todo list."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :type '(choice
- (const :tag "Ignore future-scheduled todos" future)
- (const :tag "Ignore past- or present-scheduled todos" past)
- (const :tag "Ignore all scheduled todos" all)
- (const :tag "Ignore all scheduled todos (compatibility)" t)
- (const :tag "Show scheduled todos" nil)
- (integer :tag "Ignore if N or more days in past(-) or future(+).")))
- (defcustom org-agenda-todo-ignore-deadlines nil
- "Non-nil means ignore some deadlined TODO items when making TODO list.
- There are different motivations for using different values, please think
- carefully when configuring this variable.
- This applies when creating the global todo list.
- Valid values are:
- near Don't show near deadline entries. A deadline is near when it is
- closer than `org-deadline-warning-days' days. The idea behind this
- is that such items will appear in the agenda anyway.
- far Don't show TODO entries where a deadline has been defined, but
- the deadline is not near. This is useful if you don't want to
- use the todo list to figure out what to do now.
- past Don't show entries with a deadline timestamp for today or in the past.
- future Don't show entries with a deadline timestamp in the future, not even
- when they become `near' ones. Use it with caution.
- all Ignore all TODO entries that do have a deadline.
- t Same as `near', for backward compatibility.
- This variable can also have an integer as a value. See
- `org-agenda-todo-ignore-timestamp' for more details.
- See also `org-agenda-todo-ignore-with-date'.
- See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want
- to make his option also apply to the tags-todo list."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :type '(choice
- (const :tag "Ignore near deadlines" near)
- (const :tag "Ignore near deadlines (compatibility)" t)
- (const :tag "Ignore far deadlines" far)
- (const :tag "Ignore all TODOs with a deadlines" all)
- (const :tag "Show all TODOs, even if they have a deadline" nil)
- (integer :tag "Ignore if N or more days in past(-) or future(+).")))
- (defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil
- "Time unit to use when possibly ignoring an agenda item.
- See the docstring of various `org-agenda-todo-ignore-*' options.
- The default is to compare time stamps using days. An item is thus
- considered to be in the future if it is at least one day after today.
- Non-nil means to compare time stamps using seconds. An item is then
- considered future if it has a time value later than current time."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice
- (const :tag "Compare time with days" nil)
- (const :tag "Compare time with seconds" t)))
- (defcustom org-agenda-tags-todo-honor-ignore-options nil
- "Non-nil means honor todo-list ignores options also in tags-todo search.
- The variables
- `org-agenda-todo-ignore-with-date',
- `org-agenda-todo-ignore-timestamp',
- `org-agenda-todo-ignore-scheduled',
- `org-agenda-todo-ignore-deadlines'
- make the global TODO list skip entries that have time stamps of certain
- kinds. If this option is set, the same options will also apply for the
- tags-todo search, which is the general tags/property matcher
- restricted to unfinished TODO entries only."
- :group 'org-agenda-skip
- :group 'org-agenda-todo-list
- :group 'org-agenda-match-view
- :type 'boolean)
- (defcustom org-agenda-skip-scheduled-if-done nil
- "Non-nil means don't show scheduled items in agenda when they are done.
- This is relevant for the daily/weekly agenda, not for the TODO list. And
- it applies only to the actual date of the scheduling. Warnings about
- an item with a past scheduling dates are always turned off when the item
- is DONE."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil
- "Non-nil means skip scheduling line if same entry shows because of deadline.
- In the agenda of today, an entry can show up multiple times
- because it is both scheduled and has a nearby deadline, and maybe
- a plain time stamp as well.
- When this variable is nil, the entry will be shown several times.
- When set to t, then only the deadline is shown and the fact that
- the entry is scheduled today or was scheduled previously is not
- shown.
- When set to the symbol `not-today', skip scheduled previously,
- but not scheduled today.
- When set to the symbol `repeated-after-deadline', skip scheduled
- items if they are repeated beyond the current deadline."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)
- (const :tag "Not when scheduled today" not-today)
- (const :tag "When repeated past deadline" repeated-after-deadline)))
- (defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil
- "Non-nil means skip timestamp line if same entry shows because of deadline.
- In the agenda of today, an entry can show up multiple times
- because it has both a plain timestamp and has a nearby deadline.
- When this variable is t, then only the deadline is shown and the
- fact that the entry has a timestamp for or including today is not
- shown. When this variable is nil, the entry will be shown
- several times."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :version "24.1"
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Always" t)))
- (defcustom org-agenda-skip-deadline-if-done nil
- "Non-nil means don't show deadlines when the corresponding item is done.
- When nil, the deadline is still shown and should give you a happy feeling.
- This is relevant for the daily/weekly agenda. And it applied only to the
- actually date of the deadline. Warnings about approaching and past-due
- deadlines are always turned off when the item is DONE."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil
- "Non-nil means skip deadline prewarning when entry is also scheduled.
- This will apply on all days where a prewarning for the deadline would
- be shown, but not at the day when the entry is actually due. On that day,
- the deadline will be shown anyway.
- This variable may be set to nil, t, the symbol `pre-scheduled',
- or a number which will then give the number of days before the actual
- deadline when the prewarnings should resume. The symbol `pre-scheduled'
- eliminates the deadline prewarning only prior to the scheduled date.
- This can be used in a workflow where the first showing of the deadline will
- trigger you to schedule it, and then you don't want to be reminded of it
- because you will take care of it on the day when scheduled."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :version "24.1"
- :type '(choice
- (const :tag "Always show prewarning" nil)
- (const :tag "Remove prewarning prior to scheduled date" pre-scheduled)
- (const :tag "Remove prewarning if entry is scheduled" t)
- (integer :tag "Restart prewarning N days before deadline")))
- (defcustom org-agenda-skip-scheduled-delay-if-deadline nil
- "Non-nil means skip scheduled delay when entry also has a deadline.
- This variable may be set to nil, t, the symbol `post-deadline',
- or a number which will then give the number of days after the actual
- scheduled date when the delay should expire. The symbol `post-deadline'
- eliminates the schedule delay when the date is posterior to the deadline."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(choice
- (const :tag "Always honor delay" nil)
- (const :tag "Ignore delay if posterior to the deadline" post-deadline)
- (const :tag "Ignore delay if entry has a deadline" t)
- (integer :tag "Honor delay up until N days after the scheduled date")))
- (defcustom org-agenda-skip-additional-timestamps-same-entry nil
- "When nil, multiple same-day timestamps in entry make multiple agenda lines.
- When non-nil, after the search for timestamps has matched once in an
- entry, the rest of the entry will not be searched."
- :group 'org-agenda-skip
- :type 'boolean)
- (defcustom org-agenda-skip-timestamp-if-done nil
- "Non-nil means don't select item by timestamp or -range if it is DONE."
- :group 'org-agenda-skip
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-dim-blocked-tasks t
- "Non-nil means dim blocked tasks in the agenda display.
- This causes some overhead during agenda construction, but if you
- have turned on `org-enforce-todo-dependencies',
- `org-enforce-todo-checkbox-dependencies', or any other blocking
- mechanism, this will create useful feedback in the agenda.
- Instead of t, this variable can also have the value `invisible'.
- Then blocked tasks will be invisible and only become visible when
- they become unblocked. An exemption to this behavior is when a task is
- blocked because of unchecked checkboxes below it. Since checkboxes do
- not show up in the agenda views, making this task invisible you remove any
- trace from agenda views that there is something to do. Therefore, a task
- that is blocked because of checkboxes will never be made invisible, it
- will only be dimmed."
- :group 'org-agenda-daily/weekly
- :group 'org-agenda-todo-list
- :version "24.3"
- :type '(choice
- (const :tag "Do not dim" nil)
- (const :tag "Dim to a gray face" t)
- (const :tag "Make invisible" invisible)))
- (defcustom org-timeline-show-empty-dates 3
- "Non-nil means `org-timeline' also shows dates without an entry.
- When nil, only the days which actually have entries are shown.
- When t, all days between the first and the last date are shown.
- When an integer, show also empty dates, but if there is a gap of more than
- N days, just insert a special line indicating the size of the gap."
- :group 'org-agenda-skip
- :type '(choice
- (const :tag "None" nil)
- (const :tag "All" t)
- (integer :tag "at most")))
- (defgroup org-agenda-startup nil
- "Options concerning initial settings in the Agenda in Org Mode."
- :tag "Org Agenda Startup"
- :group 'org-agenda)
- (defcustom org-agenda-menu-show-matcher t
- "Non-nil means show the match string in the agenda dispatcher menu.
- When nil, the matcher string is not shown, but is put into the help-echo
- property so than moving the mouse over the command shows it.
- Setting it to nil is good if matcher strings are very long and/or if
- you want to use two-columns display (see `org-agenda-menu-two-columns')."
- :group 'org-agenda
- :version "24.1"
- :type 'boolean)
- (define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3")
- (defcustom org-agenda-menu-two-columns nil
- "Non-nil means, use two columns to show custom commands in the dispatcher.
- If you use this, you probably want to set `org-agenda-menu-show-matcher'
- to nil."
- :group 'org-agenda
- :version "24.1"
- :type 'boolean)
- (define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3")
- (defcustom org-agenda-finalize-hook nil
- "Hook run just before displaying an agenda buffer.
- The buffer is still writable when the hook is called.
- You can modify some of the buffer substrings but you should be
- extra careful not to modify the text properties of the agenda
- headlines as the agenda display heavily relies on them."
- :group 'org-agenda-startup
- :type 'hook)
- (defcustom org-agenda-mouse-1-follows-link nil
- "Non-nil means mouse-1 on a link will follow the link in the agenda.
- A longer mouse click will still set point. Does not work on XEmacs.
- Needs to be set before org.el is loaded."
- :group 'org-agenda-startup
- :type 'boolean)
- (defcustom org-agenda-start-with-follow-mode nil
- "The initial value of follow mode in a newly created agenda window."
- :group 'org-agenda-startup
- :type 'boolean)
- (defcustom org-agenda-follow-indirect nil
- "Non-nil means `org-agenda-follow-mode' displays only the
- current item's tree, in an indirect buffer."
- :group 'org-agenda
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-show-outline-path t
- "Non-nil means show outline path in echo area after line motion."
- :group 'org-agenda-startup
- :type 'boolean)
- (defcustom org-agenda-start-with-entry-text-mode nil
- "The initial value of entry-text-mode in a newly created agenda window."
- :group 'org-agenda-startup
- :type 'boolean)
- (defcustom org-agenda-entry-text-maxlines 5
- "Number of text lines to be added when `E' is pressed in the agenda.
- Note that this variable only used during agenda display. Add add entry text
- when exporting the agenda, configure the variable
- `org-agenda-add-entry-ext-maxlines'."
- :group 'org-agenda
- :type 'integer)
- (defcustom org-agenda-entry-text-exclude-regexps nil
- "List of regular expressions to clean up entry text.
- The complete matches of all regular expressions in this list will be
- removed from entry text before it is shown in the agenda."
- :group 'org-agenda
- :type '(repeat (regexp)))
- (defcustom org-agenda-entry-text-leaders " > "
- "Text prepended to the entry text in agenda buffers."
- :version "24.4"
- :package-version '(Org . "8.0")
- :group 'org-agenda
- :type 'string)
- (defvar org-agenda-entry-text-cleanup-hook nil
- "Hook that is run after basic cleanup of entry text to be shown in agenda.
- This cleanup is done in a temporary buffer, so the function may inspect and
- change the entire buffer.
- Some default stuff like drawers and scheduling/deadline dates will already
- have been removed when this is called, as will any matches for regular
- expressions listed in `org-agenda-entry-text-exclude-regexps'.")
- (defvar org-agenda-include-inactive-timestamps nil
- "Non-nil means include inactive time stamps in agenda and timeline.
- Dynamically scoped.")
- (defgroup org-agenda-windows nil
- "Options concerning the windows used by the Agenda in Org Mode."
- :tag "Org Agenda Windows"
- :group 'org-agenda)
- (defcustom org-agenda-window-setup 'reorganize-frame
- "How the agenda buffer should be displayed.
- Possible values for this option are:
- current-window Show agenda in the current window, keeping all other windows.
- other-window Use `switch-to-buffer-other-window' to display agenda.
- reorganize-frame Show only two windows on the current frame, the current
- window and the agenda.
- other-frame Use `switch-to-buffer-other-frame' to display agenda.
- Also, when exiting the agenda, kill that frame.
- See also the variable `org-agenda-restore-windows-after-quit'."
- :group 'org-agenda-windows
- :type '(choice
- (const current-window)
- (const other-frame)
- (const other-window)
- (const reorganize-frame)))
- (defcustom org-agenda-window-frame-fractions '(0.5 . 0.75)
- "The min and max height of the agenda window as a fraction of frame height.
- The value of the variable is a cons cell with two numbers between 0 and 1.
- It only matters if `org-agenda-window-setup' is `reorganize-frame'."
- :group 'org-agenda-windows
- :type '(cons (number :tag "Minimum") (number :tag "Maximum")))
- (defcustom org-agenda-restore-windows-after-quit nil
- "Non-nil means restore window configuration upon exiting agenda.
- Before the window configuration is changed for displaying the agenda,
- the current status is recorded. When the agenda is exited with
- `q' or `x' and this option is set, the old state is restored. If
- `org-agenda-window-setup' is `other-frame', the value of this
- option will be ignored."
- :group 'org-agenda-windows
- :type 'boolean)
- (defcustom org-agenda-ndays nil
- "Number of days to include in overview display.
- Should be 1 or 7.
- Obsolete, see `org-agenda-span'."
- :group 'org-agenda-daily/weekly
- :type '(choice (const nil)
- (integer)))
- (make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1")
- (defcustom org-agenda-span 'week
- "Number of days to include in overview display.
- Can be day, week, month, year, or any number of days.
- Custom commands can set this variable in the options section."
- :group 'org-agenda-daily/weekly
- :type '(choice (const :tag "Day" day)
- (const :tag "Week" week)
- (const :tag "Fortnight" fortnight)
- (const :tag "Month" month)
- (const :tag "Year" year)
- (integer :tag "Custom")))
- (defcustom org-agenda-start-on-weekday 1
- "Non-nil means start the overview always on the specified weekday.
- 0 denotes Sunday, 1 denotes Monday, etc.
- When nil, always start on the current day.
- Custom commands can set this variable in the options section."
- :group 'org-agenda-daily/weekly
- :type '(choice (const :tag "Today" nil)
- (integer :tag "Weekday No.")))
- (defcustom org-agenda-show-all-dates t
- "Non-nil means `org-agenda' shows every day in the selected range.
- When nil, only the days which actually have entries are shown."
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-format-date 'org-agenda-format-date-aligned
- "Format string for displaying dates in the agenda.
- Used by the daily/weekly agenda and by the timeline. This should be
- a format string understood by `format-time-string', or a function returning
- the formatted date as a string. The function must take a single argument,
- a calendar-style date list like (month day year)."
- :group 'org-agenda-daily/weekly
- :type '(choice
- (string :tag "Format string")
- (function :tag "Function")))
- (defun org-agenda-format-date-aligned (date)
- "Format a DATE string for display in the daily/weekly agenda, or timeline.
- This function makes sure that dates are aligned for easy reading."
- (require 'cal-iso)
- (let* ((dayname (calendar-day-name date))
- (day (cadr date))
- (day-of-week (calendar-day-of-week date))
- (month (car date))
- (monthname (calendar-month-name month))
- (year (nth 2 date))
- (iso-week (org-days-to-iso-week
- (calendar-absolute-from-gregorian date)))
- (weekyear (cond ((and (= month 1) (>= iso-week 52))
- (1- year))
- ((and (= month 12) (<= iso-week 1))
- (1+ year))
- (t year)))
- (weekstring (if (= day-of-week 1)
- (format " W%02d" iso-week)
- "")))
- (format "%-10s %2d %s %4d%s"
- dayname day monthname year weekstring)))
- (defcustom org-agenda-time-leading-zero nil
- "Non-nil means use leading zero for military times in agenda.
- For example, 9:30am would become 09:30 rather than 9:30."
- :group 'org-agenda-daily/weekly
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-timegrid-use-ampm nil
- "When set, show AM/PM style timestamps on the timegrid."
- :group 'org-agenda
- :version "24.1"
- :type 'boolean)
- (defun org-agenda-time-of-day-to-ampm (time)
- "Convert TIME of a string like '13:45' to an AM/PM style time string."
- (let* ((hour-number (string-to-number (substring time 0 -3)))
- (minute (substring time -2))
- (ampm "am"))
- (cond
- ((equal hour-number 12)
- (setq ampm "pm"))
- ((> hour-number 12)
- (setq ampm "pm")
- (setq hour-number (- hour-number 12))))
- (concat
- (if org-agenda-time-leading-zero
- (format "%02d" hour-number)
- (format "%02s" (number-to-string hour-number)))
- ":" minute ampm)))
- (defun org-agenda-time-of-day-to-ampm-maybe (time)
- "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'."
- (if org-agenda-timegrid-use-ampm
- (org-agenda-time-of-day-to-ampm time)
- time))
- (defcustom org-agenda-weekend-days '(6 0)
- "Which days are weekend?
- These days get the special face `org-agenda-date-weekend' in the agenda
- and timeline buffers."
- :group 'org-agenda-daily/weekly
- :type '(set :greedy t
- (const :tag "Monday" 1)
- (const :tag "Tuesday" 2)
- (const :tag "Wednesday" 3)
- (const :tag "Thursday" 4)
- (const :tag "Friday" 5)
- (const :tag "Saturday" 6)
- (const :tag "Sunday" 0)))
- (defcustom org-agenda-move-date-from-past-immediately-to-today t
- "Non-nil means jump to today when moving a past date forward in time.
- When using S-right in the agenda to move a a date forward, and the date
- stamp currently points to the past, the first key press will move it
- to today. WHen nil, just move one day forward even if the date stays
- in the past."
- :group 'org-agenda-daily/weekly
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-include-diary nil
- "If non-nil, include in the agenda entries from the Emacs Calendar's diary.
- Custom commands can set this variable in the options section."
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-include-deadlines t
- "If non-nil, include entries within their deadline warning period.
- Custom commands can set this variable in the options section."
- :group 'org-agenda-daily/weekly
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-repeating-timestamp-show-all t
- "Non-nil means show all occurrences of a repeating stamp in the agenda.
- When set to a list of strings, only show occurrences of repeating
- stamps for these TODO keywords. When nil, only one occurrence is
- shown, either today or the nearest into the future."
- :group 'org-agenda-daily/weekly
- :type '(choice
- (const :tag "Show repeating stamps" t)
- (repeat :tag "Show repeating stamps for these TODO keywords"
- (string :tag "TODO Keyword"))
- (const :tag "Don't show repeating stamps" nil)))
- (defcustom org-scheduled-past-days 10000
- "Number of days to continue listing scheduled items not marked DONE.
- When an item is scheduled on a date, it shows up in the agenda on this
- day and will be listed until it is marked done for the number of days
- given here."
- :group 'org-agenda-daily/weekly
- :type 'integer)
- (defcustom org-agenda-log-mode-items '(closed clock)
- "List of items that should be shown in agenda log mode.
- This list may contain the following symbols:
- closed Show entries that have been closed on that day.
- clock Show entries that have received clocked time on that day.
- state Show all logged state changes.
- Note that instead of changing this variable, you can also press `C-u l' in
- the agenda to display all available LOG items temporarily."
- :group 'org-agenda-daily/weekly
- :type '(set :greedy t (const closed) (const clock) (const state)))
- (defcustom org-agenda-clock-consistency-checks
- '(:max-duration "10:00" :min-duration 0 :max-gap "0:05"
- :gap-ok-around ("4:00")
- :default-face ((:background "DarkRed") (:foreground "white"))
- :overlap-face nil :gap-face nil :no-end-time-face nil
- :long-face nil :short-face nil)
- "This is a property list, with the following keys:
- :max-duration Mark clocking chunks that are longer than this time.
- This is a time string like \"HH:MM\", or the number
- of minutes as an integer.
- :min-duration Mark clocking chunks that are shorter that this.
- This is a time string like \"HH:MM\", or the number
- of minutes as an integer.
- :max-gap Mark gaps between clocking chunks that are longer than
- this duration. A number of minutes, or a string
- like \"HH:MM\".
- :gap-ok-around List of times during the day which are usually not working
- times. When a gap is detected, but the gap contains any
- of these times, the gap is *not* reported. For example,
- if this is (\"4:00\" \"13:00\") then gaps that contain
- 4:00 in the morning (i.e. the night) and 13:00
- (i.e. a typical lunch time) do not cause a warning.
- You should have at least one time during the night in this
- list, or otherwise the first task each morning will trigger
- a warning because it follows a long gap.
- Furthermore, the following properties can be used to define faces for
- issue display.
- :default-face the default face, if the specific face is undefined
- :overlap-face face for overlapping clocks
- :gap-face face for gaps between clocks
- :no-end-time-face face for incomplete clocks
- :long-face face for clock intervals that are too long
- :short-face face for clock intervals that are too short"
- :group 'org-agenda-daily/weekly
- :group 'org-clock
- :version "24.1"
- :type 'plist)
- (defcustom org-agenda-log-mode-add-notes t
- "Non-nil means add first line of notes to log entries in agenda views.
- If a log item like a state change or a clock entry is associated with
- notes, the first line of these notes will be added to the entry in the
- agenda display."
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-start-with-log-mode nil
- "The initial value of log-mode in a newly created agenda window.
- See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further
- explanations on the possible values."
- :group 'org-agenda-startup
- :group 'org-agenda-daily/weekly
- :type '(choice (const :tag "Don't show log items" nil)
- (const :tag "Show only log items" only)
- (const :tag "Show all possible log items" clockcheck)
- (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'"
- (choice (const :tag "Show closed log items" closed)
- (const :tag "Show clocked log items" clock)
- (const :tag "Show all logged state changes" state)))))
- (defcustom org-agenda-start-with-clockreport-mode nil
- "The initial value of clockreport-mode in a newly created agenda window."
- :group 'org-agenda-startup
- :group 'org-agenda-daily/weekly
- :type 'boolean)
- (defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2)
- "Property list with parameters for the clocktable in clockreport mode.
- This is the display mode that shows a clock table in the daily/weekly
- agenda, the properties for this dynamic block can be set here.
- The usual clocktable parameters are allowed here, but you cannot set
- the properties :name, :tstart, :tend, :block, and :scope - these will
- be overwritten to make sure the content accurately reflects the
- current display in the agenda."
- :group 'org-agenda-daily/weekly
- :type 'plist)
- (defcustom org-agenda-search-view-always-boolean nil
- "Non-nil means the search string is interpreted as individual parts.
- The search string for search view can either be interpreted as a phrase,
- or as a list of snippets that define a boolean search for a number of
- strings.
- When this is non-nil, the string will be split on whitespace, and each
- snippet will be searched individually, and all must match in order to
- select an entry. A snippet is then a single string of non-white
- characters, or a string in double quotes, or a regexp in {} braces.
- If a snippet is preceded by \"-\", the snippet must *not* match.
- \"+\" is syntactic sugar for positive selection. Each snippet may
- be found as a full word or a partial word, but see the variable
- `org-agenda-search-view-force-full-words'.
- When this is nil, search will look for the entire search phrase as one,
- with each space character matching any amount of whitespace, including
- line breaks.
- Even when this is nil, you can still switch to Boolean search dynamically
- by preceding the first snippet with \"+\" or \"-\". If the first snippet
- is a regexp marked with braces like \"{abc}\", this will also switch to
- boolean search."
- :group 'org-agenda-search-view
- :version "24.1"
- :type 'boolean)
- (org-defvaralias 'org-agenda-search-view-search-words-only
- 'org-agenda-search-view-always-boolean)
- (defcustom org-agenda-search-view-force-full-words nil
- "Non-nil means, search words must be matches as complete words.
- When nil, they may also match part of a word."
- :group 'org-agenda-search-view
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-search-view-max-outline-level 0
- "Maximum outline level to display in search view.
- E.g. when this is set to 1, the search view will only
- show headlines of level 1. When set to 0, the default
- value, don't limit agenda view by outline level."
- :group 'org-agenda-search-view
- :version "24.4"
- :package-version '(Org . "8.3")
- :type 'integer)
- (defgroup org-agenda-time-grid nil
- "Options concerning the time grid in the Org-mode Agenda."
- :tag "Org Agenda Time Grid"
- :group 'org-agenda)
- (defcustom org-agenda-search-headline-for-time t
- "Non-nil means search headline for a time-of-day.
- If the headline contains a time-of-day in one format or another, it will
- be used to sort the entry into the time sequence of items for a day.
- Some people have time stamps in the headline that refer to the creation
- time or so, and then this produces an unwanted side effect. If this is
- the case for your, use this variable to turn off searching the headline
- for a time."
- :group 'org-agenda-time-grid
- :type 'boolean)
- (defcustom org-agenda-use-time-grid t
- "Non-nil means show a time grid in the agenda schedule.
- A time grid is a set of lines for specific times (like every two hours between
- 8:00 and 20:00). The items scheduled for a day at specific times are
- sorted in between these lines.
- For details about when the grid will be shown, and what it will look like, see
- the variable `org-agenda-time-grid'."
- :group 'org-agenda-time-grid
- :type 'boolean)
- (defcustom org-agenda-time-grid
- '((daily today require-timed)
- "----------------"
- (800 1000 1200 1400 1600 1800 2000))
- "The settings for time grid for agenda display.
- This is a list of three items. The first item is again a list. It contains
- symbols specifying conditions when the grid should be displayed:
- daily if the agenda shows a single day
- weekly if the agenda shows an entire week
- today show grid on current date, independent of daily/weekly display
- require-timed show grid only if at least one item has a time specification
- The second item is a string which will be placed behind the grid time.
- The third item is a list of integers, indicating the times that should have
- a grid line."
- :group 'org-agenda-time-grid
- :type
- '(list
- (set :greedy t :tag "Grid Display Options"
- (const :tag "Show grid in single day agenda display" daily)
- (const :tag "Show grid in weekly agenda display" weekly)
- (const :tag "Always show grid for today" today)
- (const :tag "Show grid only if any timed entries are present"
- require-timed)
- (const :tag "Skip grid times already present in an entry"
- remove-match))
- (string :tag "Grid String")
- (repeat :tag "Grid Times" (integer :tag "Time"))))
- (defcustom org-agenda-show-current-time-in-grid t
- "Non-nil means show the current time in the time grid."
- :group 'org-agenda-time-grid
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-current-time-string
- "now - - - - - - - - - - - - - - - - - - - - - - - - -"
- "The string for the current time marker in the agenda."
- :group 'org-agenda-time-grid
- :version "24.1"
- :type 'string)
- (defgroup org-agenda-sorting nil
- "Options concerning sorting in the Org-mode Agenda."
- :tag "Org Agenda Sorting"
- :group 'org-agenda)
- (defcustom org-agenda-sorting-strategy
- '((agenda habit-down time-up priority-down category-keep)
- (todo priority-down category-keep)
- (tags priority-down category-keep)
- (search category-keep))
- "Sorting structure for the agenda items of a single day.
- This is a list of symbols which will be used in sequence to determine
- if an entry should be listed before another entry. The following
- symbols are recognized:
- time-up Put entries with time-of-day indications first, early first
- time-down Put entries with time-of-day indications first, late first
- timestamp-up Sort by any timestamp, early first
- timestamp-down Sort by any timestamp, late first
- scheduled-up Sort by scheduled timestamp, early first
- scheduled-down Sort by scheduled timestamp, late first
- deadline-up Sort by deadline timestamp, early first
- deadline-down Sort by deadline timestamp, late first
- ts-up Sort by active timestamp, early first
- ts-down Sort by active timestamp, late first
- tsia-up Sort by inactive timestamp, early first
- tsia-down Sort by inactive timestamp, late first
- category-keep Keep the default order of categories, corresponding to the
- sequence in `org-agenda-files'.
- category-up Sort alphabetically by category, A-Z.
- category-down Sort alphabetically by category, Z-A.
- tag-up Sort alphabetically by last tag, A-Z.
- tag-down Sort alphabetically by last tag, Z-A.
- priority-up Sort numerically by priority, high priority last.
- priority-down Sort numerically by priority, high priority first.
- todo-state-up Sort by todo state, tasks that are done last.
- todo-state-down Sort by todo state, tasks that are done first.
- effort-up Sort numerically by estimated effort, high effort last.
- effort-down Sort numerically by estimated effort, high effort first.
- user-defined-up Sort according to `org-agenda-cmp-user-defined', high last.
- user-defined-down Sort according to `org-agenda-cmp-user-defined', high first.
- habit-up Put entries that are habits first
- habit-down Put entries that are habits last
- alpha-up Sort headlines alphabetically
- alpha-down Sort headlines alphabetically, reversed
- The different possibilities will be tried in sequence, and testing stops
- if one comparison returns a \"not-equal\". For example, the default
- '(time-up category-keep priority-down)
- means: Pull out all entries having a specified time of day and sort them,
- in order to make a time schedule for the current day the first thing in the
- agenda listing for the day. Of the entries without a time indication, keep
- the grouped in categories, don't sort the categories, but keep them in
- the sequence given in `org-agenda-files'. Within each category sort by
- priority.
- Leaving out `category-keep' would mean that items will be sorted across
- categories by priority.
- Instead of a single list, this can also be a set of list for specific
- contents, with a context symbol in the car of the list, any of
- `agenda', `todo', `tags', `search' for the corresponding agenda views.
- Custom commands can bind this variable in the options section."
- :group 'org-agenda-sorting
- :type `(choice
- (repeat :tag "General" ,org-sorting-choice)
- (list :tag "Individually"
- (cons (const :tag "Strategy for Weekly/Daily agenda" agenda)
- (repeat ,org-sorting-choice))
- (cons (const :tag "Strategy for TODO lists" todo)
- (repeat ,org-sorting-choice))
- (cons (const :tag "Strategy for Tags matches" tags)
- (repeat ,org-sorting-choice))
- (cons (const :tag "Strategy for search matches" search)
- (repeat ,org-sorting-choice)))))
- (defcustom org-agenda-cmp-user-defined nil
- "A function to define the comparison `user-defined'.
- This function must receive two arguments, agenda entry a and b.
- If a>b, return +1. If a<b, return -1. If they are equal as seen by
- the user comparison, return nil.
- When this is defined, you can make `user-defined-up' and `user-defined-down'
- part of an agenda sorting strategy."
- :group 'org-agenda-sorting
- :type 'symbol)
- (defcustom org-sort-agenda-notime-is-late t
- "Non-nil means items without time are considered late.
- This is only relevant for sorting. When t, items which have no explicit
- time like 15:30 will be considered as 99:01, i.e. later than any items which
- do have a time. When nil, the default time is before 0:00. You can use this
- option to decide if the schedule for today should come before or after timeless
- agenda entries."
- :group 'org-agenda-sorting
- :type 'boolean)
- (defcustom org-sort-agenda-noeffort-is-high t
- "Non-nil means items without effort estimate are sorted as high effort.
- This also applies when filtering an agenda view with respect to the
- < or > effort operator. Then, tasks with no effort defined will be treated
- as tasks with high effort.
- When nil, such items are sorted as 0 minutes effort."
- :group 'org-agenda-sorting
- :type 'boolean)
- (defgroup org-agenda-line-format nil
- "Options concerning the entry prefix in the Org-mode agenda display."
- :tag "Org Agenda Line Format"
- :group 'org-agenda)
- (defcustom org-agenda-prefix-format
- '((agenda . " %i %-12:c%?-12t% s")
- (timeline . " % s")
- (todo . " %i %-12:c")
- (tags . " %i %-12:c")
- (search . " %i %-12:c"))
- "Format specifications for the prefix of items in the agenda views.
- An alist with five entries, each for the different agenda types. The
- keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'.
- The values are format strings.
- This format works similar to a printf format, with the following meaning:
- %c the category of the item, \"Diary\" for entries from the diary,
- or as given by the CATEGORY keyword or derived from the file name
- %e the effort required by the item
- %l the level of the item (insert X space(s) if item is of level X)
- %i the icon category of the item, see `org-agenda-category-icon-alist'
- %T the last tag of the item (ignore inherited tags, which come first)
- %t the HH:MM time-of-day specification if one applies to the entry
- %s Scheduling/Deadline information, a short string
- %b show breadcrumbs, i.e., the names of the higher levels
- %(expression) Eval EXPRESSION and replace the control string
- by the result
- All specifiers work basically like the standard `%s' of printf, but may
- contain two additional characters: a question mark just after the `%'
- and a whitespace/punctuation character just before the final letter.
- If the first character after `%' is a question mark, the entire field
- will only be included if the corresponding value applies to the current
- entry. This is useful for fields which should have fixed width when
- present, but zero width when absent. For example, \"%?-12t\" will
- result in a 12 character time field if a time of the day is specified,
- but will completely disappear in entries which do not contain a time.
- If there is punctuation or whitespace character just before the
- final format letter, this character will be appended to the field
- value if the value is not empty. For example, the format
- \"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If
- the category is empty, no additional colon is inserted.
- The default value for the agenda sublist is \" %-12:c%?-12t% s\",
- which means:
- - Indent the line with two space characters
- - Give the category a 12 chars wide field, padded with whitespace on
- the right (because of `-'). Append a colon if there is a category
- (because of `:').
- - If there is a time-of-day, put it into a 12 chars wide field. If no
- time, don't put in an empty field, just skip it (because of '?').
- - Finally, put the scheduling information.
- See also the variables `org-agenda-remove-times-when-in-prefix' and
- `org-agenda-remove-tags'.
- Custom commands can set this variable in the options section."
- :type '(choice
- (string :tag "General format")
- (list :greedy t :tag "View dependent"
- (cons (const agenda) (string :tag "Format"))
- (cons (const timeline) (string :tag "Format"))
- (cons (const todo) (string :tag "Format"))
- (cons (const tags) (string :tag "Format"))
- (cons (const search) (string :tag "Format"))))
- :group 'org-agenda-line-format)
- (defvar org-prefix-format-compiled nil
- "The compiled prefix format and associated variables.
- This is a list where first element is a list of variable bindings, and second
- element is the compiled format expression. See the variable
- `org-agenda-prefix-format'.")
- (defcustom org-agenda-todo-keyword-format "%-1s"
- "Format for the TODO keyword in agenda lines.
- Set this to something like \"%-12s\" if you want all TODO keywords
- to occupy a fixed space in the agenda display."
- :group 'org-agenda-line-format
- :type 'string)
- (defcustom org-agenda-diary-sexp-prefix nil
- "A regexp that matches part of a diary sexp entry
- which should be treated as scheduling/deadline information in
- `org-agenda'.
- For example, you can use this to extract the `diary-remind-message' from
- `diary-remind' entries."
- :group 'org-agenda-line-format
- :type '(choice (const :tag "None" nil) (regexp :tag "Regexp")))
- (defcustom org-agenda-timerange-leaders '("" "(%d/%d): ")
- "Text preceding timerange entries in the agenda view.
- This is a list with two strings. The first applies when the range
- is entirely on one day. The second applies if the range spans several days.
- The strings may have two \"%d\" format specifiers which will be filled
- with the sequence number of the days, and the total number of days in the
- range, respectively."
- :group 'org-agenda-line-format
- :type '(list
- (string :tag "Deadline today ")
- (choice :tag "Deadline relative"
- (string :tag "Format string")
- (function))))
- (defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ")
- "Text preceding scheduled items in the agenda view.
- This is a list with two strings. The first applies when the item is
- scheduled on the current day. The second applies when it has been scheduled
- previously, it may contain a %d indicating that this is the nth time that
- this item is scheduled, due to automatic rescheduling of unfinished items
- for the following day. So this number is one larger than the number of days
- that passed since this item was scheduled first."
- :group 'org-agenda-line-format
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(list
- (string :tag "Scheduled today ")
- (string :tag "Scheduled previously")))
- (defcustom org-agenda-inactive-leader "["
- "Text preceding item pulled into the agenda by inactive time stamps.
- These entries are added to the agenda when pressing \"[\"."
- :group 'org-agenda-line-format
- :version "24.1"
- :type 'string)
- (defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ")
- "Text preceding deadline items in the agenda view.
- This is a list with three strings. The first applies when the item has its
- deadline on the current day. The second applies when the deadline is in the
- future, the third one when it is in the past. The strings may contain %d
- to capture the number of days."
- :group 'org-agenda-line-format
- :version "24.4"
- :package-version '(Org . "8.0")
- :type '(list
- (string :tag "Deadline today ")
- (string :tag "Deadline in the future ")
- (string :tag "Deadline in the past ")))
- (defcustom org-agenda-remove-times-when-in-prefix t
- "Non-nil means remove duplicate time specifications in agenda items.
- When the format `org-agenda-prefix-format' contains a `%t' specifier, a
- time-of-day specification in a headline or diary entry is extracted and
- placed into the prefix. If this option is non-nil, the original specification
- \(a timestamp or -range, or just a plain time(range) specification like
- 11:30-4pm) will be removed for agenda display. This makes the agenda less
- cluttered.
- The option can be t or nil. It may also be the symbol `beg', indicating
- that the time should only be removed when it is located at the beginning of
- the headline/diary entry."
- :group 'org-agenda-line-format
- :type '(choice
- (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "When at beginning of entry" beg)))
- (defcustom org-agenda-remove-timeranges-from-blocks nil
- "Non-nil means remove time ranges specifications in agenda
- items that span on several days."
- :group 'org-agenda-line-format
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-default-appointment-duration nil
- "Default duration for appointments that only have a starting time.
- When nil, no duration is specified in such cases.
- When non-nil, this must be the number of minutes, e.g. 60 for one hour."
- :group 'org-agenda-line-format
- :type '(choice
- (integer :tag "Minutes")
- (const :tag "No default duration")))
- (defcustom org-agenda-show-inherited-tags t
- "Non-nil means show inherited tags in each agenda line.
- When this option is set to 'always, it take precedences over
- `org-agenda-use-tag-inheritance' and inherited tags are shown
- in every agenda.
- When this option is set to t (the default), inherited tags are
- shown when they are available, i.e. when the value of
- `org-agenda-use-tag-inheritance' has been taken into account.
- This can be set to a list of agenda types in which the agenda
- must display the inherited tags. Available types are 'todo,
- 'agenda, 'search and 'timeline.
- When set to nil, never show inherited tags in agenda lines."
- :group 'org-agenda-line-format
- :group 'org-agenda
- :version "24.3"
- :type '(choice
- (const :tag "Show inherited tags when available" t)
- (const :tag "Always show inherited tags" always)
- (repeat :tag "Show inherited tags only in selected agenda types"
- (symbol :tag "Agenda type"))))
- (defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda)
- "List of agenda view types where to use tag inheritance.
- In tags/tags-todo/tags-tree agenda views, tag inheritance is
- controlled by `org-use-tag-inheritance'. In other agenda types,
- `org-use-tag-inheritance' is not used for the selection of the
- agenda entries. Still, you may want the agenda to be aware of
- the inherited tags anyway, e.g. for later tag filtering.
- Allowed value are 'todo, 'search, 'timeline and 'agenda.
- This variable has no effect if `org-agenda-show-inherited-tags'
- is set to 'always. In that case, the agenda is aware of those
- tags.
- The default value sets tags in every agenda type. Setting this
- option to nil will speed up non-tags agenda view a lot."
- :group 'org-agenda
- :version "24.3"
- :type '(choice
- (const :tag "Use tag inheritance in all agenda types" t)
- (repeat :tag "Use tag inheritance in selected agenda types"
- (symbol :tag "Agenda type"))))
- (defcustom org-agenda-hide-tags-regexp nil
- "Regular expression used to filter away specific tags in agenda views.
- This means that these tags will be present, but not be shown in the agenda
- line. Secondary filtering will still work on the hidden tags.
- Nil means don't hide any tags."
- :group 'org-agenda-line-format
- :type '(choice
- (const :tag "Hide none" nil)
- (string :tag "Regexp ")))
- (defcustom org-agenda-remove-tags nil
- "Non-nil means remove the tags from the headline copy in the agenda.
- When this is the symbol `prefix', only remove tags when
- `org-agenda-prefix-format' contains a `%T' specifier."
- :group 'org-agenda-line-format
- :type '(choice
- (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "When prefix format contains %T" prefix)))
- (org-defvaralias 'org-agenda-remove-tags-when-in-prefix
- 'org-agenda-remove-tags)
- (defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80)
- "Shift tags in agenda items to this column.
- If this number is positive, it specifies the column. If it is negative,
- it means that the tags should be flushright to that column. For example,
- -80 works well for a normal 80 character screen."
- :group 'org-agenda-line-format
- :type 'integer)
- (org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
- (defcustom org-agenda-fontify-priorities 'cookies
- "Non-nil means highlight low and high priorities in agenda.
- When t, the highest priority entries are bold, lowest priority italic.
- However, settings in `org-priority-faces' will overrule these faces.
- When this variable is the symbol `cookies', only fontify the
- cookies, not the entire task.
- This may also be an association list of priority faces, whose
- keys are the character values of `org-highest-priority',
- `org-default-priority', and `org-lowest-priority' (the default values
- are ?A, ?B, and ?C, respectively). The face may be a named face, a
- color as a string, or a list like `(:background \"Red\")'.
- If it is a color, the variable `org-faces-easy-properties'
- determines if it is a foreground or a background color."
- :group 'org-agenda-line-format
- :type '(choice
- (const :tag "Never" nil)
- (const :tag "Defaults" t)
- (const :tag "Cookies only" cookies)
- (repeat :tag "Specify"
- (list (character :tag "Priority" :value ?A)
- (choice :tag "Face "
- (string :tag "Color")
- (sexp :tag "Face"))))))
- (defcustom org-agenda-day-face-function nil
- "Function called to determine what face should be used to display a day.
- The only argument passed to that function is the day. It should
- returns a face, or nil if does not want to specify a face and let
- the normal rules apply."
- :group 'org-agenda-line-format
- :version "24.1"
- :type '(choice (const nil) (function)))
- (defcustom org-agenda-category-icon-alist nil
- "Alist of category icon to be displayed in agenda views.
- Each entry should have the following format:
- (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS)
- Where CATEGORY-REGEXP is a regexp matching the categories where
- the icon should be displayed.
- FILE-OR-DATA either a file path or a string containing image data.
- The other fields can be omitted safely if not needed:
- TYPE indicates the image type.
- DATA-P is a boolean indicating whether the FILE-OR-DATA string is
- image data.
- PROPS are additional image attributes to assign to the image,
- like, e.g. `:ascent center'.
- (\"Org\" \"/path/to/icon.png\" nil nil :ascent center)
- If you want to set the display properties yourself, just put a
- list as second element:
- (CATEGORY-REGEXP (MY PROPERTY LIST))
- For example, to display a 16px horizontal space for Emacs
- category, you can use:
- (\"Emacs\" '(space . (:width (16))))"
- :group 'org-agenda-line-format
- :version "24.1"
- :type '(alist :key-type (string :tag "Regexp matching category")
- :value-type (choice (list :tag "Icon"
- (string :tag "File or data")
- (symbol :tag "Type")
- (boolean :tag "Data?")
- (repeat :tag "Extra image properties" :inline t symbol))
- (list :tag "Display properties" sexp))))
- (defgroup org-agenda-column-view nil
- "Options concerning column view in the agenda."
- :tag "Org Agenda Column View"
- :group 'org-agenda)
- (defcustom org-agenda-columns-show-summaries t
- "Non-nil means show summaries for columns displayed in the agenda view."
- :group 'org-agenda-column-view
- :type 'boolean)
- (defcustom org-agenda-columns-compute-summary-properties t
- "Non-nil means recompute all summary properties before column view.
- When column view in the agenda is listing properties that have a summary
- operator, it can go to all relevant buffers and recompute the summaries
- there. This can mean overhead for the agenda column view, but is necessary
- to have thing up to date.
- As a special case, a CLOCKSUM property also makes sure that the clock
- computations are current."
- :group 'org-agenda-column-view
- :type 'boolean)
- (defcustom org-agenda-columns-add-appointments-to-effort-sum nil
- "Non-nil means the duration of an appointment will add to day effort.
- The property to which appointment durations will be added is the one given
- in the option `org-effort-property'. If an appointment does not have
- an end time, `org-agenda-default-appointment-duration' will be used. If that
- is not set, an appointment without end time will not contribute to the time
- estimate."
- :group 'org-agenda-column-view
- :type 'boolean)
- (defcustom org-agenda-auto-exclude-function nil
- "A function called with a tag to decide if it is filtered on '/ RET'.
- The sole argument to the function, which is called once for each
- possible tag, is a string giving the name of the tag. The
- function should return either nil if the tag should be included
- as normal, or \"-<TAG>\" to exclude the tag.
- Note that for the purpose of tag filtering, only the lower-case version of
- all tags will be considered, so that this function will only ever see
- the lower-case version of all tags."
- :group 'org-agenda
- :type '(choice (const nil) (function)))
- (defcustom org-agenda-bulk-custom-functions nil
- "Alist of characters and custom functions for bulk actions.
- For example, this value makes those two functions available:
- '((?R set-category)
- (?C bulk-cut))
- With selected entries in an agenda buffer, `B R' will call
- the custom function `set-category' on the selected entries.
- Note that functions in this alist don't need to be quoted."
- :type 'alist
- :version "24.1"
- :group 'org-agenda)
- (defmacro org-agenda-with-point-at-orig-entry (string &rest body)
- "Execute BODY with point at location given by `org-hd-marker' property.
- If STRING is non-nil, the text property will be fetched from position 0
- in that string. If STRING is nil, it will be fetched from the beginning
- of the current line."
- (org-with-gensyms (marker)
- `(let ((,marker (get-text-property (if string 0 (point-at-bol))
- 'org-hd-marker ,string)))
- (with-current-buffer (marker-buffer ,marker)
- (save-excursion
- (goto-char ,marker)
- ,@body)))))
- (def-edebug-spec org-agenda-with-point-at-orig-entry (form body))
- (defun org-add-agenda-custom-command (entry)
- "Replace or add a command in `org-agenda-custom-commands'.
- This is mostly for hacking and trying a new command - once the command
- works you probably want to add it to `org-agenda-custom-commands' for good."
- (let ((ass (assoc (car entry) org-agenda-custom-commands)))
- (if ass
- (setcdr ass (cdr entry))
- (push entry org-agenda-custom-commands))))
- ;;; Define the org-agenda-mode
- (defvar org-agenda-mode-map (make-sparse-keymap)
- "Keymap for `org-agenda-mode'.")
- (org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
- (defvar org-agenda-menu) ; defined later in this file.
- (defvar org-agenda-restrict nil) ; defined later in this file.
- (defvar org-agenda-follow-mode nil)
- (defvar org-agenda-entry-text-mode nil)
- (defvar org-agenda-clockreport-mode nil)
- (defvar org-agenda-show-log nil)
- (defvar org-agenda-redo-command nil)
- (defvar org-agenda-query-string nil)
- (defvar org-agenda-mode-hook nil
- "Hook run after `org-agenda-mode' is turned on.
- The buffer is still writable when this hook is called.")
- (defvar org-agenda-type nil)
- (defvar org-agenda-force-single-file nil)
- (defvar org-agenda-bulk-marked-entries nil
- "List of markers that refer to marked entries in the agenda.")
- ;;; Multiple agenda buffers support
- (defcustom org-agenda-sticky nil
- "Non-nil means agenda q key will bury agenda buffers.
- Agenda commands will then show existing buffer instead of generating new ones.
- When nil, `q' will kill the single agenda buffer."
- :group 'org-agenda
- :version "24.3"
- :type 'boolean)
- ;;;###autoload
- (defun org-toggle-sticky-agenda (&optional arg)
- "Toggle `org-agenda-sticky'."
- (interactive "P")
- (let ((new-value (if arg
- (> (prefix-numeric-value arg) 0)
- (not org-agenda-sticky))))
- (if (equal new-value org-agenda-sticky)
- (and (org-called-interactively-p 'interactive)
- (message "Sticky agenda was already %s"
- (if org-agenda-sticky "enabled" "disabled")))
- (setq org-agenda-sticky new-value)
- (org-agenda-kill-all-agenda-buffers)
- (and (org-called-interactively-p 'interactive)
- (message "Sticky agenda was %s"
- (if org-agenda-sticky "enabled" "disabled"))))))
- (defvar org-agenda-buffer nil
- "Agenda buffer currently being generated.")
- (defvar org-agenda-last-prefix-arg nil)
- (defvar org-agenda-this-buffer-name nil)
- (defvar org-agenda-doing-sticky-redo nil)
- (defvar org-agenda-this-buffer-is-sticky nil)
- (defconst org-agenda-local-vars
- '(org-agenda-this-buffer-name
- org-agenda-undo-list
- org-agenda-pending-undo-list
- org-agenda-follow-mode
- org-agenda-entry-text-mode
- org-agenda-clockreport-mode
- org-agenda-show-log
- org-agenda-redo-command
- org-agenda-query-string
- org-agenda-type
- org-agenda-bulk-marked-entries
- org-agenda-undo-has-started-in
- org-agenda-info
- org-agenda-pre-window-conf
- org-agenda-columns-active
- org-agenda-tag-filter-overlays
- org-agenda-tag-filter
- org-agenda-cat-filter-overlays
- org-agenda-category-filter
- org-agenda-re-filter-overlays
- org-agenda-regexp-filter
- org-agenda-markers
- org-agenda-last-search-view-search-was-boolean
- org-agenda-filtered-by-category
- org-agenda-filter-form
- org-agenda-cycle-counter
- org-agenda-last-prefix-arg)
- "Variables that must be local in agenda buffers to allow multiple buffers.")
- (defun org-agenda-mode ()
- "Mode for time-sorted view on action items in Org-mode files.
- The following commands are available:
- \\{org-agenda-mode-map}"
- (interactive)
- (cond (org-agenda-doing-sticky-redo
- ;; Refreshing sticky agenda-buffer
- ;;
- ;; Preserve the value of `org-agenda-local-vars' variables,
- ;; while letting `kill-all-local-variables' kill the rest
- (let ((save (buffer-local-variables)))
- (kill-all-local-variables)
- (mapc 'make-local-variable org-agenda-local-vars)
- (dolist (elem save)
- (let ((var (car elem))
- (val (cdr elem)))
- (when (and val
- (member var org-agenda-local-vars))
- (set var val)))))
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
- (org-agenda-sticky
- ;; Creating a sticky Agenda buffer for the first time
- (kill-all-local-variables)
- (mapc 'make-local-variable org-agenda-local-vars)
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t))
- (t
- ;; Creating a non-sticky agenda buffer
- (kill-all-local-variables)
- (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil)))
- (setq org-agenda-undo-list nil
- org-agenda-pending-undo-list nil
- org-agenda-bulk-marked-entries nil)
- (setq major-mode 'org-agenda-mode)
- ;; Keep global-font-lock-mode from turning on font-lock-mode
- (org-set-local 'font-lock-global-modes (list 'not major-mode))
- (setq mode-name "Org-Agenda")
- (use-local-map org-agenda-mode-map)
- (easy-menu-add org-agenda-menu)
- (if org-startup-truncated (setq truncate-lines t))
- (org-set-local 'line-move-visual nil)
- (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local)
- (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local)
- ;; Make sure properties are removed when copying text
- (org-add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (substring-no-properties (funcall fun start end delete)))
- nil t)
- (unless org-agenda-keep-modes
- (setq org-agenda-follow-mode org-agenda-start-with-follow-mode
- org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode
- org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode
- org-agenda-show-log org-agenda-start-with-log-mode))
- (easy-menu-change
- '("Agenda") "Agenda Files"
- (append
- (list
- (vector
- (if (get 'org-agenda-files 'org-restrict)
- "Restricted to single file"
- "Edit File List")
- '(org-edit-agenda-file-list)
- (not (get 'org-agenda-files 'org-restrict)))
- "--")
- (mapcar 'org-file-menu-entry (org-agenda-files))))
- (org-agenda-set-mode-name)
- (apply
- (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks)
- (list 'org-agenda-mode-hook)))
- (substitute-key-definition 'undo 'org-agenda-undo
- org-agenda-mode-map global-map)
- (org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto)
- (org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto)
- (org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to)
- (org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill)
- (org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile)
- (org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward)
- (org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward)
- (org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark)
- (org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle)
- (org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all)
- (org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all)
- (org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks)
- (org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp)
- (org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark)
- (org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all)
- (org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action)
- (org-defkey org-agenda-mode-map "k" 'org-agenda-capture)
- (org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda)
- (org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default)
- (org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag)
- (org-defkey org-agenda-mode-map "\C-c\C-xA" 'org-agenda-archive-to-archive-sibling)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive)
- (org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive)
- (org-defkey org-agenda-mode-map "$" 'org-agenda-archive)
- (org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link)
- (org-defkey org-agenda-mode-map " " 'org-agenda-show-and-scroll-up)
- (org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down)
- (org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down)
- (org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset)
- (org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset)
- (org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer)
- (org-defkey org-agenda-mode-map "o" 'delete-other-windows)
- (org-defkey org-agenda-mode-map "L" 'org-agenda-recenter)
- (org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo)
- (org-defkey org-agenda-mode-map "t" 'org-agenda-todo)
- (org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation)
- (org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags)
- (org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags)
- (org-defkey org-agenda-mode-map "." 'org-agenda-goto-today)
- (org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date)
- (org-defkey org-agenda-mode-map "d" 'org-agenda-day-view)
- (org-defkey org-agenda-mode-map "w" 'org-agenda-week-view)
- (org-defkey org-agenda-mode-map "y" 'org-agenda-year-view)
- (org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note)
- (org-defkey org-agenda-mode-map "z" 'org-agenda-add-note)
- (org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later)
- (org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier)
- (org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later)
- (org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier)
- (org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt)
- (org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule)
- (org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline)
- (let ((l '(1 2 3 4 5 6 7 8 9 0)))
- (while l (org-defkey org-agenda-mode-map
- (int-to-string (pop l)) 'digit-argument)))
- (org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode)
- (org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode)
- (org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode)
- (org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode)
- (org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch)
- (org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary)
- (org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines)
- (org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid)
- (org-defkey org-agenda-mode-map "r" 'org-agenda-redo)
- (org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t)))
- (org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort)
- (org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-e"
- 'org-clock-modify-effort-estimate)
- (org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property)
- (org-defkey org-agenda-mode-map "q" 'org-agenda-quit)
- (org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit)
- (org-defkey org-agenda-mode-map "x" 'org-agenda-exit)
- (org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write)
- (org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers)
- (org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers)
- (org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags)
- (org-defkey org-agenda-mode-map "n" 'org-agenda-next-line)
- (org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line)
- (org-defkey org-agenda-mode-map "N" 'org-agenda-next-item)
- (org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item)
- (substitute-key-definition 'next-line 'org-agenda-next-line
- org-agenda-mode-map global-map)
- (substitute-key-definition 'previous-line 'org-agenda-previous-line
- org-agenda-mode-map global-map)
- (org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach)
- (org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line)
- (org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line)
- (org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority)
- (org-defkey org-agenda-mode-map "," 'org-agenda-priority)
- (org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry)
- (org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar)
- (org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date)
- (org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon)
- (org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset)
- (org-defkey org-agenda-mode-map "h" 'org-agenda-holidays)
- (org-defkey org-agenda-mode-map "H" 'org-agenda-holidays)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in)
- (org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out)
- (org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel)
- (org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto)
- (org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto)
- (org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up)
- (org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down)
- (org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up)
- (org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down)
- (org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up)
- (org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down)
- (org-defkey org-agenda-mode-map "f" 'org-agenda-later)
- (org-defkey org-agenda-mode-map "b" 'org-agenda-earlier)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
- (org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock)
- (org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add)
- (org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract)
- (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re)
- (org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
- (org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
- (org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
- (org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
- (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
- (org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
- (org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
- (org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline)
- (org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
- (define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
- (org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push)
- (org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse)
- (org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse)
- (when org-agenda-mouse-1-follows-link
- (org-defkey org-agenda-mode-map [follow-link] 'mouse-face))
- (easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu"
- '("Agenda"
- ("Agenda Files")
- "--"
- ("Agenda Dates"
- ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)]
- ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)]
- ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)]
- ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)])
- "--"
- ("View"
- ["Day View" org-agenda-day-view
- :active (org-agenda-check-type nil 'agenda)
- :style radio :selected (eq org-agenda-current-span 'day)
- :keys "v d (or just d)"]
- ["Week View" org-agenda-week-view
- :active (org-agenda-check-type nil 'agenda)
- :style radio :selected (eq org-agenda-current-span 'week)
- :keys "v w"]
- ["Fortnight View" org-agenda-fortnight-view
- :active (org-agenda-check-type nil 'agenda)
- :style radio :selected (eq org-agenda-current-span 'fortnight)
- :keys "v f"]
- ["Month View" org-agenda-month-view
- :active (org-agenda-check-type nil 'agenda)
- :style radio :selected (eq org-agenda-current-span 'month)
- :keys "v m"]
- ["Year View" org-agenda-year-view
- :active (org-agenda-check-type nil 'agenda)
- :style radio :selected (eq org-agenda-current-span 'year)
- :keys "v y"]
- "--"
- ["Include Diary" org-agenda-toggle-diary
- :style toggle :selected org-agenda-include-diary
- :active (org-agenda-check-type nil 'agenda)]
- ["Include Deadlines" org-agenda-toggle-deadlines
- :style toggle :selected org-agenda-include-deadlines
- :active (org-agenda-check-type nil 'agenda)]
- ["Use Time Grid" org-agenda-toggle-time-grid
- :style toggle :selected org-agenda-use-time-grid
- :active (org-agenda-check-type nil 'agenda)]
- "--"
- ["Show clock report" org-agenda-clockreport-mode
- :style toggle :selected org-agenda-clockreport-mode
- :active (org-agenda-check-type nil 'agenda)]
- ["Show some entry text" org-agenda-entry-text-mode
- :style toggle :selected org-agenda-entry-text-mode
- :active t]
- "--"
- ["Show Logbook entries" org-agenda-log-mode
- :style toggle :selected org-agenda-show-log
- :active (org-agenda-check-type nil 'agenda 'timeline)
- :keys "v l (or just l)"]
- ["Include archived trees" org-agenda-archives-mode
- :style toggle :selected org-agenda-archives-mode :active t
- :keys "v a"]
- ["Include archive files" (org-agenda-archives-mode t)
- :style toggle :selected (eq org-agenda-archives-mode t) :active t
- :keys "v A"]
- "--"
- ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
- ["Write view to file" org-agenda-write t]
- ["Rebuild buffer" org-agenda-redo t]
- ["Save all Org-mode Buffers" org-save-all-org-buffers t]
- "--"
- ["Show original entry" org-agenda-show t]
- ["Go To (other window)" org-agenda-goto t]
- ["Go To (this window)" org-agenda-switch-to t]
- ["Capture with cursor date" org-agenda-capture t]
- ["Follow Mode" org-agenda-follow-mode
- :style toggle :selected org-agenda-follow-mode :active t]
- ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t]
- "--"
- ("TODO"
- ["Cycle TODO" org-agenda-todo t]
- ["Next TODO set" org-agenda-todo-nextset t]
- ["Previous TODO set" org-agenda-todo-previousset t]
- ["Add note" org-agenda-add-note t])
- ("Archive/Refile/Delete"
- ["Archive default" org-agenda-archive-default t]
- ["Archive default" org-agenda-archive-default-with-confirmation t]
- ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t]
- ["Move to archive sibling" org-agenda-archive-to-archive-sibling t]
- ["Archive subtree" org-agenda-archive t]
- "--"
- ["Refile" org-agenda-refile t]
- "--"
- ["Delete subtree" org-agenda-kill t])
- ("Bulk action"
- ["Mark entry" org-agenda-bulk-mark t]
- ["Mark all" org-agenda-bulk-mark-all t]
- ["Unmark entry" org-agenda-bulk-unmark t]
- ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"]
- ["Toggle mark" org-agenda-bulk-toggle t]
- ["Toggle all" org-agenda-bulk-toggle-all t]
- ["Mark regexp" org-agenda-bulk-mark-regexp t])
- ["Act on all marked" org-agenda-bulk-action t]
- "--"
- ("Tags and Properties"
- ["Show all Tags" org-agenda-show-tags t]
- ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))]
- ["Change tag in region" org-agenda-set-tags (org-region-active-p)]
- "--"
- ["Column View" org-columns t])
- ("Deadline/Schedule"
- ["Schedule" org-agenda-schedule t]
- ["Set Deadline" org-agenda-deadline t]
- "--"
- ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)]
- ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)]
- ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"]
- ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"]
- ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"]
- ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"]
- ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)])
- ("Clock and Effort"
- ["Clock in" org-agenda-clock-in t]
- ["Clock out" org-agenda-clock-out t]
- ["Clock cancel" org-agenda-clock-cancel t]
- ["Goto running clock" org-clock-goto t]
- "--"
- ["Set Effort" org-agenda-set-effort t]
- ["Change clocked effort" org-clock-modify-effort-estimate
- (org-clock-is-active)])
- ("Priority"
- ["Set Priority" org-agenda-priority t]
- ["Increase Priority" org-agenda-priority-up t]
- ["Decrease Priority" org-agenda-priority-down t]
- ["Show Priority" org-show-priority t])
- ("Calendar/Diary"
- ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)]
- ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)]
- ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)]
- ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)]
- ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)]
- ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)]
- "--"
- ["Create iCalendar File" org-icalendar-combine-agenda-files t])
- "--"
- ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list]
- "--"
- ("MobileOrg"
- ["Push Files and Views" org-mobile-push t]
- ["Get Captured and Flagged" org-mobile-pull t]
- ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"]
- ["Show note / unflag" org-agenda-show-the-flagging-note t]
- "--"
- ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t])
- "--"
- ["Quit" org-agenda-quit t]
- ["Exit and Release Buffers" org-agenda-exit t]
- ))
- ;;; Agenda undo
- (defvar org-agenda-allow-remote-undo t
- "Non-nil means allow remote undo from the agenda buffer.")
- (defvar org-agenda-undo-has-started-in nil
- "Buffers that have already seen `undo-start' in the current undo sequence.")
- (defun org-agenda-undo ()
- "Undo a remote editing step in the agenda.
- This undoes changes both in the agenda buffer and in the remote buffer
- that have been changed along."
- (interactive)
- (or org-agenda-allow-remote-undo
- (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo"))
- (if (not (eq this-command last-command))
- (setq org-agenda-undo-has-started-in nil
- org-agenda-pending-undo-list org-agenda-undo-list))
- (if (not org-agenda-pending-undo-list)
- (user-error "No further undo information"))
- (let* ((entry (pop org-agenda-pending-undo-list))
- buf line cmd rembuf)
- (setq cmd (pop entry) line (pop entry))
- (setq rembuf (nth 2 entry))
- (org-with-remote-undo rembuf
- (while (bufferp (setq buf (pop entry)))
- (if (pop entry)
- (with-current-buffer buf
- (let ((last-undo-buffer buf)
- (inhibit-read-only t))
- (unless (memq buf org-agenda-undo-has-started-in)
- (push buf org-agenda-undo-has-started-in)
- (make-local-variable 'pending-undo-list)
- (undo-start))
- (while (and pending-undo-list
- (listp pending-undo-list)
- (not (car pending-undo-list)))
- (pop pending-undo-list))
- (undo-more 1))))))
- (org-goto-line line)
- (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf))))
- (defun org-verify-change-for-undo (l1 l2)
- "Verify that a real change occurred between the undo lists L1 and L2."
- (while (and l1 (listp l1) (null (car l1))) (pop l1))
- (while (and l2 (listp l2) (null (car l2))) (pop l2))
- (not (eq l1 l2)))
- ;;; Agenda dispatch
- (defvar org-agenda-restrict-begin (make-marker))
- (defvar org-agenda-restrict-end (make-marker))
- (defvar org-agenda-last-dispatch-buffer nil)
- (defvar org-agenda-overriding-restriction nil)
- (defcustom org-agenda-custom-commands-contexts nil
- "Alist of custom agenda keys and contextual rules.
- For example, if you have a custom agenda command \"p\" and you
- want this command to be accessible only from plain text files,
- use this:
- '((\"p\" ((in-file . \"\\.txt\"))))
- Here are the available contexts definitions:
- in-file: command displayed only in matching files
- in-mode: command displayed only in matching modes
- not-in-file: command not displayed in matching files
- not-in-mode: command not displayed in matching modes
- in-buffer: command displayed only in matching buffers
- not-in-buffer: command not displayed in matching buffers
- [function]: a custom function taking no argument
- If you define several checks, the agenda command will be
- accessible if there is at least one valid check.
- You can also bind a key to another agenda custom command
- depending on contextual rules.
- '((\"p\" \"q\" ((in-file . \"\\.txt\"))))
- Here it means: in .txt files, use \"p\" as the key for the
- agenda command otherwise associated with \"q\". (The command
- originally associated with \"q\" is not displayed to avoid
- duplicates.)"
- :version "24.3"
- :group 'org-agenda-custom-commands
- :type '(repeat (list :tag "Rule"
- (string :tag " Agenda key")
- (string :tag "Replace by command")
- (repeat :tag "Available when"
- (choice
- (cons :tag "Condition"
- (choice
- (const :tag "In file" in-file)
- (const :tag "Not in file" not-in-file)
- (const :tag "In buffer" in-buffer)
- (const :tag "Not in buffer" not-in-buffer)
- (const :tag "In mode" in-mode)
- (const :tag "Not in mode" not-in-mode))
- (regexp))
- (function :tag "Custom function"))))))
- (defcustom org-agenda-max-entries nil
- "Maximum number of entries to display in an agenda.
- This can be nil (no limit) or an integer or an alist of agenda
- types with an associated number of entries to display in this
- type."
- :version "24.4"
- :package-version '(Org . "8.0")
- :group 'org-agenda-custom-commands
- :type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search)
- (const timeline))
- (integer :tag "Max number of entries")))))
- (defcustom org-agenda-max-todos nil
- "Maximum number of TODOs to display in an agenda.
- This can be nil (no limit) or an integer or an alist of agenda
- types with an associated number of entries to display in this
- type."
- :version "24.4"
- :package-version '(Org . "8.0")
- :group 'org-agenda-custom-commands
- :type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search)
- (const timeline))
- (integer :tag "Max number of entries")))))
- (defcustom org-agenda-max-tags nil
- "Maximum number of tagged entries to display in an agenda.
- This can be nil (no limit) or an integer or an alist of agenda
- types with an associated number of entries to display in this
- type."
- :version "24.4"
- :package-version '(Org . "8.0")
- :group 'org-agenda-custom-commands
- :type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search)
- (const timeline))
- (integer :tag "Max number of entries")))))
- (defcustom org-agenda-max-effort nil
- "Maximum cumulated effort duration for the agenda.
- This can be nil (no limit) or a number of minutes (as an integer)
- or an alist of agenda types with an associated number of minutes
- to limit entries to in this type."
- :version "24.4"
- :package-version '(Org . "8.0")
- :group 'org-agenda-custom-commands
- :type '(choice (symbol :tag "No limit" nil)
- (integer :tag "Max number of entries")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search)
- (const timeline))
- (integer :tag "Max number of entries")))))
- (defvar org-keys nil)
- (defvar org-match nil)
- ;;;###autoload
- (defun org-agenda (&optional arg org-keys restriction)
- "Dispatch agenda commands to collect entries to the agenda buffer.
- Prompts for a command to execute. Any prefix arg will be passed
- on to the selected command. The default selections are:
- a Call `org-agenda-list' to display the agenda for current day or week.
- t Call `org-todo-list' to display the global todo list.
- T Call `org-todo-list' to display the global todo list, select only
- entries with a specific TODO keyword (the user gets a prompt).
- m Call `org-tags-view' to display headlines with tags matching
- a condition (the user is prompted for the condition).
- M Like `m', but select only TODO entries, no ordinary headlines.
- L Create a timeline for the current buffer.
- e Export views to associated files.
- s Search entries for keywords.
- S Search entries for keywords, only with TODO keywords.
- / Multi occur across all agenda files and also files listed
- in `org-agenda-text-search-extra-files'.
- < Restrict agenda commands to buffer, subtree, or region.
- Press several times to get the desired effect.
- > Remove a previous restriction.
- # List \"stuck\" projects.
- ! Configure what \"stuck\" means.
- C Configure custom agenda commands.
- More commands can be added by configuring the variable
- `org-agenda-custom-commands'. In particular, specific tags and TODO keyword
- searches can be pre-defined in this way.
- If the current buffer is in Org-mode and visiting a file, you can also
- first press `<' once to indicate that the agenda should be temporarily
- \(until the next use of \\[org-agenda]) restricted to the current file.
- Pressing `<' twice means to restrict to the current subtree or region
- \(if active)."
- (interactive "P")
- (catch 'exit
- (let* ((prefix-descriptions nil)
- (org-agenda-buffer-name org-agenda-buffer-name)
- (org-agenda-window-setup (if (equal (buffer-name)
- org-agenda-buffer-name)
- 'current-window
- org-agenda-window-setup))
- (org-agenda-custom-commands-orig org-agenda-custom-commands)
- (org-agenda-custom-commands
- ;; normalize different versions
- (delq nil
- (mapcar
- (lambda (x)
- (cond ((stringp (cdr x))
- (push x prefix-descriptions)
- nil)
- ((stringp (nth 1 x)) x)
- ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
- (t (cons (car x) (cons "" (cdr x))))))
- org-agenda-custom-commands)))
- (org-agenda-custom-commands
- (org-contextualize-keys
- org-agenda-custom-commands org-agenda-custom-commands-contexts))
- (buf (current-buffer))
- (bfn (buffer-file-name (buffer-base-buffer)))
- entry key type org-match lprops ans)
- ;; Turn off restriction unless there is an overriding one,
- (unless org-agenda-overriding-restriction
- (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list)
- ;; There is a request to keep the file list in place
- (put 'org-agenda-files 'org-restrict nil))
- (setq org-agenda-restrict nil)
- (move-marker org-agenda-restrict-begin nil)
- (move-marker org-agenda-restrict-end nil))
- ;; Delete old local properties
- (put 'org-agenda-redo-command 'org-lprops nil)
- ;; Delete previously set last-arguments
- (put 'org-agenda-redo-command 'last-args nil)
- ;; Remember where this call originated
- (setq org-agenda-last-dispatch-buffer (current-buffer))
- (unless org-keys
- (setq ans (org-agenda-get-restriction-and-command prefix-descriptions)
- org-keys (car ans)
- restriction (cdr ans)))
- ;; If we have sticky agenda buffers, set a name for the buffer,
- ;; depending on the invoking keys. The user may still set this
- ;; as a command option, which will overwrite what we do here.
- (if org-agenda-sticky
- (setq org-agenda-buffer-name
- (format "*Org Agenda(%s)*" org-keys)))
- ;; Establish the restriction, if any
- (when (and (not org-agenda-overriding-restriction) restriction)
- (put 'org-agenda-files 'org-restrict (list bfn))
- (cond
- ((eq restriction 'region)
- (setq org-agenda-restrict (current-buffer))
- (move-marker org-agenda-restrict-begin (region-beginning))
- (move-marker org-agenda-restrict-end (region-end)))
- ((eq restriction 'subtree)
- (save-excursion
- (setq org-agenda-restrict (current-buffer))
- (org-back-to-heading t)
- (move-marker org-agenda-restrict-begin (point))
- (move-marker org-agenda-restrict-end
- (progn (org-end-of-subtree t)))))))
- ;; For example the todo list should not need it (but does...)
- (cond
- ((setq entry (assoc org-keys org-agenda-custom-commands))
- (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry)))
- (progn
- (setq type (nth 2 entry) org-match (eval (nth 3 entry))
- lprops (nth 4 entry))
- (if org-agenda-sticky
- (setq org-agenda-buffer-name
- (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
- (format "*Org Agenda(%s)*" org-keys))))
- (put 'org-agenda-redo-command 'org-lprops lprops)
- (cond
- ((eq type 'agenda)
- (org-let lprops '(org-agenda-list current-prefix-arg)))
- ((eq type 'agenda*)
- (org-let lprops '(org-agenda-list current-prefix-arg nil nil t)))
- ((eq type 'alltodo)
- (org-let lprops '(org-todo-list current-prefix-arg)))
- ((eq type 'search)
- (org-let lprops '(org-search-view current-prefix-arg org-match nil)))
- ((eq type 'stuck)
- (org-let lprops '(org-agenda-list-stuck-projects
- current-prefix-arg)))
- ((eq type 'tags)
- (org-let lprops '(org-tags-view current-prefix-arg org-match)))
- ((eq type 'tags-todo)
- (org-let lprops '(org-tags-view '(4) org-match)))
- ((eq type 'todo)
- (org-let lprops '(org-todo-list org-match)))
- ((eq type 'tags-tree)
- (org-check-for-org-mode)
- (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match)))
- ((eq type 'todo-tree)
- (org-check-for-org-mode)
- (org-let lprops
- '(org-occur (concat "^" org-outline-regexp "[ \t]*"
- (regexp-quote org-match) "\\>"))))
- ((eq type 'occur-tree)
- (org-check-for-org-mode)
- (org-let lprops '(org-occur org-match)))
- ((functionp type)
- (org-let lprops '(funcall type org-match)))
- ((fboundp type)
- (org-let lprops '(funcall type org-match)))
- (t (user-error "Invalid custom agenda command type %s" type))))
- (org-agenda-run-series (nth 1 entry) (cddr entry))))
- ((equal org-keys "C")
- (setq org-agenda-custom-commands org-agenda-custom-commands-orig)
- (customize-variable 'org-agenda-custom-commands))
- ((equal org-keys "a") (call-interactively 'org-agenda-list))
- ((equal org-keys "s") (call-interactively 'org-search-view))
- ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4))))
- ((equal org-keys "t") (call-interactively 'org-todo-list))
- ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4))))
- ((equal org-keys "m") (call-interactively 'org-tags-view))
- ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4))))
- ((equal org-keys "e") (call-interactively 'org-store-agenda-views))
- ((equal org-keys "?") (org-tags-view nil "+FLAGGED")
- (org-add-hook
- 'post-command-hook
- (lambda ()
- (unless (current-message)
- (let* ((m (org-agenda-get-any-marker))
- (note (and m (org-entry-get m "THEFLAGGINGNOTE"))))
- (when note
- (message (concat
- "FLAGGING-NOTE ([?] for more info): "
- (org-add-props
- (replace-regexp-in-string
- "\\\\n" "//"
- (copy-sequence note))
- nil 'face 'org-warning)))))))
- t t))
- ((equal org-keys "L")
- (unless (derived-mode-p 'org-mode)
- (user-error "This is not an Org-mode file"))
- (unless restriction
- (put 'org-agenda-files 'org-restrict (list bfn))
- (org-call-with-arg 'org-timeline arg)))
- ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects))
- ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files))
- ((equal org-keys "!") (customize-variable 'org-stuck-projects))
- (t (user-error "Invalid agenda key"))))))
- (defvar org-agenda-multi)
- (defun org-agenda-append-agenda ()
- "Append another agenda view to the current one.
- This function allows interactive building of block agendas.
- Agenda views are separated by `org-agenda-block-separator'."
- (interactive)
- (unless (derived-mode-p 'org-agenda-mode)
- (user-error "Can only append from within agenda buffer"))
- (let ((org-agenda-multi t))
- (org-agenda)
- (widen)
- (org-agenda-finalize)
- (setq buffer-read-only t)
- (org-agenda-fit-window-to-buffer)))
- (defun org-agenda-normalize-custom-commands (cmds)
- "Normalize custom commands CMDS."
- (delq nil
- (mapcar
- (lambda (x)
- (cond ((stringp (cdr x)) nil)
- ((stringp (nth 1 x)) x)
- ((not (nth 1 x)) (cons (car x) (cons "" (cddr x))))
- (t (cons (car x) (cons "" (cdr x))))))
- cmds)))
- (defun org-agenda-get-restriction-and-command (prefix-descriptions)
- "The user interface for selecting an agenda command."
- (catch 'exit
- (let* ((bfn (buffer-file-name (buffer-base-buffer)))
- (restrict-ok (and bfn (derived-mode-p 'org-mode)))
- (region-p (org-region-active-p))
- (custom org-agenda-custom-commands)
- (selstring "")
- restriction second-time
- c entry key type match prefixes rmheader header-end custom1 desc
- line lines left right n n1)
- (save-window-excursion
- (delete-other-windows)
- (org-switch-to-buffer-other-window " *Agenda Commands*")
- (erase-buffer)
- (insert (eval-when-compile
- (let ((header
- "Press key for an agenda command: < Buffer, subtree/region restriction
- -------------------------------- > Remove restriction
- a Agenda for current week or day e Export agenda views
- t List of all TODO entries T Entries with special TODO kwd
- m Match a TAGS/PROP/TODO query M Like m, but only TODO entries
- s Search for keywords S Like s, but only TODO entries
- L Timeline for current buffer # List stuck projects (!=configure)
- / Multi-occur C Configure custom agenda commands
- ? Find :FLAGGED: entries * Toggle sticky agenda views
- ")
- (start 0))
- (while (string-match
- "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)"
- header start)
- (setq start (match-end 0))
- (add-text-properties (match-beginning 2) (match-end 2)
- '(face bold) header))
- header)))
- (setq header-end (point-marker))
- (while t
- (setq custom1 custom)
- (when (eq rmheader t)
- (org-goto-line 1)
- (re-search-forward ":" nil t)
- (delete-region (match-end 0) (point-at-eol))
- (forward-char 1)
- (looking-at "-+")
- (delete-region (match-end 0) (point-at-eol))
- (move-marker header-end (match-end 0)))
- (goto-char header-end)
- (delete-region (point) (point-max))
- ;; Produce all the lines that describe custom commands and prefixes
- (setq lines nil)
- (while (setq entry (pop custom1))
- (setq key (car entry) desc (nth 1 entry)
- type (nth 2 entry)
- match (nth 3 entry))
- (if (> (length key) 1)
- (add-to-list 'prefixes (string-to-char key))
- (setq line
- (format
- "%-4s%-14s"
- (org-add-props (copy-sequence key)
- '(face bold))
- (cond
- ((string-match "\\S-" desc) desc)
- ((eq type 'agenda) "Agenda for current week or day")
- ((eq type 'agenda*) "Appointments for current week or day")
- ((eq type 'alltodo) "List of all TODO entries")
- ((eq type 'search) "Word search")
- ((eq type 'stuck) "List of stuck projects")
- ((eq type 'todo) "TODO keyword")
- ((eq type 'tags) "Tags query")
- ((eq type 'tags-todo) "Tags (TODO)")
- ((eq type 'tags-tree) "Tags tree")
- ((eq type 'todo-tree) "TODO kwd tree")
- ((eq type 'occur-tree) "Occur tree")
- ((functionp type) (if (symbolp type)
- (symbol-name type)
- "Lambda expression"))
- (t "???"))))
- (if org-agenda-menu-show-matcher
- (setq line
- (concat line ": "
- (cond
- ((stringp match)
- (setq match (copy-sequence match))
- (org-add-props match nil 'face 'org-warning))
- ((listp type)
- (format "set of %d commands" (length type))))))
- (if (org-string-nw-p match)
- (add-text-properties
- 0 (length line) (list 'help-echo
- (concat "Matcher: " match)) line)))
- (push line lines)))
- (setq lines (nreverse lines))
- (when prefixes
- (mapc (lambda (x)
- (push
- (format "%s %s"
- (org-add-props (char-to-string x)
- nil 'face 'bold)
- (or (cdr (assoc (concat selstring
- (char-to-string x))
- prefix-descriptions))
- "Prefix key"))
- lines))
- prefixes))
- ;; Check if we should display in two columns
- (if org-agenda-menu-two-columns
- (progn
- (setq n (length lines)
- n1 (+ (/ n 2) (mod n 2))
- right (nthcdr n1 lines)
- left (copy-sequence lines))
- (setcdr (nthcdr (1- n1) left) nil))
- (setq left lines right nil))
- (while left
- (insert "\n" (pop left))
- (when right
- (if (< (current-column) 40)
- (move-to-column 40 t)
- (insert " "))
- (insert (pop right))))
- ;; Make the window the right size
- (goto-char (point-min))
- (if second-time
- (if (not (pos-visible-in-window-p (point-max)))
- (org-fit-window-to-buffer))
- (setq second-time t)
- (org-fit-window-to-buffer))
- ;; Ask for selection
- (message "Press key for agenda command%s:"
- (if (or restrict-ok org-agenda-overriding-restriction)
- (if org-agenda-overriding-restriction
- " (restriction lock active)"
- (if restriction
- (format " (restricted to %s)" restriction)
- " (unrestricted)"))
- ""))
- (setq c (read-char-exclusive))
- (message "")
- (cond
- ((assoc (char-to-string c) custom)
- (setq selstring (concat selstring (char-to-string c)))
- (throw 'exit (cons selstring restriction)))
- ((memq c prefixes)
- (setq selstring (concat selstring (char-to-string c))
- prefixes nil
- rmheader (or rmheader t)
- custom (delq nil (mapcar
- (lambda (x)
- (if (or (= (length (car x)) 1)
- (/= (string-to-char (car x)) c))
- nil
- (cons (substring (car x) 1) (cdr x))))
- custom))))
- ((eq c ?*)
- (call-interactively 'org-toggle-sticky-agenda)
- (sit-for 2))
- ((and (not restrict-ok) (memq c '(?1 ?0 ?<)))
- (message "Restriction is only possible in Org-mode buffers")
- (ding) (sit-for 1))
- ((eq c ?1)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction 'buffer))
- ((eq c ?0)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction (if region-p 'region 'subtree)))
- ((eq c ?<)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction
- (cond
- ((eq restriction 'buffer)
- (if region-p 'region 'subtree))
- ((memq restriction '(subtree region))
- nil)
- (t 'buffer))))
- ((eq c ?>)
- (org-agenda-remove-restriction-lock 'noupdate)
- (setq restriction nil))
- ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??)))
- (throw 'exit (cons (setq selstring (char-to-string c)) restriction)))
- ((and (> (length selstring) 0) (eq c ?\d))
- (delete-window)
- (org-agenda-get-restriction-and-command prefix-descriptions))
- ((equal c ?q) (error "Abort"))
- (t (user-error "Invalid key %c" c))))))))
- (defun org-agenda-fit-window-to-buffer ()
- "Fit the window to the buffer size."
- (and (memq org-agenda-window-setup '(reorganize-frame))
- (fboundp 'fit-window-to-buffer)
- (org-fit-window-to-buffer
- nil
- (floor (* (frame-height) (cdr org-agenda-window-frame-fractions)))
- (floor (* (frame-height) (car org-agenda-window-frame-fractions))))))
- (defvar org-cmd nil)
- (defvar org-agenda-overriding-cmd nil)
- (defvar org-agenda-overriding-arguments nil)
- (defvar org-agenda-overriding-cmd-arguments nil)
- (defun org-agenda-run-series (name series)
- "Run agenda NAME as a SERIES of agenda commands."
- (org-let (nth 1 series) '(org-agenda-prepare name))
- ;; We need to reset agenda markers here, because when constructing a
- ;; block agenda, the individual blocks do not do that.
- (org-agenda-reset-markers)
- (let* ((org-agenda-multi t)
- (redo (list 'org-agenda-run-series name (list 'quote series)))
- (cmds (car series))
- (gprops (nth 1 series))
- match ;; The byte compiler incorrectly complains about this. Keep it!
- org-cmd type lprops)
- (while (setq org-cmd (pop cmds))
- (setq type (car org-cmd)
- match (eval (nth 1 org-cmd))
- lprops (nth 2 org-cmd))
- (let ((org-agenda-overriding-arguments
- (if (eq org-agenda-overriding-cmd org-cmd)
- (or org-agenda-overriding-arguments
- org-agenda-overriding-cmd-arguments))))
- (cond
- ((eq type 'agenda)
- (org-let2 gprops lprops
- '(call-interactively 'org-agenda-list)))
- ((eq type 'agenda*)
- (org-let2 gprops lprops
- '(funcall 'org-agenda-list nil nil t)))
- ((eq type 'alltodo)
- (org-let2 gprops lprops
- '(call-interactively 'org-todo-list)))
- ((eq type 'search)
- (org-let2 gprops lprops
- '(org-search-view current-prefix-arg match nil)))
- ((eq type 'stuck)
- (org-let2 gprops lprops
- '(call-interactively 'org-agenda-list-stuck-projects)))
- ((eq type 'tags)
- (org-let2 gprops lprops
- '(org-tags-view current-prefix-arg match)))
- ((eq type 'tags-todo)
- (org-let2 gprops lprops
- '(org-tags-view '(4) match)))
- ((eq type 'todo)
- (org-let2 gprops lprops
- '(org-todo-list match)))
- ((fboundp type)
- (org-let2 gprops lprops
- '(funcall type match)))
- (t (error "Invalid type in command series")))))
- (widen)
- (let ((inhibit-read-only t))
- (add-text-properties (point-min) (point-max)
- `(org-series t org-series-redo-cmd ,redo)))
- (setq org-agenda-redo-command redo)
- (goto-char (point-min)))
- (org-agenda-fit-window-to-buffer)
- (org-let (nth 1 series) '(org-agenda-finalize)))
- ;;;###autoload
- (defmacro org-batch-agenda (cmd-key &rest parameters)
- "Run an agenda command in batch mode and send the result to STDOUT.
- If CMD-KEY is a string of length 1, it is used as a key in
- `org-agenda-custom-commands' and triggers this command. If it is a
- longer string it is used as a tags/todo match string.
- Parameters are alternating variable names and values that will be bound
- before running the agenda command."
- (org-eval-in-environment (org-make-parameter-alist parameters)
- (let (org-agenda-sticky)
- (if (> (length cmd-key) 2)
- (org-tags-view nil cmd-key)
- (org-agenda nil cmd-key))))
- (set-buffer org-agenda-buffer-name)
- (princ (buffer-string)))
- (defvar org-agenda-info nil)
- ;;;###autoload
- (defmacro org-batch-agenda-csv (cmd-key &rest parameters)
- "Run an agenda command in batch mode and send the result to STDOUT.
- If CMD-KEY is a string of length 1, it is used as a key in
- `org-agenda-custom-commands' and triggers this command. If it is a
- longer string it is used as a tags/todo match string.
- Parameters are alternating variable names and values that will be bound
- before running the agenda command.
- The output gives a line for each selected agenda item. Each
- item is a list of comma-separated values, like this:
- category,head,type,todo,tags,date,time,extra,priority-l,priority-n
- category The category of the item
- head The headline, without TODO kwd, TAGS and PRIORITY
- type The type of the agenda entry, can be
- todo selected in TODO match
- tagsmatch selected in tags match
- diary imported from diary
- deadline a deadline on given date
- scheduled scheduled on given date
- timestamp entry has timestamp on given date
- closed entry was closed on given date
- upcoming-deadline warning about deadline
- past-scheduled forwarded scheduled item
- block entry has date block including g. date
- todo The todo keyword, if any
- tags All tags including inherited ones, separated by colons
- date The relevant date, like 2007-2-14
- time The time, like 15:00-16:50
- extra Sting with extra planning info
- priority-l The priority letter if any was given
- priority-n The computed numerical priority
- agenda-day The day in the agenda where this is listed"
- (org-eval-in-environment (append '((org-agenda-remove-tags t))
- (org-make-parameter-alist parameters))
- (if (> (length cmd-key) 2)
- (org-tags-view nil cmd-key)
- (org-agenda nil cmd-key)))
- (set-buffer org-agenda-buffer-name)
- (let* ((lines (org-split-string (buffer-string) "\n"))
- line)
- (while (setq line (pop lines))
- (catch 'next
- (if (not (get-text-property 0 'org-category line)) (throw 'next nil))
- (setq org-agenda-info
- (org-fix-agenda-info (text-properties-at 0 line)))
- (princ
- (mapconcat 'org-agenda-export-csv-mapper
- '(org-category txt type todo tags date time extra
- priority-letter priority agenda-day)
- ","))
- (princ "\n")))))
- (defun org-fix-agenda-info (props)
- "Make sure all properties on an agenda item have a canonical form.
- This ensures the export commands can easily use it."
- (let (tmp re)
- (when (setq tmp (plist-get props 'tags))
- (setq props (plist-put props 'tags (mapconcat 'identity tmp ":"))))
- (when (setq tmp (plist-get props 'date))
- (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
- (let ((calendar-date-display-form '(year "-" month "-" day)))
- '((format "%4d, %9s %2s, %4s" dayname monthname day year))
- (setq tmp (calendar-date-string tmp)))
- (setq props (plist-put props 'date tmp)))
- (when (setq tmp (plist-get props 'day))
- (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp)))
- (let ((calendar-date-display-form '(year "-" month "-" day)))
- (setq tmp (calendar-date-string tmp)))
- (setq props (plist-put props 'day tmp))
- (setq props (plist-put props 'agenda-day tmp)))
- (when (setq tmp (plist-get props 'txt))
- (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp)
- (plist-put props 'priority-letter (match-string 1 tmp))
- (setq tmp (replace-match "" t t tmp)))
- (when (and (setq re (plist-get props 'org-todo-regexp))
- (setq re (concat "\\`\\.*" re " ?"))
- (string-match re tmp))
- (plist-put props 'todo (match-string 1 tmp))
- (setq tmp (replace-match "" t t tmp)))
- (plist-put props 'txt tmp)))
- props)
- (defun org-agenda-export-csv-mapper (prop)
- (let ((res (plist-get org-agenda-info prop)))
- (setq res
- (cond
- ((not res) "")
- ((stringp res) res)
- (t (prin1-to-string res))))
- (while (string-match "," res)
- (setq res (replace-match ";" t t res)))
- (org-trim res)))
- ;;;###autoload
- (defun org-store-agenda-views (&rest parameters)
- "Store agenda views."
- (interactive)
- (eval (list 'org-batch-store-agenda-views)))
- ;;;###autoload
- (defmacro org-batch-store-agenda-views (&rest parameters)
- "Run all custom agenda commands that have a file argument."
- (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
- (pop-up-frames nil)
- (dir default-directory)
- (pars (org-make-parameter-alist parameters))
- cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname)
- (save-window-excursion
- (while cmds
- (setq cmd (pop cmds)
- thiscmdkey (car cmd)
- thiscmdcmd (cdr cmd)
- match (nth 2 thiscmdcmd)
- bufname (if org-agenda-sticky
- (or (and (stringp match)
- (format "*Org Agenda(%s:%s)*" thiscmdkey match))
- (format "*Org Agenda(%s)*" thiscmdkey))
- org-agenda-buffer-name)
- cmd-or-set (nth 2 cmd)
- opts (nth (if (listp cmd-or-set) 3 4) cmd)
- files (nth (if (listp cmd-or-set) 4 5) cmd))
- (if (stringp files) (setq files (list files)))
- (when files
- (org-eval-in-environment (append org-agenda-exporter-settings
- opts pars)
- (org-agenda nil thiscmdkey))
- (set-buffer bufname)
- (while files
- (org-eval-in-environment (append org-agenda-exporter-settings
- opts pars)
- (org-agenda-write (expand-file-name (pop files) dir) nil t bufname)))
- (and (get-buffer bufname)
- (kill-buffer bufname)))))))
- (defvar org-agenda-current-span nil
- "The current span used in the agenda view.") ; local variable in the agenda buffer
- (defun org-agenda-mark-header-line (pos)
- "Mark the line at POS as an agenda structure header."
- (save-excursion
- (goto-char pos)
- (put-text-property (point-at-bol) (point-at-eol)
- 'org-agenda-structural-header t)
- (when org-agenda-title-append
- (put-text-property (point-at-bol) (point-at-eol)
- 'org-agenda-title-append org-agenda-title-append))))
- (defvar org-mobile-creating-agendas) ; defined in org-mobile.el
- (defvar org-agenda-write-buffer-name "Agenda View")
- (defun org-agenda-write (file &optional open nosettings agenda-bufname)
- "Write the current buffer (an agenda view) as a file.
- Depending on the extension of the file name, plain text (.txt),
- HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced.
- If the extension is .ics, run icalendar export over all files used
- to construct the agenda and limit the export to entries listed in the
- agenda now.
- If the extension is .org, collect all subtrees corresponding to the
- agenda entries and add them in an .org file.
- With prefix argument OPEN, open the new file immediately.
- If NOSETTINGS is given, do not scope the settings of
- `org-agenda-exporter-settings' into the export commands. This is used when
- the settings have already been scoped and we do not wish to overrule other,
- higher priority settings.
- If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write."
- (interactive "FWrite agenda to file: \nP")
- (if (or (not (file-writable-p file))
- (and (file-exists-p file)
- (if (org-called-interactively-p 'any)
- (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
- (user-error "Cannot write agenda to file %s" file))
- (org-let (if nosettings nil org-agenda-exporter-settings)
- '(save-excursion
- (save-window-excursion
- (org-agenda-mark-filtered-text)
- (let ((bs (copy-sequence (buffer-string))) beg content)
- (org-agenda-unmark-filtered-text)
- (with-temp-buffer
- (rename-buffer org-agenda-write-buffer-name t)
- (set-buffer-modified-p nil)
- (insert bs)
- (org-agenda-remove-marked-text 'org-filtered)
- (while (setq beg (text-property-any (point-min) (point-max)
- 'org-filtered t))
- (delete-region
- beg (or (next-single-property-change beg 'org-filtered)
- (point-max))))
- (run-hooks 'org-agenda-before-write-hook)
- (cond
- ((org-bound-and-true-p org-mobile-creating-agendas)
- (org-mobile-write-agenda-for-mobile file))
- ((string-match "\\.org\\'" file)
- (let (content p m message-log-max)
- (goto-char (point-min))
- (while (setq p (next-single-property-change (point) 'org-hd-marker nil))
- (goto-char p)
- (setq m (get-text-property (point) 'org-hd-marker))
- (when m
- (push (save-excursion
- (set-buffer (marker-buffer m))
- (goto-char m)
- (org-copy-subtree 1 nil t t)
- org-subtree-clip)
- content)))
- (find-file file)
- (erase-buffer)
- (mapcar (lambda (s) (org-paste-subtree 1 s)) (reverse content))
- (write-file file)
- (kill-buffer (current-buffer))
- (message "Org file written to %s" file)))
- ((string-match "\\.html?\\'" file)
- (require 'htmlize)
- (set-buffer (htmlize-buffer (current-buffer)))
- (when org-agenda-export-html-style
- ;; replace <style> section with org-agenda-export-html-style
- (goto-char (point-min))
- (kill-region (- (search-forward "<style") 6)
- (search-forward "</style>"))
- (insert org-agenda-export-html-style))
- (write-file file)
- (kill-buffer (current-buffer))
- (message "HTML written to %s" file))
- ((string-match "\\.ps\\'" file)
- (require 'ps-print)
- (ps-print-buffer-with-faces file)
- (message "Postscript written to %s" file))
- ((string-match "\\.pdf\\'" file)
- (require 'ps-print)
- (ps-print-buffer-with-faces
- (concat (file-name-sans-extension file) ".ps"))
- (call-process "ps2pdf" nil nil nil
- (expand-file-name
- (concat (file-name-sans-extension file) ".ps"))
- (expand-file-name file))
- (delete-file (concat (file-name-sans-extension file) ".ps"))
- (message "PDF written to %s" file))
- ((string-match "\\.ics\\'" file)
- (require 'ox-icalendar)
- (org-icalendar-export-current-agenda (expand-file-name file)))
- (t
- (let ((bs (buffer-string)))
- (find-file file)
- (erase-buffer)
- (insert bs)
- (save-buffer 0)
- (kill-buffer (current-buffer))
- (message "Plain text written to %s" file))))))))
- (set-buffer (or agenda-bufname
- (and (org-called-interactively-p 'any) (buffer-name))
- org-agenda-buffer-name)))
- (when open (org-open-file file)))
- (defvar org-agenda-tag-filter-overlays nil)
- (defvar org-agenda-cat-filter-overlays nil)
- (defvar org-agenda-re-filter-overlays nil)
- (defun org-agenda-mark-filtered-text ()
- "Mark all text hidden by filtering with a text property."
- (let ((inhibit-read-only t))
- (mapc
- (lambda (o)
- (when (equal (overlay-buffer o) (current-buffer))
- (put-text-property
- (overlay-start o) (overlay-end o)
- 'org-filtered t)))
- (append org-agenda-tag-filter-overlays
- org-agenda-cat-filter-overlays
- org-agenda-re-filter-overlays))))
- (defun org-agenda-unmark-filtered-text ()
- "Remove the filtering text property."
- (let ((inhibit-read-only t))
- (remove-text-properties (point-min) (point-max) '(org-filtered t))))
- (defun org-agenda-remove-marked-text (property &optional value)
- "Delete all text marked with VALUE of PROPERTY.
- VALUE defaults to t."
- (let (beg)
- (setq value (or value t))
- (while (setq beg (text-property-any (point-min) (point-max)
- property value))
- (delete-region
- beg (or (next-single-property-change beg 'org-filtered)
- (point-max))))))
- (defun org-agenda-add-entry-text ()
- "Add entry text to agenda lines.
- This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the
- entry text following headings shown in the agenda.
- Drawers will be excluded, also the line with scheduling/deadline info."
- (when (and (> org-agenda-add-entry-text-maxlines 0)
- (not (org-bound-and-true-p org-mobile-creating-agendas)))
- (let (m txt)
- (goto-char (point-min))
- (while (not (eobp))
- (if (not (setq m (org-get-at-bol 'org-hd-marker)))
- (beginning-of-line 2)
- (setq txt (org-agenda-get-some-entry-text
- m org-agenda-add-entry-text-maxlines " > "))
- (end-of-line 1)
- (if (string-match "\\S-" txt)
- (insert "\n" txt)
- (or (eobp) (forward-char 1))))))))
- (defun org-agenda-get-some-entry-text (marker n-lines &optional indent
- &rest keep)
- "Extract entry text from MARKER, at most N-LINES lines.
- This will ignore drawers etc, just get the text.
- If INDENT is given, prefix every line with this string. If KEEP is
- given, it is a list of symbols, defining stuff that should not be
- removed from the entry content. Currently only `planning' is allowed here."
- (let (txt drawer-re kwd-time-re ind)
- (save-excursion
- (with-current-buffer (marker-buffer marker)
- (if (not (derived-mode-p 'org-mode))
- (setq txt "")
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (end-of-line 1)
- (setq txt (buffer-substring
- (min (1+ (point)) (point-max))
- (progn (outline-next-heading) (point)))
- drawer-re org-drawer-regexp
- kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp
- ".*\n?"))
- (with-temp-buffer
- (insert txt)
- (when org-agenda-add-entry-text-descriptive-links
- (goto-char (point-min))
- (while (org-activate-bracket-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
- (goto-char (point-min))
- (while (re-search-forward org-bracket-link-regexp (point-max) t)
- (set-text-properties (match-beginning 0) (match-end 0)
- nil))
- (goto-char (point-min))
- (while (re-search-forward drawer-re nil t)
- (delete-region
- (match-beginning 0)
- (progn (re-search-forward
- "^[ \t]*:END:.*\n?" nil 'move)
- (point))))
- (unless (member 'planning keep)
- (goto-char (point-min))
- (while (re-search-forward kwd-time-re nil t)
- (replace-match "")))
- (goto-char (point-min))
- (when org-agenda-entry-text-exclude-regexps
- (let ((re-list org-agenda-entry-text-exclude-regexps) re)
- (while (setq re (pop re-list))
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (replace-match "")))))
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (if (looking-at "[ \t\n]+\\'") (replace-match ""))
- ;; find and remove min common indentation
- (goto-char (point-min))
- (untabify (point-min) (point-max))
- (setq ind (org-get-indentation))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (setq ind (min ind (org-get-indentation))))
- (beginning-of-line 2))
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (move-to-column ind)
- (delete-region (point-at-bol) (point)))
- (beginning-of-line 2))
- (run-hooks 'org-agenda-entry-text-cleanup-hook)
- (goto-char (point-min))
- (when indent
- (while (and (not (eobp)) (re-search-forward "^" nil t))
- (replace-match indent t t)))
- (goto-char (point-min))
- (while (looking-at "[ \t]*\n") (replace-match ""))
- (goto-char (point-max))
- (when (> (org-current-line)
- n-lines)
- (org-goto-line (1+ n-lines))
- (backward-char 1))
- (setq txt (buffer-substring (point-min) (point)))))))))
- txt))
- (defun org-check-for-org-mode ()
- "Make sure current buffer is in org-mode. Error if not."
- (or (derived-mode-p 'org-mode)
- (error "Cannot execute org-mode agenda command on buffer in %s"
- major-mode)))
- ;;; Agenda prepare and finalize
- (defvar org-agenda-multi nil) ; dynamically scoped
- (defvar org-agenda-pre-window-conf nil)
- (defvar org-agenda-columns-active nil)
- (defvar org-agenda-name nil)
- (defvar org-agenda-tag-filter nil)
- (defvar org-agenda-category-filter nil)
- (defvar org-agenda-regexp-filter nil)
- (defvar org-agenda-top-headline-filter nil)
- (defvar org-agenda-tag-filter-while-redo nil)
- (defvar org-agenda-tag-filter-preset nil
- "A preset of the tags filter used for secondary agenda filtering.
- This must be a list of strings, each string must be a single tag preceded
- by \"+\" or \"-\".
- This variable should not be set directly, but agenda custom commands can
- bind it in the options section. The preset filter is a global property of
- the entire agenda view. In a block agenda, it will not work reliably to
- define a filter for one of the individual blocks. You need to set it in
- the global options and expect it to be applied to the entire view.")
- (defvar org-agenda-category-filter-preset nil
- "A preset of the category filter used for secondary agenda filtering.
- This must be a list of strings, each string must be a single category
- preceded by \"+\" or \"-\".
- This variable should not be set directly, but agenda custom commands can
- bind it in the options section. The preset filter is a global property of
- the entire agenda view. In a block agenda, it will not work reliably to
- define a filter for one of the individual blocks. You need to set it in
- the global options and expect it to be applied to the entire view.")
- (defvar org-agenda-regexp-filter-preset nil
- "A preset of the regexp filter used for secondary agenda filtering.
- This must be a list of strings, each string must be a single category
- preceded by \"+\" or \"-\".
- This variable should not be set directly, but agenda custom commands can
- bind it in the options section. The preset filter is a global property of
- the entire agenda view. In a block agenda, it will not work reliably to
- define a filter for one of the individual blocks. You need to set it in
- the global options and expect it to be applied to the entire view.")
- (defun org-agenda-use-sticky-p ()
- "Return non-nil if an agenda buffer named
- `org-agenda-buffer-name' exists and should be shown instead of
- generating a new one."
- (and
- ;; turned off by user
- org-agenda-sticky
- ;; For multi-agenda buffer already exists
- (not org-agenda-multi)
- ;; buffer found
- (get-buffer org-agenda-buffer-name)
- ;; C-u parameter is same as last call
- (with-current-buffer (get-buffer org-agenda-buffer-name)
- (and
- (equal current-prefix-arg
- org-agenda-last-prefix-arg)
- ;; In case user turned stickiness on, while having existing
- ;; Agenda buffer active, don't reuse that buffer, because it
- ;; does not have org variables local
- org-agenda-this-buffer-is-sticky))))
- (defun org-agenda-prepare-window (abuf)
- "Setup agenda buffer in the window."
- (let* ((awin (get-buffer-window abuf))
- wconf)
- (cond
- ((equal (current-buffer) abuf) nil)
- (awin (select-window awin))
- ((not (setq wconf (current-window-configuration))))
- ((equal org-agenda-window-setup 'current-window)
- (org-pop-to-buffer-same-window abuf))
- ((equal org-agenda-window-setup 'other-window)
- (org-switch-to-buffer-other-window abuf))
- ((equal org-agenda-window-setup 'other-frame)
- (switch-to-buffer-other-frame abuf))
- ((equal org-agenda-window-setup 'reorganize-frame)
- (delete-other-windows)
- (org-switch-to-buffer-other-window abuf)))
- ;; additional test in case agenda is invoked from within agenda
- ;; buffer via elisp link
- (unless (equal (current-buffer) abuf)
- (org-pop-to-buffer-same-window abuf))
- (setq org-agenda-pre-window-conf
- (or org-agenda-pre-window-conf wconf))))
- (defun org-agenda-prepare (&optional name)
- (if (org-agenda-use-sticky-p)
- (progn
- ;; Popup existing buffer
- (org-agenda-prepare-window (get-buffer org-agenda-buffer-name))
- (message "Sticky Agenda buffer, use `r' to refresh")
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
- (setq org-todo-keywords-for-agenda nil)
- (setq org-drawers-for-agenda nil)
- (unless org-agenda-persistent-filter
- (setq org-agenda-tag-filter nil
- org-agenda-category-filter nil
- org-agenda-regexp-filter nil))
- (put 'org-agenda-tag-filter :preset-filter
- org-agenda-tag-filter-preset)
- (put 'org-agenda-category-filter :preset-filter
- org-agenda-category-filter-preset)
- (put 'org-agenda-regexp-filter :preset-filter
- org-agenda-regexp-filter-preset)
- (if org-agenda-multi
- (progn
- (setq buffer-read-only nil)
- (goto-char (point-max))
- (unless (or (bobp) org-agenda-compact-blocks
- (not org-agenda-block-separator))
- (insert "\n"
- (if (stringp org-agenda-block-separator)
- org-agenda-block-separator
- (make-string (window-width) org-agenda-block-separator))
- "\n"))
- (narrow-to-region (point) (point-max)))
- (setq org-done-keywords-for-agenda nil)
- ;; Setting any org variables that are in org-agenda-local-vars
- ;; list need to be done after the prepare call
- (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name))
- (setq buffer-read-only nil)
- (org-agenda-reset-markers)
- (let ((inhibit-read-only t)) (erase-buffer))
- (org-agenda-mode)
- (setq org-agenda-buffer (current-buffer))
- (setq org-agenda-contributing-files nil)
- (setq org-agenda-columns-active nil)
- (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
- (setq org-todo-keywords-for-agenda
- (org-uniquify org-todo-keywords-for-agenda))
- (setq org-done-keywords-for-agenda
- (org-uniquify org-done-keywords-for-agenda))
- (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda))
- (setq org-agenda-last-prefix-arg current-prefix-arg)
- (setq org-agenda-this-buffer-name org-agenda-buffer-name)
- (and name (not org-agenda-name)
- (org-set-local 'org-agenda-name name)))
- (setq buffer-read-only nil)))
- (defvar org-agenda-overriding-columns-format) ; From org-colview.el
- (defun org-agenda-finalize ()
- "Finishing touch for the agenda buffer, called just before displaying it."
- (unless org-agenda-multi
- (save-excursion
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (save-excursion
- (while (org-activate-bracket-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
- (save-excursion
- (while (org-activate-plain-links (point-max))
- (add-text-properties (match-beginning 0) (match-end 0)
- '(face org-link))))
- (unless (eq org-agenda-remove-tags t)
- (org-agenda-align-tags))
- (unless org-agenda-with-colors
- (remove-text-properties (point-min) (point-max) '(face nil)))
- (if (and (boundp 'org-agenda-overriding-columns-format)
- org-agenda-overriding-columns-format)
- (org-set-local 'org-agenda-overriding-columns-format
- org-agenda-overriding-columns-format))
- (if (and (boundp 'org-agenda-view-columns-initially)
- org-agenda-view-columns-initially)
- (org-agenda-columns))
- (when org-agenda-fontify-priorities
- (org-agenda-fontify-priorities))
- (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
- (org-agenda-dim-blocked-tasks))
- ;; We need to widen when `org-agenda-finalize' is called from
- ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in')
- (when org-clock-current-task
- (save-restriction
- (widen)
- (org-agenda-mark-clocking-task)))
- (when org-agenda-entry-text-mode
- (org-agenda-entry-text-hide)
- (org-agenda-entry-text-show))
- (if (and (functionp 'org-habit-insert-consistency-graphs)
- (save-excursion (next-single-property-change (point-min) 'org-habit-p)))
- (org-habit-insert-consistency-graphs))
- (setq org-agenda-type (org-get-at-bol 'org-agenda-type))
- (unless (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq org-agenda-type org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (and (listp org-agenda-use-tag-inheritance)
- (not (memq org-agenda-type
- org-agenda-use-tag-inheritance))))))
- (let (mrk)
- (save-excursion
- (goto-char (point-min))
- (while (equal (forward-line) 0)
- (when (setq mrk (or (get-text-property (point) 'org-hd-marker)
- (get-text-property (point) 'org-hd-marker)))
- (put-text-property (point-at-bol) (point-at-eol)
- 'tags (org-with-point-at mrk
- (delete-dups
- (mapcar 'downcase (org-get-tags-at))))))))))
- (run-hooks 'org-agenda-finalize-hook)
- (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
- (org-agenda-filter-apply org-agenda-category-filter 'category))
- (when (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter))
- (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
- (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local)))))
- (defun org-agenda-mark-clocking-task ()
- "Mark the current clock entry in the agenda if it is present."
- (org-agenda-unmark-clocking-task)
- (when (marker-buffer org-clock-hd-marker)
- (save-excursion
- (goto-char (point-min))
- (let (s ov)
- (while (setq s (next-single-property-change (point) 'org-hd-marker))
- (goto-char s)
- (when (equal (org-get-at-bol 'org-hd-marker)
- org-clock-hd-marker)
- (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol))))
- (overlay-put ov 'type 'org-agenda-clocking)
- (overlay-put ov 'face 'org-agenda-clocking)
- (overlay-put ov 'help-echo
- "The clock is running in this item")))))))
- (defun org-agenda-unmark-clocking-task ()
- "Unmark the current clocking task."
- (mapc (lambda (o)
- (if (eq (overlay-get o 'type) 'org-agenda-clocking)
- (delete-overlay o)))
- (overlays-in (point-min) (point-max))))
- (defun org-agenda-fontify-priorities ()
- "Make highest priority lines bold, and lowest italic."
- (interactive)
- (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority)
- (delete-overlay o)))
- (overlays-in (point-min) (point-max)))
- (save-excursion
- (let (b e p ov h l)
- (goto-char (point-min))
- (while (re-search-forward "\\[#\\(.\\)\\]" nil t)
- (setq h (or (get-char-property (point) 'org-highest-priority)
- org-highest-priority)
- l (or (get-char-property (point) 'org-lowest-priority)
- org-lowest-priority)
- p (string-to-char (match-string 1))
- b (match-beginning 0)
- e (if (eq org-agenda-fontify-priorities 'cookies)
- (match-end 0)
- (point-at-eol))
- ov (make-overlay b e))
- (overlay-put
- ov 'face
- (cons (cond ((org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-priority-faces))))
- ((and (listp org-agenda-fontify-priorities)
- (org-face-from-face-or-color
- 'priority nil
- (cdr (assoc p org-agenda-fontify-priorities)))))
- ((equal p l) 'italic)
- ((equal p h) 'bold))
- 'org-priority))
- (overlay-put ov 'org-type 'org-priority)))))
- (defvar org-depend-tag-blocked)
- (defun org-agenda-dim-blocked-tasks (&optional invisible)
- "Dim currently blocked TODO's in the agenda display.
- When INVISIBLE is non-nil, hide currently blocked TODO instead of
- dimming them."
- (interactive "P")
- (when (org-called-interactively-p 'interactive)
- (message "Dim or hide blocked tasks..."))
- (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo)
- (delete-overlay o)))
- (overlays-in (point-min) (point-max)))
- (save-excursion
- (let ((inhibit-read-only t)
- (org-depend-tag-blocked nil)
- (invis (or (not (null invisible))
- (eq org-agenda-dim-blocked-tasks 'invisible)))
- org-blocked-by-checkboxes
- invis1 b e p ov h l)
- (goto-char (point-min))
- (while (let ((pos (next-single-property-change (point) 'todo-state)))
- (and pos (goto-char (1+ pos))))
- (setq org-blocked-by-checkboxes nil invis1 invis)
- (let ((marker (org-get-at-bol 'org-hd-marker)))
- (when (and marker
- (with-current-buffer (marker-buffer marker)
- (save-excursion (goto-char marker)
- (org-entry-blocked-p))))
- (if org-blocked-by-checkboxes (setq invis1 nil))
- (setq b (if invis1
- (max (point-min) (1- (point-at-bol)))
- (point-at-bol))
- e (point-at-eol)
- ov (make-overlay b e))
- (if invis1
- (overlay-put ov 'invisible t)
- (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
- (overlay-put ov 'org-type 'org-blocked-todo))))))
- (when (org-called-interactively-p 'interactive)
- (message "Dim or hide blocked tasks...done")))
- (defvar org-agenda-skip-function nil
- "Function to be called at each match during agenda construction.
- If this function returns nil, the current match should not be skipped.
- Otherwise, the function must return a position from where the search
- should be continued.
- This may also be a Lisp form, it will be evaluated.
- Never set this variable using `setq' or so, because then it will apply
- to all future agenda commands. If you do want a global skipping condition,
- use the option `org-agenda-skip-function-global' instead.
- The correct usage for `org-agenda-skip-function' is to bind it with
- `let' to scope it dynamically into the agenda-constructing command.
- A good way to set it is through options in `org-agenda-custom-commands'.")
- (defun org-agenda-skip ()
- "Throw to `:skip' in places that should be skipped.
- Also moves point to the end of the skipped region, so that search can
- continue from there."
- (let ((p (point-at-bol)) to)
- (when (or
- (save-excursion (goto-char p) (looking-at comment-start-skip))
- (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
- (get-text-property p :org-archived)
- (org-end-of-subtree t))
- (and org-agenda-skip-comment-trees
- (get-text-property p :org-comment)
- (org-end-of-subtree t))
- (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global)
- (org-agenda-skip-eval org-agenda-skip-function)))
- (goto-char to))
- (org-in-src-block-p t))
- (throw :skip t))))
- (defun org-agenda-skip-eval (form)
- "If FORM is a function or a list, call (or eval) it and return the result.
- `save-excursion' and `save-match-data' are wrapped around the call, so point
- and match data are returned to the previous state no matter what these
- functions do."
- (let (fp)
- (and form
- (or (setq fp (functionp form))
- (consp form))
- (save-excursion
- (save-match-data
- (if fp
- (funcall form)
- (eval form)))))))
- (defvar org-agenda-markers nil
- "List of all currently active markers created by `org-agenda'.")
- (defvar org-agenda-last-marker-time (org-float-time)
- "Creation time of the last agenda marker.")
- (defun org-agenda-new-marker (&optional pos)
- "Return a new agenda marker.
- Org-mode keeps a list of these markers and resets them when they are
- no longer in use."
- (let ((m (copy-marker (or pos (point)))))
- (setq org-agenda-last-marker-time (org-float-time))
- (if org-agenda-buffer
- (with-current-buffer org-agenda-buffer
- (push m org-agenda-markers))
- (push m org-agenda-markers))
- m))
- (defun org-agenda-reset-markers ()
- "Reset markers created by `org-agenda'."
- (while org-agenda-markers
- (move-marker (pop org-agenda-markers) nil)))
- (defun org-agenda-save-markers-for-cut-and-paste (beg end)
- "Save relative positions of markers in region.
- This check for agenda markers in all agenda buffers currently active."
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (eq major-mode 'org-agenda-mode)
- (mapc (lambda (m) (org-check-and-save-marker m beg end))
- org-agenda-markers)))))
- ;;; Entry text mode
- (defun org-agenda-entry-text-show-here ()
- "Add some text from the entry as context to the current line."
- (let (m txt o)
- (setq m (org-get-at-bol 'org-hd-marker))
- (unless (marker-buffer m)
- (error "No marker points to an entry here"))
- (setq txt (concat "\n" (org-no-properties
- (org-agenda-get-some-entry-text
- m org-agenda-entry-text-maxlines
- org-agenda-entry-text-leaders))))
- (when (string-match "\\S-" txt)
- (setq o (make-overlay (point-at-bol) (point-at-eol)))
- (overlay-put o 'evaporate t)
- (overlay-put o 'org-overlay-type 'agenda-entry-content)
- (overlay-put o 'after-string txt))))
- (defun org-agenda-entry-text-show ()
- "Add entry context for all agenda lines."
- (interactive)
- (save-excursion
- (goto-char (point-max))
- (beginning-of-line 1)
- (while (not (bobp))
- (when (org-get-at-bol 'org-hd-marker)
- (org-agenda-entry-text-show-here))
- (beginning-of-line 0))))
- (defun org-agenda-entry-text-hide ()
- "Remove any shown entry context."
- (delq nil
- (mapcar (lambda (o)
- (if (eq (overlay-get o 'org-overlay-type)
- 'agenda-entry-content)
- (progn (delete-overlay o) t)))
- (overlays-in (point-min) (point-max)))))
- (defun org-agenda-get-day-face (date)
- "Return the face DATE should be displayed with."
- (or (and (functionp org-agenda-day-face-function)
- (funcall org-agenda-day-face-function date))
- (cond ((org-agenda-todayp date)
- 'org-agenda-date-today)
- ((member (calendar-day-of-week date) org-agenda-weekend-days)
- 'org-agenda-date-weekend)
- (t 'org-agenda-date))))
- ;;; Agenda timeline
- (defvar org-agenda-only-exact-dates nil) ; dynamically scoped
- (defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list'
- (defun org-timeline (&optional dotodo)
- "Show a time-sorted view of the entries in the current org file.
- Only entries with a time stamp of today or later will be listed. With
- \\[universal-argument] prefix, all unfinished TODO items will also be shown,
- under the current date.
- If the buffer contains an active region, only check the region for
- dates."
- (interactive "P")
- (let* ((dopast t)
- (org-agenda-show-log-scoped org-agenda-show-log)
- (org-agenda-show-log org-agenda-show-log-scoped)
- (entry (buffer-file-name (or (buffer-base-buffer (current-buffer))
- (current-buffer))))
- (date (calendar-current-date))
- (beg (if (org-region-active-p) (region-beginning) (point-min)))
- (end (if (org-region-active-p) (region-end) (point-max)))
- (day-numbers (org-get-all-dates
- beg end 'no-ranges
- t org-agenda-show-log-scoped ; always include today
- org-timeline-show-empty-dates))
- (org-deadline-warning-days 0)
- (org-agenda-only-exact-dates t)
- (today (org-today))
- (past t)
- args
- s e rtn d emptyp)
- (setq org-agenda-redo-command
- (list 'let
- (list (list 'org-agenda-show-log 'org-agenda-show-log))
- (list 'org-switch-to-buffer-other-window (current-buffer))
- (list 'org-timeline (list 'quote dotodo))))
- (put 'org-agenda-redo-command 'org-lprops nil)
- (if (not dopast)
- ;; Remove past dates from the list of dates.
- (setq day-numbers (delq nil (mapcar (lambda(x)
- (if (>= x today) x nil))
- day-numbers))))
- (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry)))
- (org-compile-prefix-format 'timeline)
- (org-set-sorting-strategy 'timeline)
- (if org-agenda-show-log-scoped (push :closed args))
- (push :timestamp args)
- (push :deadline args)
- (push :scheduled args)
- (push :sexp args)
- (if dotodo (push :todo args))
- (insert "Timeline of file " entry "\n")
- (add-text-properties (point-min) (point)
- (list 'face 'org-agenda-structure))
- (org-agenda-mark-header-line (point-min))
- (while (setq d (pop day-numbers))
- (if (and (listp d) (eq (car d) :omitted))
- (progn
- (setq s (point))
- (insert (format "\n[... %d empty days omitted]\n\n" (cdr d)))
- (put-text-property s (1- (point)) 'face 'org-agenda-structure))
- (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil))
- (if (and (>= d today)
- dopast
- past)
- (progn
- (setq past nil)
- (insert (make-string 79 ?-) "\n")))
- (setq date (calendar-gregorian-from-absolute d))
- (setq s (point))
- (setq rtn (and (not emptyp)
- (apply 'org-agenda-get-day-entries entry
- date args)))
- (if (or rtn (equal d today) org-timeline-show-empty-dates)
- (progn
- (insert
- (if (stringp org-agenda-format-date)
- (format-time-string org-agenda-format-date
- (org-time-from-absolute date))
- (funcall org-agenda-format-date date))
- "\n")
- (put-text-property s (1- (point)) 'face
- (org-agenda-get-day-face date))
- (put-text-property s (1- (point)) 'org-date-line t)
- (put-text-property s (1- (point)) 'org-agenda-date-header t)
- (if (equal d today)
- (put-text-property s (1- (point)) 'org-today t))
- (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n"))
- (put-text-property s (1- (point)) 'day d)))))
- (goto-char (or (text-property-any (point-min) (point-max) 'org-today t)
- (point-min)))
- (add-text-properties
- (point-min) (point-max)
- `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command))
- (org-agenda-finalize)
- (setq buffer-read-only t)))
- (defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re)
- "Return a list of all relevant day numbers from BEG to END buffer positions.
- If NO-RANGES is non-nil, include only the start and end dates of a range,
- not every single day in the range. If FORCE-TODAY is non-nil, make
- sure that TODAY is included in the list. If INACTIVE is non-nil, also
- inactive time stamps (those in square brackets) are included.
- When EMPTY is non-nil, also include days without any entries."
- (let ((re (concat
- (if pre-re pre-re "")
- (if inactive org-ts-regexp-both org-ts-regexp)))
- dates dates1 date day day1 day2 ts1 ts2 pos)
- (if force-today
- (setq dates (list (org-today))))
- (save-excursion
- (goto-char beg)
- (while (re-search-forward re end t)
- (setq day (time-to-days (org-time-string-to-time
- (substring (match-string 1) 0 10)
- (current-buffer) (match-beginning 0))))
- (or (memq day dates) (push day dates)))
- (unless no-ranges
- (goto-char beg)
- (while (re-search-forward org-tr-regexp end t)
- (setq pos (match-beginning 0))
- (setq ts1 (substring (match-string 1) 0 10)
- ts2 (substring (match-string 2) 0 10)
- day1 (time-to-days (org-time-string-to-time
- ts1 (current-buffer) pos))
- day2 (time-to-days (org-time-string-to-time
- ts2 (current-buffer) pos)))
- (while (< (setq day1 (1+ day1)) day2)
- (or (memq day1 dates) (push day1 dates)))))
- (setq dates (sort dates '<))
- (when empty
- (while (setq day (pop dates))
- (setq day2 (car dates))
- (push day dates1)
- (when (and day2 empty)
- (if (or (eq empty t)
- (and (numberp empty) (<= (- day2 day) empty)))
- (while (< (setq day (1+ day)) day2)
- (push (list day) dates1))
- (push (cons :omitted (- day2 day)) dates1))))
- (setq dates (nreverse dates1)))
- dates)))
- ;;; Agenda Daily/Weekly
- (defvar org-agenda-start-day nil ; dynamically scoped parameter
- "Start day for the agenda view.
- Custom commands can set this variable in the options section.
- This is usually a string like \"2007-11-01\", \"+2d\" or any other
- input allowed when reading a date through the Org calendar.
- See the docstring of `org-read-date' for details.")
- (defvar org-starting-day nil) ; local variable in the agenda buffer
- (defvar org-arg-loc nil) ; local variable
- (defvar org-agenda-buffer-tmp-name nil)
- ;;;###autoload
- (defun org-agenda-list (&optional arg start-day span with-hour)
- "Produce a daily/weekly view from all files in variable `org-agenda-files'.
- The view will be for the current day or week, but from the overview buffer
- you will be able to go to other days/weeks.
- With a numeric prefix argument in an interactive call, the agenda will
- span ARG days. Lisp programs should instead specify SPAN to change
- the number of days. SPAN defaults to `org-agenda-span'.
- START-DAY defaults to TODAY, or to the most recent match for the weekday
- given in `org-agenda-start-on-weekday'.
- When WITH-HOUR is non-nil, only include scheduled and deadline
- items if they have an hour specification like [h]h:mm."
- (interactive "P")
- (if org-agenda-overriding-arguments
- (setq arg (car org-agenda-overriding-arguments)
- start-day (nth 1 org-agenda-overriding-arguments)
- span (nth 2 org-agenda-overriding-arguments)))
- (if (and (integerp arg) (> arg 0))
- (setq span arg arg nil))
- (catch 'exit
- (setq org-agenda-buffer-name
- (or org-agenda-buffer-tmp-name
- (if org-agenda-sticky
- (cond ((and org-keys (stringp org-match))
- (format "*Org Agenda(%s:%s)*" org-keys org-match))
- (org-keys
- (format "*Org Agenda(%s)*" org-keys))
- (t "*Org Agenda(a)*")))
- org-agenda-buffer-name))
- (org-agenda-prepare "Day/Week")
- (setq start-day (or start-day org-agenda-start-day))
- (if (stringp start-day)
- ;; Convert to an absolute day number
- (setq start-day (time-to-days (org-read-date nil t start-day))))
- (org-compile-prefix-format 'agenda)
- (org-set-sorting-strategy 'agenda)
- (let* ((span (org-agenda-ndays-to-span
- (or span org-agenda-ndays org-agenda-span)))
- (today (org-today))
- (sd (or start-day today))
- (ndays (org-agenda-span-to-ndays span sd))
- (org-agenda-start-on-weekday
- (if (or (eq ndays 7) (eq ndays 14))
- org-agenda-start-on-weekday))
- (thefiles (org-agenda-files nil 'ifmode))
- (files thefiles)
- (start (if (or (null org-agenda-start-on-weekday)
- (< ndays 7))
- sd
- (let* ((nt (calendar-day-of-week
- (calendar-gregorian-from-absolute sd)))
- (n1 org-agenda-start-on-weekday)
- (d (- nt n1)))
- (- sd (+ (if (< d 0) 7 0) d)))))
- (day-numbers (list start))
- (day-cnt 0)
- (inhibit-redisplay (not debug-on-error))
- (org-agenda-show-log-scoped org-agenda-show-log)
- s e rtn rtnall file date d start-pos end-pos todayp
- clocktable-start clocktable-end filter)
- (setq org-agenda-redo-command
- (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour))
- (dotimes (n (1- ndays))
- (push (1+ (car day-numbers)) day-numbers))
- (setq day-numbers (nreverse day-numbers))
- (setq clocktable-start (car day-numbers)
- clocktable-end (1+ (or (org-last day-numbers) 0)))
- (org-set-local 'org-starting-day (car day-numbers))
- (org-set-local 'org-arg-loc arg)
- (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span))
- (unless org-agenda-compact-blocks
- (let* ((d1 (car day-numbers))
- (d2 (org-last day-numbers))
- (w1 (org-days-to-iso-week d1))
- (w2 (org-days-to-iso-week d2)))
- (setq s (point))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert (org-agenda-span-name span)
- "-agenda"
- (if (< (- d2 d1) 350)
- (if (= w1 w2)
- (format " (W%02d)" w1)
- (format " (W%02d-W%02d)" w1 w2))
- "")
- ":\n")))
- (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure
- 'org-date-line t))
- (org-agenda-mark-header-line s))
- (while (setq d (pop day-numbers))
- (setq date (calendar-gregorian-from-absolute d)
- s (point))
- (if (or (setq todayp (= d today))
- (and (not start-pos) (= d sd)))
- (setq start-pos (point))
- (if (and start-pos (not end-pos))
- (setq end-pos (point))))
- (setq files thefiles
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (let ((org-agenda-entry-types org-agenda-entry-types))
- ;; Starred types override non-starred equivalents
- (when (member :deadline* org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :deadline org-agenda-entry-types)))
- (when (member :scheduled* org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :scheduled org-agenda-entry-types)))
- ;; Honor with-hour
- (when with-hour
- (when (member :deadline org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :deadline org-agenda-entry-types))
- (push :deadline* org-agenda-entry-types))
- (when (member :scheduled org-agenda-entry-types)
- (setq org-agenda-entry-types
- (delq :scheduled org-agenda-entry-types))
- (push :scheduled* org-agenda-entry-types)))
- (unless org-agenda-include-deadlines
- (setq org-agenda-entry-types
- (delq :deadline* (delq :deadline org-agenda-entry-types))))
- (cond
- ((memq org-agenda-show-log-scoped '(only clockcheck))
- (setq rtn (org-agenda-get-day-entries
- file date :closed)))
- (org-agenda-show-log-scoped
- (setq rtn (apply 'org-agenda-get-day-entries
- file date
- (append '(:closed) org-agenda-entry-types))))
- (t
- (setq rtn (apply 'org-agenda-get-day-entries
- file date
- org-agenda-entry-types)))))
- (setq rtnall (append rtnall rtn)))) ;; all entries
- (if org-agenda-include-diary
- (let ((org-agenda-search-headline-for-time t))
- (require 'diary-lib)
- (setq rtn (org-get-entries-from-diary date))
- (setq rtnall (append rtnall rtn))))
- (if (or rtnall org-agenda-show-all-dates)
- (progn
- (setq day-cnt (1+ day-cnt))
- (insert
- (if (stringp org-agenda-format-date)
- (format-time-string org-agenda-format-date
- (org-time-from-absolute date))
- (funcall org-agenda-format-date date))
- "\n")
- (put-text-property s (1- (point)) 'face
- (org-agenda-get-day-face date))
- (put-text-property s (1- (point)) 'org-date-line t)
- (put-text-property s (1- (point)) 'org-agenda-date-header t)
- (put-text-property s (1- (point)) 'org-day-cnt day-cnt)
- (when todayp
- (put-text-property s (1- (point)) 'org-today t))
- (setq rtnall
- (org-agenda-add-time-grid-maybe rtnall ndays todayp))
- (if rtnall (insert ;; all entries
- (org-agenda-finalize-entries rtnall 'agenda)
- "\n"))
- (put-text-property s (1- (point)) 'day d)
- (put-text-property s (1- (point)) 'org-day-cnt day-cnt))))
- (when (and org-agenda-clockreport-mode clocktable-start)
- (let ((org-agenda-files (org-agenda-files nil 'ifmode))
- ;; the above line is to ensure the restricted range!
- (p (copy-sequence org-agenda-clockreport-parameter-plist))
- tbl)
- (setq p (org-plist-delete p :block))
- (setq p (plist-put p :tstart clocktable-start))
- (setq p (plist-put p :tend clocktable-end))
- (setq p (plist-put p :scope 'agenda))
- (when (and (eq org-agenda-clockreport-mode 'with-filter)
- (setq filter (or org-agenda-tag-filter-while-redo
- (get 'org-agenda-tag-filter :preset-filter))))
- (setq p (plist-put p :tags (mapconcat (lambda (x)
- (if (string-match "[<>=]" x)
- ""
- x))
- filter ""))))
- (setq tbl (apply 'org-clock-get-clocktable p))
- (insert tbl)))
- (goto-char (point-min))
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (unless (and (pos-visible-in-window-p (point-min))
- (pos-visible-in-window-p (point-max)))
- (goto-char (1- (point-max)))
- (recenter -1)
- (if (not (pos-visible-in-window-p (or start-pos 1)))
- (progn
- (goto-char (or start-pos 1))
- (recenter 1))))
- (goto-char (or start-pos 1))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type agenda
- org-last-args (,arg ,start-day ,span)
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
- (if (eq org-agenda-show-log-scoped 'clockcheck)
- (org-agenda-show-clocking-issues))
- (org-agenda-finalize)
- (setq buffer-read-only t)
- (message ""))))
- (defun org-agenda-ndays-to-span (n)
- "Return a span symbol for a span of N days, or N if none matches."
- (cond ((symbolp n) n)
- ((= n 1) 'day)
- ((= n 7) 'week)
- ((= n 14) 'fortnight)
- (t n)))
- (defun org-agenda-span-to-ndays (span &optional start-day)
- "Return ndays from SPAN, possibly starting at START-DAY.
- START-DAY is an absolute time value."
- (cond ((numberp span) span)
- ((eq span 'day) 1)
- ((eq span 'week) 7)
- ((eq span 'fortnight) 14)
- ((eq span 'month)
- (let ((date (calendar-gregorian-from-absolute start-day)))
- (calendar-last-day-of-month (car date) (caddr date))))
- ((eq span 'year)
- (let ((date (calendar-gregorian-from-absolute start-day)))
- (if (calendar-leap-year-p (caddr date)) 366 365)))))
- (defun org-agenda-span-name (span)
- "Return a SPAN name."
- (if (null span)
- ""
- (if (symbolp span)
- (capitalize (symbol-name span))
- (format "%d days" span))))
- ;;; Agenda word search
- (defvar org-agenda-search-history nil)
- (defvar org-search-syntax-table nil
- "Special syntax table for org-mode search.
- In this table, we have single quotes not as word constituents, to
- that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"")
- (defvar org-mode-syntax-table) ; From org.el
- (defun org-search-syntax-table ()
- (unless org-search-syntax-table
- (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table))
- (modify-syntax-entry ?' "." org-search-syntax-table)
- (modify-syntax-entry ?` "." org-search-syntax-table))
- org-search-syntax-table)
- (defvar org-agenda-last-search-view-search-was-boolean nil)
- ;;;###autoload
- (defun org-search-view (&optional todo-only string edit-at)
- "Show all entries that contain a phrase or words or regular expressions.
- With optional prefix argument TODO-ONLY, only consider entries that are
- TODO entries. The argument STRING can be used to pass a default search
- string into this function. If EDIT-AT is non-nil, it means that the
- user should get a chance to edit this string, with cursor at position
- EDIT-AT.
- The search string can be viewed either as a phrase that should be found as
- is, or it can be broken into a number of snippets, each of which must match
- in a Boolean way to select an entry. The default depends on the variable
- `org-agenda-search-view-always-boolean'.
- Even if this is turned off (the default) you can always switch to
- Boolean search dynamically by preceding the first word with \"+\" or \"-\".
- The default is a direct search of the whole phrase, where each space in
- the search string can expand to an arbitrary amount of whitespace,
- including newlines.
- If using a Boolean search, the search string is split on whitespace and
- each snippet is searched separately, with logical AND to select an entry.
- Words prefixed with a minus must *not* occur in the entry. Words without
- a prefix or prefixed with a plus must occur in the entry. Matching is
- case-insensitive. Words are enclosed by word delimiters (i.e. they must
- match whole words, not parts of a word) if
- `org-agenda-search-view-force-full-words' is set (default is nil).
- Boolean search snippets enclosed by curly braces are interpreted as
- regular expressions that must or (when preceded with \"-\") must not
- match in the entry. Snippets enclosed into double quotes will be taken
- as a whole, to include whitespace.
- - If the search string starts with an asterisk, search only in headlines.
- - If (possibly after the leading star) the search string starts with an
- exclamation mark, this also means to look at TODO entries only, an effect
- that can also be achieved with a prefix argument.
- - If (possibly after star and exclamation mark) the search string starts
- with a colon, this will mean that the (non-regexp) snippets of the
- Boolean search must match as full words.
- This command searches the agenda files, and in addition the files listed
- in `org-agenda-text-search-extra-files'."
- (interactive "P")
- (if org-agenda-overriding-arguments
- (setq todo-only (car org-agenda-overriding-arguments)
- string (nth 1 org-agenda-overriding-arguments)
- edit-at (nth 2 org-agenda-overriding-arguments)))
- (let* ((props (list 'face nil
- 'done-face 'org-agenda-done
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo (format "mouse-2 or RET jump to location")))
- (full-words org-agenda-search-view-force-full-words)
- (org-agenda-text-search-extra-files org-agenda-text-search-extra-files)
- regexp rtn rtnall files file pos inherited-tags
- marker category category-pos level tags c neg re boolean
- ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str)
- (unless (and (not edit-at)
- (stringp string)
- (string-match "\\S-" string))
- (setq string (read-string
- (if org-agenda-search-view-always-boolean
- "[+-]Word/{Regexp} ...: "
- "Phrase or [+-]Word/{Regexp} ...: ")
- (cond
- ((integerp edit-at) (cons string edit-at))
- (edit-at string))
- 'org-agenda-search-history)))
- (catch 'exit
- (if org-agenda-sticky
- (setq org-agenda-buffer-name
- (if (stringp string)
- (format "*Org Agenda(%s:%s)*"
- (or org-keys (or (and todo-only "S") "s")) string)
- (format "*Org Agenda(%s)*" (or (and todo-only "S") "s")))))
- (org-agenda-prepare "SEARCH")
- (org-compile-prefix-format 'search)
- (org-set-sorting-strategy 'search)
- (setq org-agenda-redo-command
- (list 'org-search-view (if todo-only t nil)
- (list 'if 'current-prefix-arg nil string)))
- (setq org-agenda-query-string string)
- (if (equal (string-to-char string) ?*)
- (setq hdl-only t
- words (substring string 1))
- (setq words string))
- (when (equal (string-to-char words) ?!)
- (setq todo-only t
- words (substring words 1)))
- (when (equal (string-to-char words) ?:)
- (setq full-words t
- words (substring words 1)))
- (if (or org-agenda-search-view-always-boolean
- (member (string-to-char words) '(?- ?+ ?\{)))
- (setq boolean t))
- (setq words (org-split-string words))
- (let (www w)
- (while (setq w (pop words))
- (while (and (string-match "\\\\\\'" w) words)
- (setq w (concat (substring w 0 -1) " " (pop words))))
- (push w www))
- (setq words (nreverse www) www nil)
- (while (setq w (pop words))
- (when (and (string-match "\\`[-+]?{" w)
- (not (string-match "}\\'" w)))
- (while (and words (not (string-match "}\\'" (car words))))
- (setq w (concat w " " (pop words))))
- (setq w (concat w " " (pop words))))
- (push w www))
- (setq words (nreverse www)))
- (setq org-agenda-last-search-view-search-was-boolean boolean)
- (when boolean
- (let (wds w)
- (while (setq w (pop words))
- (if (or (equal (substring w 0 1) "\"")
- (and (> (length w) 1)
- (member (substring w 0 1) '("+" "-"))
- (equal (substring w 1 2) "\"")))
- (while (and words (not (equal (substring w -1) "\"")))
- (setq w (concat w " " (pop words)))))
- (and (string-match "\\`\\([-+]?\\)\"" w)
- (setq w (replace-match "\\1" nil nil w)))
- (and (equal (substring w -1) "\"") (setq w (substring w 0 -1)))
- (push w wds))
- (setq words (nreverse wds))))
- (if boolean
- (mapc (lambda (w)
- (setq c (string-to-char w))
- (if (equal c ?-)
- (setq neg t w (substring w 1))
- (if (equal c ?+)
- (setq neg nil w (substring w 1))
- (setq neg nil)))
- (if (string-match "\\`{.*}\\'" w)
- (setq re (substring w 1 -1))
- (if full-words
- (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>"))
- (setq re (regexp-quote (downcase w)))))
- (if neg (push re regexps-) (push re regexps+)))
- words)
- (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+")
- regexps+))
- (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b)))))
- (if (not regexps+)
- (setq regexp org-outline-regexp-bol)
- (setq regexp (pop regexps+))
- (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
- regexp))))
- (setq files (org-agenda-files nil 'ifmode))
- (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
- (pop org-agenda-text-search-extra-files)
- (setq files (org-add-archive-files files)))
- (setq files (append files org-agenda-text-search-extra-files)
- rtnall nil)
- (while (setq file (pop files))
- (setq ee nil)
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- (if (not buffer)
- ;; If file does not exist, make sure an error message is sent
- (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s"
- file))))
- (with-current-buffer buffer
- (with-syntax-table (org-search-syntax-table)
- (unless (derived-mode-p 'org-mode)
- (error "Agenda file %s is not in `org-mode'" file))
- (let ((case-fold-search t))
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- (goto-char (point-min))
- (unless (or (org-at-heading-p)
- (outline-next-heading))
- (throw 'nextfile t))
- (goto-char (max (point-min) (1- (point))))
- (while (re-search-forward regexp nil t)
- (org-back-to-heading t)
- (while (and (not (zerop org-agenda-search-view-max-outline-level))
- (> (org-reduced-level (org-outline-level))
- org-agenda-search-view-max-outline-level)
- (forward-line -1)
- (outline-back-to-heading t)))
- (skip-chars-forward "* ")
- (setq beg (point-at-bol)
- beg1 (point)
- end (progn
- (outline-next-heading)
- (while (and (not (zerop org-agenda-search-view-max-outline-level))
- (> (org-reduced-level (org-outline-level))
- org-agenda-search-view-max-outline-level)
- (forward-line 1)
- (outline-next-heading)))
- (point)))
- (catch :skip
- (goto-char beg)
- (org-agenda-skip)
- (setq str (buffer-substring-no-properties
- (point-at-bol)
- (if hdl-only (point-at-eol) end)))
- (mapc (lambda (wr) (when (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
- regexps-)
- (mapc (lambda (wr) (unless (string-match wr str)
- (goto-char (1- end))
- (throw :skip t)))
- (if todo-only
- (cons (concat "^\*+[ \t]+" org-not-done-regexp)
- regexps+)
- regexps+))
- (goto-char beg)
- (setq marker (org-agenda-new-marker (point))
- category (org-get-category)
- level (make-string (org-reduced-level (org-outline-level)) ? )
- category-pos (get-text-property (point) 'org-category-position)
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'todo org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- txt (org-agenda-format-item
- ""
- (buffer-substring-no-properties
- beg1 (point-at-eol))
- level category tags t))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker marker
- 'org-todo-regexp org-todo-regexp
- 'level level
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'priority 1000 'org-category category
- 'org-category-position category-pos
- 'type "search")
- (push txt ee)
- (goto-char (1- end))))))))))
- (setq rtn (nreverse ee))
- (setq rtnall (append rtnall rtn)))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Search words: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure))
- (setq pos (point))
- (insert string "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
- (setq pos (point))
- (unless org-agenda-multi
- (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n")
- (add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure))))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'search) "\n"))
- (goto-char (point-min))
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type search
- org-last-args (,todo-only ,string ,edit-at)
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
- (org-agenda-finalize)
- (setq buffer-read-only t))))
- ;;; Agenda TODO list
- (defun org-agenda-propertize-selected-todo-keywords (keywords)
- "Use `org-todo-keyword-faces' for the selected todo KEYWORDS."
- (concat
- (if (or (equal keywords "ALL") (not keywords))
- (propertize "ALL" 'face 'warning)
- (mapconcat
- (lambda (kw)
- (propertize kw 'face (org-get-todo-face kw)))
- (org-split-string keywords "|")
- "|"))
- "\n"))
- (defvar org-select-this-todo-keyword nil)
- (defvar org-last-arg nil)
- ;;;###autoload
- (defun org-todo-list (&optional arg)
- "Show all (not done) TODO entries from all agenda file in a single list.
- The prefix arg can be used to select a specific TODO keyword and limit
- the list to these. When using \\[universal-argument], you will be prompted
- for a keyword. A numeric prefix directly selects the Nth keyword in
- `org-todo-keywords-1'."
- (interactive "P")
- (if org-agenda-overriding-arguments
- (setq arg org-agenda-overriding-arguments))
- (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
- (let* ((today (org-today))
- (date (calendar-gregorian-from-absolute today))
- (kwds org-todo-keywords-for-agenda)
- (completion-ignore-case t)
- (org-select-this-todo-keyword
- (if (stringp arg) arg
- (and arg (integerp arg) (> arg 0)
- (nth (1- arg) kwds))))
- rtn rtnall files file pos)
- (when (equal arg '(4))
- (setq org-select-this-todo-keyword
- (org-icompleting-read "Keyword (or KWD1|K2D2|...): "
- (mapcar 'list kwds) nil nil)))
- (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
- (catch 'exit
- (if org-agenda-sticky
- (setq org-agenda-buffer-name
- (if (stringp org-select-this-todo-keyword)
- (format "*Org Agenda(%s:%s)*" (or org-keys "t")
- org-select-this-todo-keyword)
- (format "*Org Agenda(%s)*" (or org-keys "t")))))
- (org-agenda-prepare "TODO")
- (org-compile-prefix-format 'todo)
- (org-set-sorting-strategy 'todo)
- (setq org-agenda-redo-command
- `(org-todo-list (or (and (numberp current-prefix-arg)
- current-prefix-arg)
- ,org-select-this-todo-keyword
- current-prefix-arg ,arg)))
- (setq files (org-agenda-files nil 'ifmode)
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq rtn (org-agenda-get-day-entries file date :todo))
- (setq rtnall (append rtnall rtn))))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Global list of TODO items of type: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure
- 'short-heading
- (concat "ToDo: "
- (or org-select-this-todo-keyword "ALL"))))
- (org-agenda-mark-header-line (point-min))
- (insert (org-agenda-propertize-selected-todo-keywords
- org-select-this-todo-keyword))
- (setq pos (point))
- (unless org-agenda-multi
- (insert "Available with `N r': (0)[ALL]")
- (let ((n 0) s)
- (mapc (lambda (x)
- (setq s (format "(%d)%s" (setq n (1+ n)) x))
- (if (> (+ (current-column) (string-width s) 1) (frame-width))
- (insert "\n "))
- (insert " " s))
- kwds))
- (insert "\n"))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'todo) "\n"))
- (goto-char (point-min))
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type todo
- org-last-args ,arg
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
- (org-agenda-finalize)
- (setq buffer-read-only t))))
- ;;; Agenda tags match
- ;;;###autoload
- (defun org-tags-view (&optional todo-only match)
- "Show all headlines for all `org-agenda-files' matching a TAGS criterion.
- The prefix arg TODO-ONLY limits the search to TODO entries."
- (interactive "P")
- (if org-agenda-overriding-arguments
- (setq todo-only (car org-agenda-overriding-arguments)
- match (nth 1 org-agenda-overriding-arguments)))
- (let* ((org-tags-match-list-sublevels
- org-tags-match-list-sublevels)
- (completion-ignore-case t)
- rtn rtnall files file pos matcher
- buffer)
- (when (and (stringp match) (not (string-match "\\S-" match)))
- (setq match nil))
- (catch 'exit
- (if org-agenda-sticky
- (setq org-agenda-buffer-name
- (if (stringp match)
- (format "*Org Agenda(%s:%s)*"
- (or org-keys (or (and todo-only "M") "m")) match)
- (format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
- ;; Prepare agendas (and `org-tag-alist-for-agenda') before
- ;; expanding tags within `org-make-tags-matcher'
- (org-agenda-prepare (concat "TAGS " match))
- (setq matcher (org-make-tags-matcher match)
- match (car matcher) matcher (cdr matcher))
- (org-compile-prefix-format 'tags)
- (org-set-sorting-strategy 'tags)
- (setq org-agenda-query-string match)
- (setq org-agenda-redo-command
- (list 'org-tags-view `(quote ,todo-only)
- (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string))))
- (setq files (org-agenda-files nil 'ifmode)
- rtnall nil)
- (while (setq file (pop files))
- (catch 'nextfile
- (org-check-agenda-file file)
- (setq buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- (if (not buffer)
- ;; If file does not exist, error message to agenda
- (setq rtn (list
- (format "ORG-AGENDA-ERROR: No such org-file %s" file))
- rtnall (append rtnall rtn))
- (with-current-buffer buffer
- (unless (derived-mode-p 'org-mode)
- (error "Agenda file %s is not in `org-mode'" file))
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- (setq rtn (org-scan-tags 'agenda matcher todo-only))
- (setq rtnall (append rtnall rtn))))))))
- (if org-agenda-overriding-header
- (insert (org-add-props (copy-sequence org-agenda-overriding-header)
- nil 'face 'org-agenda-structure) "\n")
- (insert "Headlines with TAGS match: ")
- (add-text-properties (point-min) (1- (point))
- (list 'face 'org-agenda-structure
- 'short-heading
- (concat "Match: " match)))
- (setq pos (point))
- (insert match "\n")
- (add-text-properties pos (1- (point)) (list 'face 'org-warning))
- (setq pos (point))
- (unless org-agenda-multi
- (insert "Press `C-u r' to search again with new search string\n"))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
- (org-agenda-mark-header-line (point-min))
- (when rtnall
- (insert (org-agenda-finalize-entries rtnall 'tags) "\n"))
- (goto-char (point-min))
- (or org-agenda-multi (org-agenda-fit-window-to-buffer))
- (add-text-properties (point-min) (point-max)
- `(org-agenda-type tags
- org-last-args (,todo-only ,match)
- org-redo-cmd ,org-agenda-redo-command
- org-series-cmd ,org-cmd))
- (org-agenda-finalize)
- (setq buffer-read-only t))))
- ;;; Agenda Finding stuck projects
- (defvar org-agenda-skip-regexp nil
- "Regular expression used in skipping subtrees for the agenda.
- This is basically a temporary global variable that can be set and then
- used by user-defined selections using `org-agenda-skip-function'.")
- (defvar org-agenda-overriding-header nil
- "When set during agenda, todo and tags searches it replaces the header.
- This variable should not be set directly, but custom commands can bind it
- in the options section.")
- (defun org-agenda-skip-entry-when-regexp-matches ()
- "Check if the current entry contains match for `org-agenda-skip-regexp'.
- If yes, it returns the end position of this entry, causing agenda commands
- to skip the entry but continuing the search in the subtree. This is a
- function that can be put into `org-agenda-skip-function' for the duration
- of a command."
- (let ((end (save-excursion (org-end-of-subtree t)))
- skip)
- (save-excursion
- (setq skip (re-search-forward org-agenda-skip-regexp end t)))
- (and skip end)))
- (defun org-agenda-skip-subtree-when-regexp-matches ()
- "Check if the current subtree contains match for `org-agenda-skip-regexp'.
- If yes, it returns the end position of this tree, causing agenda commands
- to skip this subtree. This is a function that can be put into
- `org-agenda-skip-function' for the duration of a command."
- (let ((end (save-excursion (org-end-of-subtree t)))
- skip)
- (save-excursion
- (setq skip (re-search-forward org-agenda-skip-regexp end t)))
- (and skip end)))
- (defun org-agenda-skip-entry-when-regexp-matches-in-subtree ()
- "Check if the current subtree contains match for `org-agenda-skip-regexp'.
- If yes, it returns the end position of the current entry (NOT the tree),
- causing agenda commands to skip the entry but continuing the search in
- the subtree. This is a function that can be put into
- `org-agenda-skip-function' for the duration of a command. An important
- use of this function is for the stuck project list."
- (let ((end (save-excursion (org-end-of-subtree t)))
- (entry-end (save-excursion (outline-next-heading) (1- (point))))
- skip)
- (save-excursion
- (setq skip (re-search-forward org-agenda-skip-regexp end t)))
- (and skip entry-end)))
- (defun org-agenda-skip-entry-if (&rest conditions)
- "Skip entry if any of CONDITIONS is true.
- See `org-agenda-skip-if' for details."
- (org-agenda-skip-if nil conditions))
- (defun org-agenda-skip-subtree-if (&rest conditions)
- "Skip entry if any of CONDITIONS is true.
- See `org-agenda-skip-if' for details."
- (org-agenda-skip-if t conditions))
- (defun org-agenda-skip-if (subtree conditions)
- "Checks current entity for CONDITIONS.
- If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only
- the entry (i.e. the text before the next heading) is checked.
- CONDITIONS is a list of symbols, boolean OR is used to combine the results
- from different tests. Valid conditions are:
- scheduled Check if there is a scheduled cookie
- notscheduled Check if there is no scheduled cookie
- deadline Check if there is a deadline
- notdeadline Check if there is no deadline
- timestamp Check if there is a timestamp (also deadline or scheduled)
- nottimestamp Check if there is no timestamp (also deadline or scheduled)
- regexp Check if regexp matches
- notregexp Check if regexp does not match.
- todo Check if TODO keyword matches
- nottodo Check if TODO keyword does not match
- The regexp is taken from the conditions list, it must come right after
- the `regexp' or `notregexp' element.
- `todo' and `nottodo' accept as an argument a list of todo
- keywords, which may include \"*\" to match any todo keyword.
- (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\"))
- would skip all entries with \"TODO\" or \"WAITING\" keywords.
- Instead of a list, a keyword class may be given. For example:
- (org-agenda-skip-entry-if 'nottodo 'done)
- would skip entries that haven't been marked with any of \"DONE\"
- keywords. Possible classes are: `todo', `done', `any'.
- If any of these conditions is met, this function returns the end point of
- the entity, causing the search to continue from there. This is a function
- that can be put into `org-agenda-skip-function' for the duration of a command."
- (let (beg end m)
- (org-back-to-heading t)
- (setq beg (point)
- end (if subtree
- (progn (org-end-of-subtree t) (point))
- (progn (outline-next-heading) (1- (point)))))
- (goto-char beg)
- (and
- (or
- (and (memq 'scheduled conditions)
- (re-search-forward org-scheduled-time-regexp end t))
- (and (memq 'notscheduled conditions)
- (not (re-search-forward org-scheduled-time-regexp end t)))
- (and (memq 'deadline conditions)
- (re-search-forward org-deadline-time-regexp end t))
- (and (memq 'notdeadline conditions)
- (not (re-search-forward org-deadline-time-regexp end t)))
- (and (memq 'timestamp conditions)
- (re-search-forward org-ts-regexp end t))
- (and (memq 'nottimestamp conditions)
- (not (re-search-forward org-ts-regexp end t)))
- (and (setq m (memq 'regexp conditions))
- (stringp (nth 1 m))
- (re-search-forward (nth 1 m) end t))
- (and (setq m (memq 'notregexp conditions))
- (stringp (nth 1 m))
- (not (re-search-forward (nth 1 m) end t)))
- (and (or
- (setq m (memq 'nottodo conditions))
- (setq m (memq 'todo-unblocked conditions))
- (setq m (memq 'nottodo-unblocked conditions))
- (setq m (memq 'todo conditions)))
- (org-agenda-skip-if-todo m end)))
- end)))
- (defun org-agenda-skip-if-todo (args end)
- "Helper function for `org-agenda-skip-if', do not use it directly.
- ARGS is a list with first element either `todo', `nottodo',
- `todo-unblocked' or `nottodo-unblocked'. The remainder is either
- a list of TODO keywords, or a state symbol `todo' or `done' or
- `any'."
- (let ((kw (car args))
- (arg (cadr args))
- todo-wds todo-re)
- (setq todo-wds
- (org-uniquify
- (cond
- ((listp arg) ;; list of keywords
- (if (member "*" arg)
- (mapcar 'substring-no-properties org-todo-keywords-1)
- arg))
- ((symbolp arg) ;; keyword class name
- (cond
- ((eq arg 'todo)
- (org-delete-all org-done-keywords
- (mapcar 'substring-no-properties
- org-todo-keywords-1)))
- ((eq arg 'done) org-done-keywords)
- ((eq arg 'any)
- (mapcar 'substring-no-properties org-todo-keywords-1)))))))
- (setq todo-re
- (concat "^\\*+[ \t]+\\<\\("
- (mapconcat 'identity todo-wds "\\|")
- "\\)\\>"))
- (cond
- ((eq kw 'todo) (re-search-forward todo-re end t))
- ((eq kw 'nottodo) (not (re-search-forward todo-re end t)))
- ((eq kw 'todo-unblocked)
- (catch 'unblocked
- (while (re-search-forward todo-re end t)
- (or (org-entry-blocked-p) (throw 'unblocked t)))
- nil))
- ((eq kw 'nottodo-unblocked)
- (catch 'unblocked
- (while (re-search-forward todo-re end t)
- (or (org-entry-blocked-p) (throw 'unblocked nil)))
- t))
- )))
- ;;;###autoload
- (defun org-agenda-list-stuck-projects (&rest ignore)
- "Create agenda view for projects that are stuck.
- Stuck projects are project that have no next actions. For the definitions
- of what a project is and how to check if it stuck, customize the variable
- `org-stuck-projects'."
- (interactive)
- (let* ((org-agenda-skip-function
- 'org-agenda-skip-entry-when-regexp-matches-in-subtree)
- ;; We could have used org-agenda-skip-if here.
- (org-agenda-overriding-header
- (or org-agenda-overriding-header "List of stuck projects: "))
- (matcher (nth 0 org-stuck-projects))
- (todo (nth 1 org-stuck-projects))
- (todo-wds (if (member "*" todo)
- (progn
- (org-agenda-prepare-buffers (org-agenda-files
- nil 'ifmode))
- (org-delete-all
- org-done-keywords-for-agenda
- (copy-sequence org-todo-keywords-for-agenda)))
- todo))
- (todo-re (concat "^\\*+[ \t]+\\("
- (mapconcat 'identity todo-wds "\\|")
- "\\)\\>"))
- (tags (nth 2 org-stuck-projects))
- (tags-re (if (member "*" tags)
- (concat org-outline-regexp-bol
- (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$"))
- (if tags
- (concat org-outline-regexp-bol
- ".*:\\("
- (mapconcat 'identity tags "\\|")
- (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$")))))
- (gen-re (nth 3 org-stuck-projects))
- (re-list
- (delq nil
- (list
- (if todo todo-re)
- (if tags tags-re)
- (and gen-re (stringp gen-re) (string-match "\\S-" gen-re)
- gen-re)))))
- (setq org-agenda-skip-regexp
- (if re-list
- (mapconcat 'identity re-list "\\|")
- (error "No information how to identify unstuck projects")))
- (org-tags-view nil matcher)
- (with-current-buffer org-agenda-buffer-name
- (setq org-agenda-redo-command
- `(org-agenda-list-stuck-projects ,current-prefix-arg)))))
- ;;; Diary integration
- (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
- (defvar diary-list-entries-hook)
- (defvar diary-time-regexp)
- (defun org-get-entries-from-diary (date)
- "Get the (Emacs Calendar) diary entries for DATE."
- (require 'diary-lib)
- (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
- (diary-display-hook '(fancy-diary-display))
- (diary-display-function 'fancy-diary-display)
- (pop-up-frames nil)
- (diary-list-entries-hook
- (cons 'org-diary-default-entry diary-list-entries-hook))
- (diary-file-name-prefix nil) ; turn this feature off
- (diary-modify-entry-list-string-function 'org-modify-diary-entry-string)
- entries
- (org-disable-agenda-to-diary t))
- (save-excursion
- (save-window-excursion
- (funcall (if (fboundp 'diary-list-entries)
- 'diary-list-entries 'list-diary-entries)
- date 1)))
- (if (not (get-buffer diary-fancy-buffer))
- (setq entries nil)
- (with-current-buffer diary-fancy-buffer
- (setq buffer-read-only nil)
- (if (zerop (buffer-size))
- ;; No entries
- (setq entries nil)
- ;; Omit the date and other unnecessary stuff
- (org-agenda-cleanup-fancy-diary)
- ;; Add prefix to each line and extend the text properties
- (if (zerop (buffer-size))
- (setq entries nil)
- (setq entries (buffer-substring (point-min) (- (point-max) 1)))
- (setq entries
- (with-temp-buffer
- (insert entries) (goto-char (point-min))
- (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t)
- (unless (save-match-data (string-match diary-time-regexp (match-string 1)))
- (replace-match (concat "; " (match-string 1)))))
- (buffer-string)))))
- (set-buffer-modified-p nil)
- (kill-buffer diary-fancy-buffer)))
- (when entries
- (setq entries (org-split-string entries "\n"))
- (setq entries
- (mapcar
- (lambda (x)
- (setq x (org-agenda-format-item "" x nil "Diary" nil 'time))
- ;; Extend the text properties to the beginning of the line
- (org-add-props x (text-properties-at (1- (length x)) x)
- 'type "diary" 'date date 'face 'org-agenda-diary))
- entries)))))
- (defvar org-agenda-cleanup-fancy-diary-hook nil
- "Hook run when the fancy diary buffer is cleaned up.")
- (defun org-agenda-cleanup-fancy-diary ()
- "Remove unwanted stuff in buffer created by `fancy-diary-display'.
- This gets rid of the date, the underline under the date, and
- the dummy entry installed by `org-mode' to ensure non-empty diary for each
- date. It also removes lines that contain only whitespace."
- (goto-char (point-min))
- (if (looking-at ".*?:[ \t]*")
- (progn
- (replace-match "")
- (re-search-forward "\n=+$" nil t)
- (replace-match "")
- (while (re-search-backward "^ +\n?" nil t) (replace-match "")))
- (re-search-forward "\n=+$" nil t)
- (delete-region (point-min) (min (point-max) (1+ (match-end 0)))))
- (goto-char (point-min))
- (while (re-search-forward "^ +\n" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (if (re-search-forward "^Org-mode dummy\n?" nil t)
- (replace-match ""))
- (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
- ;; Make sure entries from the diary have the right text properties.
- (eval-after-load "diary-lib"
- '(if (boundp 'diary-modify-entry-list-string-function)
- ;; We can rely on the hook, nothing to do
- nil
- ;; Hook not available, must use advice to make this work
- (defadvice add-to-diary-list (before org-mark-diary-entry activate)
- "Make the position visible."
- (if (and org-disable-agenda-to-diary ;; called from org-agenda
- (stringp string)
- buffer-file-name)
- (setq string (org-modify-diary-entry-string string))))))
- (defun org-modify-diary-entry-string (string)
- "Add text properties to string, allowing org-mode to act on it."
- (org-add-props string nil
- 'mouse-face 'highlight
- 'help-echo (if buffer-file-name
- (format "mouse-2 or RET jump to diary file %s"
- (abbreviate-file-name buffer-file-name))
- "")
- 'org-agenda-diary-link t
- 'org-marker (org-agenda-new-marker (point-at-bol))))
- (defun org-diary-default-entry ()
- "Add a dummy entry to the diary.
- Needed to avoid empty dates which mess up holiday display."
- ;; Catch the error if dealing with the new add-to-diary-alist
- (when org-disable-agenda-to-diary
- (condition-case nil
- (org-add-to-diary-list original-date "Org-mode dummy" "")
- (error
- (org-add-to-diary-list original-date "Org-mode dummy" "" nil)))))
- (defun org-add-to-diary-list (&rest args)
- (if (fboundp 'diary-add-to-list)
- (apply 'diary-add-to-list args)
- (apply 'add-to-diary-list args)))
- (defvar org-diary-last-run-time nil)
- ;;;###autoload
- (defun org-diary (&rest args)
- "Return diary information from org files.
- This function can be used in a \"sexp\" diary entry in the Emacs calendar.
- It accesses org files and extracts information from those files to be
- listed in the diary. The function accepts arguments specifying what
- items should be listed. For a list of arguments allowed here, see the
- variable `org-agenda-entry-types'.
- The call in the diary file should look like this:
- &%%(org-diary) ~/path/to/some/orgfile.org
- Use a separate line for each org file to check. Or, if you omit the file name,
- all files listed in `org-agenda-files' will be checked automatically:
- &%%(org-diary)
- If you don't give any arguments (as in the example above), the default value
- of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp).
- So the example above may also be written as
- &%%(org-diary :deadline :timestamp :sexp :scheduled)
- The function expects the lisp variables `entry' and `date' to be provided
- by the caller, because this is how the calendar works. Don't use this
- function from a program - use `org-agenda-get-day-entries' instead."
- (when (> (- (org-float-time)
- org-agenda-last-marker-time)
- 5)
- ;; I am not sure if this works with sticky agendas, because the marker
- ;; list is then no longer a global variable.
- (org-agenda-reset-markers))
- (org-compile-prefix-format 'agenda)
- (org-set-sorting-strategy 'agenda)
- (setq args (or args org-agenda-entry-types))
- (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry))
- (list entry)
- (org-agenda-files t)))
- (time (org-float-time))
- file rtn results)
- (when (or (not org-diary-last-run-time)
- (> (- time
- org-diary-last-run-time)
- 3))
- (org-agenda-prepare-buffers files))
- (setq org-diary-last-run-time time)
- ;; If this is called during org-agenda, don't return any entries to
- ;; the calendar. Org Agenda will list these entries itself.
- (if org-disable-agenda-to-diary (setq files nil))
- (while (setq file (pop files))
- (setq rtn (apply 'org-agenda-get-day-entries file date args))
- (setq results (append results rtn)))
- (when results
- (setq results
- (mapcar (lambda (i) (replace-regexp-in-string
- org-bracket-link-regexp "\\3" i)) results))
- (concat (org-agenda-finalize-entries results) "\n"))))
- ;;; Agenda entry finders
- (defun org-agenda-get-day-entries (file date &rest args)
- "Does the work for `org-diary' and `org-agenda'.
- FILE is the path to a file to be checked for entries. DATE is date like
- the one returned by `calendar-current-date'. ARGS are symbols indicating
- which kind of entries should be extracted. For details about these, see
- the documentation of `org-diary'."
- (setq args (or args org-agenda-entry-types))
- (let* ((org-startup-folded nil)
- (org-startup-align-all-tables nil)
- (buffer (if (file-exists-p file)
- (org-get-agenda-file-buffer file)
- (error "No such file %s" file)))
- arg results rtn deadline-results)
- (if (not buffer)
- ;; If file does not exist, make sure an error message ends up in diary
- (list (format "ORG-AGENDA-ERROR: No such org-file %s" file))
- (with-current-buffer buffer
- (unless (derived-mode-p 'org-mode)
- (error "Agenda file %s is not in `org-mode'" file))
- (setq org-agenda-buffer (or org-agenda-buffer buffer))
- (let ((case-fold-search nil))
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- ;; The way we repeatedly append to `results' makes it O(n^2) :-(
- (while (setq arg (pop args))
- (cond
- ((and (eq arg :todo)
- (equal date (calendar-gregorian-from-absolute
- (org-today))))
- (setq rtn (org-agenda-get-todos))
- (setq results (append results rtn)))
- ((eq arg :timestamp)
- (setq rtn (org-agenda-get-blocks))
- (setq results (append results rtn))
- (setq rtn (org-agenda-get-timestamps deadline-results))
- (setq results (append results rtn)))
- ((eq arg :sexp)
- (setq rtn (org-agenda-get-sexps))
- (setq results (append results rtn)))
- ((eq arg :scheduled)
- (setq rtn (org-agenda-get-scheduled deadline-results))
- (setq results (append results rtn)))
- ((eq arg :scheduled*)
- (setq rtn (org-agenda-get-scheduled deadline-results t))
- (setq results (append results rtn)))
- ((eq arg :closed)
- (setq rtn (org-agenda-get-progress))
- (setq results (append results rtn)))
- ((eq arg :deadline)
- (setq rtn (org-agenda-get-deadlines))
- (setq deadline-results (copy-sequence rtn))
- (setq results (append results rtn)))
- ((eq arg :deadline*)
- (setq rtn (org-agenda-get-deadlines t))
- (setq deadline-results (copy-sequence rtn))
- (setq results (append results rtn))))))))
- results))))
- (defsubst org-em (x y list)
- "Is X or Y a member of LIST?"
- (or (memq x list) (memq y list)))
- (defvar org-heading-keyword-regexp-format) ; defined in org.el
- (defvar org-agenda-sorting-strategy-selected nil)
- (defun org-agenda-get-todos ()
- "Return the TODO information for agenda display."
- (let* ((props (list 'face nil
- 'done-face 'org-agenda-done
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp (format org-heading-keyword-regexp-format
- (cond
- ((and org-select-this-todo-keyword
- (equal org-select-this-todo-keyword "*"))
- org-todo-regexp)
- (org-select-this-todo-keyword
- (concat "\\("
- (mapconcat 'identity
- (org-split-string
- org-select-this-todo-keyword
- "|")
- "\\|") "\\)"))
- (t org-not-done-regexp))))
- marker priority category category-pos level tags todo-state ts-date ts-date-type
- ee txt beg end inherited-tags todo-state-end-pos)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (save-match-data
- (beginning-of-line)
- (org-agenda-skip)
- (setq beg (point) end (save-excursion (outline-next-heading) (point)))
- (unless (and (setq todo-state (org-get-todo-state))
- (setq todo-state-end-pos (match-end 2)))
- (goto-char end)
- (throw :skip nil))
- (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end)
- (goto-char (1+ beg))
- (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible))
- (throw :skip nil)))
- (goto-char (match-beginning 2))
- (setq marker (org-agenda-new-marker (match-beginning 0))
- category (org-get-category)
- ts-date (let (ts)
- (save-match-data
- (cond ((org-em 'scheduled-up 'scheduled-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "SCHEDULED")
- ts-date-type " scheduled"))
- ((org-em 'deadline-up 'deadline-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "DEADLINE")
- ts-date-type " deadline"))
- ((org-em 'ts-up 'ts-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "TIMESTAMP")
- ts-date-type " timestamp"))
- ((org-em 'tsia-up 'tsia-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get (point) "TIMESTAMP_IA")
- ts-date-type " timestamp_ia"))
- ((org-em 'timestamp-up 'timestamp-down
- org-agenda-sorting-strategy-selected)
- (setq ts (or (org-entry-get (point) "SCHEDULED")
- (org-entry-get (point) "DEADLINE")
- (org-entry-get (point) "TIMESTAMP")
- (org-entry-get (point) "TIMESTAMP_IA"))
- ts-date-type ""))
- (t (setq ts-date-type "")))
- (when ts (ignore-errors (org-time-string-to-absolute ts)))))
- category-pos (get-text-property (point) 'org-category-position)
- txt (org-trim
- (buffer-substring (match-beginning 2) (match-end 0)))
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'todo org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- level (make-string (org-reduced-level (org-outline-level)) ? )
- txt (org-agenda-format-item "" txt level category tags t)
- priority (1+ (org-get-priority txt)))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker marker
- 'priority priority 'org-category category
- 'level level
- 'ts-date ts-date
- 'org-category-position category-pos
- 'type (concat "todo" ts-date-type) 'todo-state todo-state)
- (push txt ee)
- (if org-agenda-todo-list-sublevels
- (goto-char todo-state-end-pos)
- (org-end-of-subtree 'invisible))))
- (nreverse ee)))
- (defun org-agenda-todo-custom-ignore-p (time n)
- "Check whether timestamp is farther away than n number of days.
- This function is invoked if `org-agenda-todo-ignore-deadlines',
- `org-agenda-todo-ignore-scheduled' or
- `org-agenda-todo-ignore-timestamp' is set to an integer."
- (let ((days (org-time-stamp-to-now
- time org-agenda-todo-ignore-time-comparison-use-seconds)))
- (if (>= n 0)
- (>= days n)
- (<= days n))))
- ;;;###autoload
- (defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item
- (&optional end)
- "Do we have a reason to ignore this TODO entry because it has a time stamp?"
- (when (or org-agenda-todo-ignore-with-date
- org-agenda-todo-ignore-scheduled
- org-agenda-todo-ignore-deadlines
- org-agenda-todo-ignore-timestamp)
- (setq end (or end (save-excursion (outline-next-heading) (point))))
- (save-excursion
- (or (and org-agenda-todo-ignore-with-date
- (re-search-forward org-ts-regexp end t))
- (and org-agenda-todo-ignore-scheduled
- (re-search-forward org-scheduled-time-regexp end t)
- (cond
- ((eq org-agenda-todo-ignore-scheduled 'future)
- (> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((eq org-agenda-todo-ignore-scheduled 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((numberp org-agenda-todo-ignore-scheduled)
- (org-agenda-todo-custom-ignore-p
- (match-string 1) org-agenda-todo-ignore-scheduled))
- (t)))
- (and org-agenda-todo-ignore-deadlines
- (re-search-forward org-deadline-time-regexp end t)
- (cond
- ((memq org-agenda-todo-ignore-deadlines '(t all)) t)
- ((eq org-agenda-todo-ignore-deadlines 'far)
- (not (org-deadline-close (match-string 1))))
- ((eq org-agenda-todo-ignore-deadlines 'future)
- (> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((eq org-agenda-todo-ignore-deadlines 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((numberp org-agenda-todo-ignore-deadlines)
- (org-agenda-todo-custom-ignore-p
- (match-string 1) org-agenda-todo-ignore-deadlines))
- (t (org-deadline-close (match-string 1)))))
- (and org-agenda-todo-ignore-timestamp
- (let ((buffer (current-buffer))
- (regexp
- (concat
- org-scheduled-time-regexp "\\|" org-deadline-time-regexp))
- (start (point)))
- ;; Copy current buffer into a temporary one
- (with-temp-buffer
- (insert-buffer-substring buffer start end)
- (goto-char (point-min))
- ;; Delete SCHEDULED and DEADLINE items
- (while (re-search-forward regexp end t)
- (delete-region (match-beginning 0) (match-end 0)))
- (goto-char (point-min))
- ;; No search for timestamp left
- (when (re-search-forward org-ts-regexp nil t)
- (cond
- ((eq org-agenda-todo-ignore-timestamp 'future)
- (> (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((eq org-agenda-todo-ignore-timestamp 'past)
- (<= (org-time-stamp-to-now
- (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0))
- ((numberp org-agenda-todo-ignore-timestamp)
- (org-agenda-todo-custom-ignore-p
- (match-string 1) org-agenda-todo-ignore-timestamp))
- (t))))))))))
- (defun org-agenda-get-timestamps (&optional deadline-results)
- "Return the date stamp information for agenda display."
- (let* ((props (list 'face 'org-agenda-calendar-event
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (d1 (calendar-absolute-from-gregorian date))
- mm
- (deadline-position-alist
- (mapcar (lambda (a) (and (setq mm (get-text-property
- 0 'org-hd-marker a))
- (cons (marker-position mm) a)))
- deadline-results))
- (remove-re org-ts-regexp)
- (regexp
- (concat
- (if org-agenda-include-inactive-timestamps "[[<]" "<")
- (regexp-quote
- (substring
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time ; DATE bound by calendar
- (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
- 1 11))
- "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
- "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
- marker hdmarker deadlinep scheduledp clockp closedp inactivep
- donep tmp priority category category-pos level ee txt timestr tags
- b0 b3 e3 head todo-state end-of-match show-all warntime habitp
- inherited-tags ts-date)
- (goto-char (point-min))
- (while (setq end-of-match (re-search-forward regexp nil t))
- (setq b0 (match-beginning 0)
- b3 (match-beginning 3) e3 (match-end 3)
- todo-state (save-match-data (ignore-errors (org-get-todo-state)))
- habitp (and (functionp 'org-is-habit-p) (save-match-data (org-is-habit-p)))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all)))
- (catch :skip
- (and (org-at-date-range-p) (throw :skip nil))
- (org-agenda-skip)
- (if (and (match-end 1)
- (not (= d1 (org-time-string-to-absolute
- (match-string 1) d1 nil show-all
- (current-buffer) b0))))
- (throw :skip nil))
- (if (and e3
- (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date)))
- (throw :skip nil))
- (setq tmp (buffer-substring (max (point-min)
- (- b0 org-ds-keyword-length))
- b0)
- timestr (if b3 "" (buffer-substring b0 (point-at-eol)))
- inactivep (= (char-after b0) ?\[)
- deadlinep (string-match org-deadline-regexp tmp)
- scheduledp (string-match org-scheduled-regexp tmp)
- closedp (and org-agenda-include-inactive-timestamps
- (string-match org-closed-string tmp))
- clockp (and org-agenda-include-inactive-timestamps
- (or (string-match org-clock-string tmp)
- (string-match "]-+\\'" tmp)))
- warntime (get-text-property (point) 'org-appt-warntime)
- donep (member todo-state org-done-keywords))
- (if (or scheduledp deadlinep closedp clockp
- (and donep org-agenda-skip-timestamp-if-done))
- (throw :skip t))
- (if (string-match ">" timestr)
- ;; substring should only run to end of time stamp
- (setq timestr (substring timestr 0 (match-end 0))))
- (setq marker (org-agenda-new-marker b0)
- category (org-get-category b0)
- category-pos (get-text-property b0 'org-category-position))
- (save-excursion
- (if (not (re-search-backward org-outline-regexp-bol nil t))
- (throw :skip nil)
- (goto-char (match-beginning 0))
- (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown)
- (assoc (point) deadline-position-alist))
- (throw :skip nil))
- (setq hdmarker (org-agenda-new-marker)
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
- (setq head (or (match-string 1) ""))
- (setq txt (org-agenda-format-item
- (if inactivep org-agenda-inactive-leader nil)
- head level category tags timestr
- remove-re habitp)))
- (setq priority (org-get-priority txt))
- (org-add-props txt props 'priority priority
- 'org-marker marker 'org-hd-marker hdmarker
- 'org-category category 'date date
- 'level level
- 'ts-date
- (ignore-errors (org-time-string-to-absolute timestr))
- 'org-category-position category-pos
- 'todo-state todo-state
- 'warntime warntime
- 'type "timestamp")
- (push txt ee))
- (if org-agenda-skip-additional-timestamps-same-entry
- (outline-next-heading)
- (goto-char end-of-match))))
- (nreverse ee)))
- (defun org-agenda-get-sexps ()
- "Return the sexp information for agenda display."
- (require 'diary-lib)
- (let* ((props (list 'face 'org-agenda-calendar-sexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp "^&?%%(")
- marker category extra category-pos level ee txt tags entry
- result beg b sexp sexp-entry todo-state warntime inherited-tags)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq beg (match-beginning 0))
- (goto-char (1- (match-end 0)))
- (setq b (point))
- (forward-sexp 1)
- (setq sexp (buffer-substring b (point)))
- (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)")
- (org-trim (match-string 1))
- ""))
- (setq result (org-diary-sexp-entry sexp sexp-entry date))
- (when result
- (setq marker (org-agenda-new-marker beg)
- level (make-string (org-reduced-level (org-outline-level)) ? )
- category (org-get-category beg)
- category-pos (get-text-property beg 'org-category-position)
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- todo-state (org-get-todo-state)
- warntime (get-text-property (point) 'org-appt-warntime)
- extra nil)
- (dolist (r (if (stringp result)
- (list result)
- result)) ;; we expect a list here
- (when (and org-agenda-diary-sexp-prefix
- (string-match org-agenda-diary-sexp-prefix r))
- (setq extra (match-string 0 r)
- r (replace-match "" nil nil r)))
- (if (string-match "\\S-" r)
- (setq txt r)
- (setq txt "SEXP entry returned empty string"))
- (setq txt (org-agenda-format-item extra txt level category tags 'time))
- (org-add-props txt props 'org-marker marker
- 'org-category category 'date date 'todo-state todo-state
- 'org-category-position category-pos 'tags tags
- 'level level
- 'type "sexp" 'warntime warntime)
- (push txt ee)))))
- (nreverse ee)))
- ;; Calendar sanity: define some functions that are independent of
- ;; `calendar-date-style'.
- ;; Normally I would like to use ISO format when calling the diary functions,
- ;; but to make sure we still have Emacs 22 compatibility we bind
- ;; also `european-calendar-style' and use european format
- (defun org-anniversary (year month day &optional mark)
- "Like `diary-anniversary', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-anniversary day month year mark))))
- (defun org-cyclic (N year month day &optional mark)
- "Like `diary-cyclic', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-cyclic N day month year mark))))
- (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
- "Like `diary-block', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-block D1 M1 Y1 D2 M2 Y2 mark))))
- (defun org-date (year month day &optional mark)
- "Like `diary-date', but with fixed (ISO) order of arguments."
- (org-no-warnings
- (let ((calendar-date-style 'european) (european-calendar-style t))
- (diary-date day month year mark))))
- ;; Define the` org-class' function
- (defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks)
- "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS.
- DAYNAME is a number between 0 (Sunday) and 6 (Saturday).
- SKIP-WEEKS is any number of ISO weeks in the block period for which the
- item should be skipped. If any of the SKIP-WEEKS arguments is the symbol
- `holidays', then any date that is known by the Emacs calendar to be a
- holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings,
- then those holidays will be skipped."
- (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1)))
- (date2 (calendar-absolute-from-gregorian (list m2 d2 y2)))
- (d (calendar-absolute-from-gregorian date))
- (h (when skip-weeks (calendar-check-holidays date))))
- (and
- (<= date1 d)
- (<= d date2)
- (= (calendar-day-of-week date) dayname)
- (or (not skip-weeks)
- (progn
- (require 'cal-iso)
- (not (member (car (calendar-iso-from-absolute d)) skip-weeks))))
- (not (or (and h (memq 'holidays skip-weeks))
- (delq nil (mapcar (lambda(g) (member g skip-weeks)) h))))
- entry)))
- (defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks)
- "Like `org-class', but honor `calendar-date-style'.
- The order of the first 2 times 3 arguments depends on the variable
- `calendar-date-style' or, if that is not defined, on `european-calendar-style'.
- So for American calendars, give this as MONTH DAY YEAR, for European as
- DAY MONTH YEAR, and for ISO as YEAR MONTH DAY.
- DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS
- is any number of ISO weeks in the block period for which the item should
- be skipped.
- This function is here only for backward compatibility and it is deprecated,
- please use `org-class' instead."
- (let* ((date1 (org-order-calendar-date-args m1 d1 y1))
- (date2 (org-order-calendar-date-args m2 d2 y2)))
- (org-class
- (nth 2 date1) (car date1) (nth 1 date1)
- (nth 2 date2) (car date2) (nth 1 date2)
- dayname skip-weeks)))
- (make-obsolete 'org-diary-class 'org-class "")
- (defalias 'org-get-closed 'org-agenda-get-progress)
- (defun org-agenda-get-progress ()
- "Return the logged TODO entries for agenda display."
- (let* ((props (list 'mouse-face 'highlight
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (items (if (consp org-agenda-show-log-scoped)
- org-agenda-show-log-scoped
- (if (eq org-agenda-show-log-scoped 'clockcheck)
- '(clock)
- org-agenda-log-mode-items)))
- (parts
- (delq nil
- (list
- (if (memq 'closed items) (concat "\\<" org-closed-string))
- (if (memq 'clock items) (concat "\\<" org-clock-string))
- (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?"))))
- (parts-re (if parts (mapconcat 'identity parts "\\|")
- (error "`org-agenda-log-mode-items' is empty")))
- (regexp (concat
- "\\(" parts-re "\\)"
- " *\\["
- (regexp-quote
- (substring
- (format-time-string
- (car org-time-stamp-formats)
- (apply 'encode-time ; DATE bound by calendar
- (list 0 0 0 (nth 1 date) (car date) (nth 2 date))))
- 1 11))))
- (org-agenda-search-headline-for-time nil)
- marker hdmarker priority category category-pos level tags closedp
- statep clockp state ee txt extra timestr rest clocked inherited-tags)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq marker (org-agenda-new-marker (match-beginning 0))
- closedp (equal (match-string 1) org-closed-string)
- statep (equal (string-to-char (match-string 1)) ?-)
- clockp (not (or closedp statep))
- state (and statep (match-string 2))
- category (org-get-category (match-beginning 0))
- category-pos (get-text-property (match-beginning 0) 'org-category-position)
- timestr (buffer-substring (match-beginning 0) (point-at-eol)))
- (when (string-match "\\]" timestr)
- ;; substring should only run to end of time stamp
- (setq rest (substring timestr (match-end 0))
- timestr (substring timestr 0 (match-end 0)))
- (if (and (not closedp) (not statep)
- (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
- rest))
- (progn (setq timestr (concat (substring timestr 0 -1)
- "-" (match-string 1 rest) "]"))
- (setq clocked (match-string 2 rest)))
- (setq clocked "-")))
- (save-excursion
- (setq extra
- (cond
- ((not org-agenda-log-mode-add-notes) nil)
- (statep
- (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$")
- (match-string 1)))
- (clockp
- (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$")
- (match-string 1)))))
- (if (not (re-search-backward org-outline-regexp-bol nil t))
- (throw :skip nil)
- (goto-char (match-beginning 0))
- (setq hdmarker (org-agenda-new-marker)
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'todo org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'todo org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags))
- level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
- (setq txt (match-string 1))
- (when extra
- (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt)
- (setq txt (concat (substring txt 0 (match-beginning 1))
- " - " extra " " (match-string 2 txt)))
- (setq txt (concat txt " - " extra))))
- (setq txt (org-agenda-format-item
- (cond
- (closedp "Closed: ")
- (statep (concat "State: (" state ")"))
- (t (concat "Clocked: (" clocked ")")))
- txt level category tags timestr)))
- (setq priority 100000)
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
- 'priority priority 'org-category category
- 'org-category-position category-pos
- 'level level
- 'type "closed" 'date date
- 'undone-face 'org-warning 'done-face 'org-agenda-done)
- (push txt ee))
- (goto-char (point-at-eol))))
- (nreverse ee)))
- (defun org-agenda-show-clocking-issues ()
- "Add overlays, showing issues with clocking.
- See also the user option `org-agenda-clock-consistency-checks'."
- (interactive)
- (let* ((org-time-clocksum-use-effort-durations nil)
- (pl org-agenda-clock-consistency-checks)
- (re (concat "^[ \t]*"
- org-clock-string
- "[ \t]+"
- "\\(\\[.*?\\]\\)" ; group 1 is first stamp
- "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second
- (tlstart 0.)
- (tlend 0.)
- (maxtime (org-hh:mm-string-to-minutes
- (or (plist-get pl :max-duration) "24:00")))
- (mintime (org-hh:mm-string-to-minutes
- (or (plist-get pl :min-duration) 0)))
- (maxgap (org-hh:mm-string-to-minutes
- ;; default 30:00 means never complain
- (or (plist-get pl :max-gap) "30:00")))
- (gapok (mapcar 'org-hh:mm-string-to-minutes
- (plist-get pl :gap-ok-around)))
- (def-face (or (plist-get pl :default-face)
- '((:background "DarkRed") (:foreground "white"))))
- issue face m te ts dt ov)
- (goto-char (point-min))
- (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t)
- (setq issue nil face def-face)
- (catch 'next
- (setq m (org-get-at-bol 'org-marker)
- te nil ts nil)
- (unless (and m (markerp m))
- (setq issue "No valid clock line") (throw 'next t))
- (org-with-point-at m
- (save-excursion
- (goto-char (point-at-bol))
- (unless (looking-at re)
- (error "No valid Clock line")
- (throw 'next t))
- (unless (match-end 3)
- (setq issue "No end time"
- face (or (plist-get pl :no-end-time-face) face))
- (throw 'next t))
- (setq ts (match-string 1)
- te (match-string 3)
- ts (org-float-time
- (apply 'encode-time (org-parse-time-string ts)))
- te (org-float-time
- (apply 'encode-time (org-parse-time-string te)))
- dt (- te ts))))
- (cond
- ((> dt (* 60 maxtime))
- ;; a very long clocking chunk
- (setq issue (format "Clocking interval is very long: %s"
- (org-minutes-to-clocksum-string
- (floor (/ (float dt) 60.))))
- face (or (plist-get pl :long-face) face)))
- ((< dt (* 60 mintime))
- ;; a very short clocking chunk
- (setq issue (format "Clocking interval is very short: %s"
- (org-minutes-to-clocksum-string
- (floor (/ (float dt) 60.))))
- face (or (plist-get pl :short-face) face)))
- ((and (> tlend 0) (< ts tlend))
- ;; Two clock entries are overlapping
- (setq issue (format "Clocking overlap: %d minutes"
- (/ (- tlend ts) 60))
- face (or (plist-get pl :overlap-face) face)))
- ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap))))
- ;; There is a gap, lets see if we need to report it
- (unless (org-agenda-check-clock-gap tlend ts gapok)
- (setq issue (format "Clocking gap: %d minutes"
- (/ (- ts tlend) 60))
- face (or (plist-get pl :gap-face) face))))
- (t nil)))
- (setq tlend (or te tlend) tlstart (or ts tlstart))
- (when issue
- ;; OK, there was some issue, add an overlay to show the issue
- (setq ov (make-overlay (point-at-bol) (point-at-eol)))
- (overlay-put ov 'before-string
- (concat
- (org-add-props
- (format "%-43s" (concat " " issue))
- nil
- 'face face)
- "\n"))
- (overlay-put ov 'evaporate t)))))
- (defun org-agenda-check-clock-gap (t1 t2 ok-list)
- "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values."
- (catch 'exit
- (unless ok-list
- ;; there are no OK times for gaps...
- (throw 'exit nil))
- (if (> (- (/ t2 36000) (/ t1 36000)) 24)
- ;; This is more than 24 hours, so it is OK.
- ;; because we have at least one OK time, that must be in the
- ;; 24 hour interval.
- (throw 'exit t))
- ;; We have a shorter gap.
- ;; Now we have to get the minute of the day when these times are
- (let* ((t1dec (decode-time (seconds-to-time t1)))
- (t2dec (decode-time (seconds-to-time t2)))
- ;; compute the minute on the day
- (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec))))
- (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec)))))
- (when (< min2 min1)
- ;; if min2 is smaller than min1, this means it is on the next day.
- ;; Wrap it to after midnight.
- (setq min2 (+ min2 1440)))
- ;; Now check if any of the OK times is in the gap
- (mapc (lambda (x)
- ;; Wrap the time to after midnight if necessary
- (if (< x min1) (setq x (+ x 1440)))
- ;; Check if in interval
- (and (<= min1 x) (>= min2 x) (throw 'exit t)))
- ok-list)
- ;; Nope, this gap is not OK
- nil)))
- (defun org-agenda-get-deadlines (&optional with-hour)
- "Return the deadline information for agenda display.
- When WITH-HOUR is non-nil, only return deadlines with an hour
- specification like [h]h:mm."
- (let* ((props (list 'mouse-face 'highlight
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp (if with-hour
- org-deadline-time-hour-regexp
- org-deadline-time-regexp))
- (todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- (dl0 (car org-agenda-deadline-leaders))
- (dl1 (nth 1 org-agenda-deadline-leaders))
- (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1))
- d2 diff dfrac wdays pos pos1 category category-pos level
- tags suppress-prewarning ee txt head face s todo-state
- show-all upcomingp donep timestr warntime inherited-tags ts-date)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1))
- (setq suppress-prewarning
- (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled
- (let ((item (buffer-substring (point-at-bol)
- (point-at-eol))))
- (save-match-data
- (and (string-match
- org-scheduled-time-regexp item)
- (match-string 1 item)))))))
- (cond
- ((not ds) nil)
- ;; The current item has a scheduled date (in ds), so
- ;; evaluate its prewarning lead time.
- ((integerp org-agenda-skip-deadline-prewarning-if-scheduled)
- ;; Use global prewarning-restart lead time.
- org-agenda-skip-deadline-prewarning-if-scheduled)
- ((eq org-agenda-skip-deadline-prewarning-if-scheduled
- 'pre-scheduled)
- ;; Set prewarning to no earlier than scheduled.
- (min (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-deadline-warning-days))
- ;; Set prewarning to deadline.
- (t 0))))
- (setq wdays (if suppress-prewarning
- (let ((org-deadline-warning-days suppress-prewarning))
- (org-get-wdays s))
- (org-get-wdays s))
- dfrac (- 1 (/ (* 1.0 diff) (max wdays 1)))
- upcomingp (and todayp (> diff 0)))
- ;; When to show a deadline in the calendar:
- ;; If the expiration is within wdays warning time.
- ;; Past-due deadlines are only shown on the current date
- (if (and (or (and (<= diff wdays)
- (and todayp (not org-agenda-only-exact-dates)))
- (= diff 0)))
- (save-excursion
- ;; (setq todo-state (org-get-todo-state))
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
- (or org-agenda-skip-deadline-if-done
- (not (= diff 0))))
- (setq txt nil)
- (setq category (org-get-category)
- warntime (get-text-property (point) 'org-appt-warntime)
- category-pos (get-text-property (point) 'org-category-position))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (setq inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at pos1 (not inherited-tags)))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n")
- (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (cond ((= diff 0) dl0)
- ((> diff 0)
- (if (functionp dl1)
- (funcall dl1 diff date)
- (format dl1 diff)))
- (t
- (if (functionp dl2)
- (funcall dl2 diff date)
- (format dl2 (if (string= dl2 dl1)
- diff (abs diff))))))
- head level category tags
- (if (not (= diff 0)) nil timestr)))))
- (when txt
- (setq face (org-agenda-deadline-face dfrac))
- (org-add-props txt props
- 'org-marker (org-agenda-new-marker pos)
- 'warntime warntime
- 'level level
- 'ts-date d2
- 'org-hd-marker (org-agenda-new-marker pos1)
- 'priority (+ (- diff)
- (org-get-priority txt))
- 'org-category category
- 'org-category-position category-pos
- 'todo-state todo-state
- 'type (if upcomingp "upcoming-deadline" "deadline")
- 'date (if upcomingp date d2)
- 'face (if donep 'org-agenda-done face)
- 'undone-face face 'done-face 'org-agenda-done)
- (push txt ee))))))
- (nreverse ee)))
- (defun org-agenda-deadline-face (fraction)
- "Return the face to displaying a deadline item.
- FRACTION is what fraction of the head-warning time has passed."
- (let ((faces org-agenda-deadline-faces) f)
- (catch 'exit
- (while (setq f (pop faces))
- (if (>= fraction (car f)) (throw 'exit (cdr f)))))))
- (defun org-agenda-get-scheduled (&optional deadline-results with-hour)
- "Return the scheduled information for agenda display.
- When WITH-HOUR is non-nil, only return scheduled items with
- an hour specification like [h]h:mm."
- (let* ((props (list 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'done-face 'org-agenda-done
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp (if with-hour
- org-scheduled-time-hour-regexp
- org-scheduled-time-regexp))
- (todayp (org-agenda-todayp date)) ; DATE bound by calendar
- (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar
- mm
- (deadline-position-alist
- (mapcar (lambda (a) (and (setq mm (get-text-property
- 0 'org-hd-marker a))
- (cons (marker-position mm) a)))
- deadline-results))
- d2 diff pos pos1 category category-pos level tags donep
- ee txt head pastschedp todo-state face timestr s habitp show-all
- did-habit-check-p warntime inherited-tags ts-date suppress-delay
- ddays)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq s (match-string 1)
- txt nil
- pos (1- (match-beginning 1))
- todo-state (save-match-data (org-get-todo-state))
- show-all (or (eq org-agenda-repeating-timestamp-show-all t)
- (member todo-state
- org-agenda-repeating-timestamp-show-all))
- d2 (org-time-string-to-absolute
- s d1 'past show-all (current-buffer) pos)
- diff (- d2 d1)
- warntime (get-text-property (point) 'org-appt-warntime))
- (setq pastschedp (and todayp (< diff 0)))
- (setq did-habit-check-p nil)
- (setq suppress-delay
- (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline
- (let ((item (buffer-substring (point-at-bol) (point-at-eol))))
- (save-match-data
- (and (string-match
- org-deadline-time-regexp item)
- (match-string 1 item)))))))
- (cond
- ((not ds) nil)
- ;; The current item has a deadline date (in ds), so
- ;; evaluate its delay time.
- ((integerp org-agenda-skip-scheduled-delay-if-deadline)
- ;; Use global delay time.
- (- org-agenda-skip-scheduled-delay-if-deadline))
- ((eq org-agenda-skip-scheduled-delay-if-deadline
- 'post-deadline)
- ;; Set delay to no later than deadline.
- (min (- d2 (org-time-string-to-absolute
- ds d1 'past show-all (current-buffer) pos))
- org-scheduled-delay-days))
- (t 0))))
- (setq ddays (if suppress-delay
- (let ((org-scheduled-delay-days suppress-delay))
- (org-get-wdays s t t))
- (org-get-wdays s t)))
- ;; Use a delay of 0 when there is a repeater and the delay is
- ;; of the form --3d
- (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s))
- (< (org-time-string-to-absolute s)
- (org-time-string-to-absolute
- s d2 'past nil (current-buffer) pos)))
- (setq ddays 0))
- ;; When to show a scheduled item in the calendar:
- ;; If it is on or past the date.
- (when (or (and (> ddays 0) (= diff (- ddays)))
- (and (zerop ddays) (= diff 0))
- (and (< (+ diff ddays) 0)
- (< (abs diff) org-scheduled-past-days)
- (and todayp (not org-agenda-only-exact-dates)))
- ;; org-is-habit-p uses org-entry-get, which is expansive
- ;; so we go extra mile to only call it once
- (and todayp
- (boundp 'org-habit-show-all-today)
- org-habit-show-all-today
- (setq did-habit-check-p t)
- (setq habitp (and (functionp 'org-is-habit-p)
- (org-is-habit-p)))))
- (save-excursion
- (setq donep (member todo-state org-done-keywords))
- (if (and donep
- (or org-agenda-skip-scheduled-if-done
- (not (= diff 0))
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq txt nil)
- (setq habitp (if did-habit-check-p habitp
- (and (functionp 'org-is-habit-p)
- (org-is-habit-p))))
- (setq category (org-get-category)
- category-pos (get-text-property (point) 'org-category-position))
- (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown
- 'repeated-after-deadline)
- (<= 0 (- d2 (time-to-days (org-get-deadline-time (point))))))
- (throw :skip nil))
- (if (not (re-search-backward "^\\*+[ \t]+" nil t))
- (throw :skip nil)
- (goto-char (match-end 0))
- (setq pos1 (match-beginning 0))
- (if habitp
- (if (or (not org-habit-show-habits)
- (and (not todayp)
- (boundp 'org-habit-show-habits-only-for-today)
- org-habit-show-habits-only-for-today))
- (throw :skip nil))
- (if (and
- (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown)
- (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today)
- pastschedp))
- (setq mm (assoc pos1 deadline-position-alist)))
- (throw :skip nil)))
- (setq inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags)))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (setq head (buffer-substring
- (point)
- (progn (skip-chars-forward "^\r\n") (point))))
- (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (setq timestr
- (concat (substring s (match-beginning 1)) " "))
- (setq timestr 'time))
- (setq txt (org-agenda-format-item
- (if (= diff 0)
- (car org-agenda-scheduled-leaders)
- (format (nth 1 org-agenda-scheduled-leaders)
- (- 1 diff)))
- head level category tags
- (if (not (= diff 0)) nil timestr)
- nil habitp))))
- (when txt
- (setq face
- (cond
- ((and (not habitp) pastschedp)
- 'org-scheduled-previously)
- (todayp 'org-scheduled-today)
- (t 'org-scheduled))
- habitp (and habitp (org-habit-parse-todo)))
- (org-add-props txt props
- 'undone-face face
- 'face (if donep 'org-agenda-done face)
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker pos1)
- 'type (if pastschedp "past-scheduled" "scheduled")
- 'date (if pastschedp d2 date)
- 'ts-date d2
- 'warntime warntime
- 'level level
- 'priority (if habitp
- (org-habit-get-priority habitp)
- (+ 94 (- 5 diff) (org-get-priority txt)))
- 'org-category category
- 'category-position category-pos
- 'org-habit-p habitp
- 'todo-state todo-state)
- (push txt ee))))))
- (nreverse ee)))
- (defun org-agenda-get-blocks ()
- "Return the date-range information for agenda display."
- (let* ((props (list 'face nil
- 'org-not-done-regexp org-not-done-regexp
- 'org-todo-regexp org-todo-regexp
- 'org-complex-heading-regexp org-complex-heading-regexp
- 'mouse-face 'highlight
- 'help-echo
- (format "mouse-2 or RET jump to org file %s"
- (abbreviate-file-name buffer-file-name))))
- (regexp org-tr-regexp)
- (d0 (calendar-absolute-from-gregorian date))
- marker hdmarker ee txt d1 d2 s1 s2 category category-pos
- level todo-state tags pos head donep inherited-tags)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (org-agenda-skip)
- (setq pos (point))
- (let ((start-time (match-string 1))
- (end-time (match-string 2)))
- (setq s1 (match-string 1)
- s2 (match-string 2)
- d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos))
- d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos)))
- (if (and (> (- d0 d1) -1) (> (- d2 d0) -1))
- ;; Only allow days between the limits, because the normal
- ;; date stamps will catch the limits.
- (save-excursion
- (setq todo-state (org-get-todo-state))
- (setq donep (member todo-state org-done-keywords))
- (if (and donep org-agenda-skip-timestamp-if-done)
- (throw :skip t))
- (setq marker (org-agenda-new-marker (point)))
- (setq category (org-get-category)
- category-pos (get-text-property (point) 'org-category-position))
- (if (not (re-search-backward org-outline-regexp-bol nil t))
- (throw :skip nil)
- (goto-char (match-beginning 0))
- (setq hdmarker (org-agenda-new-marker (point))
- inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (listp org-agenda-show-inherited-tags)
- (memq 'agenda org-agenda-show-inherited-tags))
- (and (eq org-agenda-show-inherited-tags t)
- (or (eq org-agenda-use-tag-inheritance t)
- (memq 'agenda org-agenda-use-tag-inheritance))))
- tags (org-get-tags-at nil (not inherited-tags)))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\([^\r\n]+\\)")
- (setq head (match-string 1))
- (let ((remove-re
- (if org-agenda-remove-timeranges-from-blocks
- (concat
- "<" (regexp-quote s1) ".*?>"
- "--"
- "<" (regexp-quote s2) ".*?>")
- nil)))
- (setq txt (org-agenda-format-item
- (format
- (nth (if (= d1 d2) 0 1)
- org-agenda-timerange-leaders)
- (1+ (- d0 d1)) (1+ (- d2 d1)))
- head level category tags
- (cond ((and (= d1 d0) (= d2 d0))
- (concat "<" start-time ">--<" end-time ">"))
- ((= d1 d0)
- (concat "<" start-time ">"))
- ((= d2 d0)
- (concat "<" end-time ">")))
- remove-re))))
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker hdmarker
- 'type "block" 'date date
- 'level level
- 'todo-state todo-state
- 'priority (org-get-priority txt) 'org-category category
- 'org-category-position category-pos)
- (push txt ee))))
- (goto-char pos)))
- ;; Sort the entries by expiration date.
- (nreverse ee)))
- ;;; Agenda presentation and sorting
- (defvar org-prefix-has-time nil
- "A flag, set by `org-compile-prefix-format'.
- The flag is set if the currently compiled format contains a `%t'.")
- (defvar org-prefix-has-tag nil
- "A flag, set by `org-compile-prefix-format'.
- The flag is set if the currently compiled format contains a `%T'.")
- (defvar org-prefix-has-effort nil
- "A flag, set by `org-compile-prefix-format'.
- The flag is set if the currently compiled format contains a `%e'.")
- (defvar org-prefix-has-breadcrumbs nil
- "A flag, set by `org-compile-prefix-format'.
- The flag is set if the currently compiled format contains a `%b'.")
- (defvar org-prefix-category-length nil
- "Used by `org-compile-prefix-format' to remember the category field width.")
- (defvar org-prefix-category-max-length nil
- "Used by `org-compile-prefix-format' to remember the category field width.")
- (defun org-agenda-get-category-icon (category)
- "Return an image for CATEGORY according to `org-agenda-category-icon-alist'."
- (dolist (entry org-agenda-category-icon-alist)
- (when (org-string-match-p (car entry) category)
- (if (listp (cadr entry))
- (return (cadr entry))
- (return (apply 'create-image (cdr entry)))))))
- (defun org-agenda-format-item (extra txt &optional level category tags dotime
- remove-re habitp)
- "Format TXT to be inserted into the agenda buffer.
- In particular, add the prefix and corresponding text properties.
- EXTRA must be a string to replace the `%s' specifier in the prefix format.
- LEVEL may be a string to replace the `%l' specifier.
- CATEGORY (a string, a symbol or nil) may be used to overrule the default
- category taken from local variable or file name. It will replace the `%c'
- specifier in the format.
- DOTIME, when non-nil, indicates that a time-of-day should be extracted from
- TXT for sorting of this entry, and for the `%t' specifier in the format.
- When DOTIME is a string, this string is searched for a time before TXT is.
- TAGS can be the tags of the headline.
- Any match of REMOVE-RE will be removed from TXT."
- ;; We keep the org-prefix-* variable values along with a compiled
- ;; formatter, so that multiple agendas existing at the same time do
- ;; not step on each other toes.
- ;;
- ;; It was inconvenient to make these variables buffer local in
- ;; Agenda buffers, because this function expects to be called with
- ;; the buffer where item comes from being current, and not agenda
- ;; buffer
- (let* ((bindings (car org-prefix-format-compiled))
- (formatter (cadr org-prefix-format-compiled)))
- (loop for (var value) in bindings
- do (set var value))
- (save-match-data
- ;; Diary entries sometimes have extra whitespace at the beginning
- (setq txt (org-trim txt))
- ;; Fix the tags part in txt
- (setq txt (org-agenda-fix-displayed-tags
- txt tags
- org-agenda-show-inherited-tags
- org-agenda-hide-tags-regexp))
- (let* ((category (or category
- (if (stringp org-category)
- org-category
- (and org-category (symbol-name org-category)))
- (if buffer-file-name
- (file-name-sans-extension
- (file-name-nondirectory buffer-file-name))
- "")))
- (category-icon (org-agenda-get-category-icon category))
- (category-icon (if category-icon
- (propertize " " 'display category-icon)
- ""))
- ;; time, tag, effort are needed for the eval of the prefix format
- (tag (if tags (nth (1- (length tags)) tags) ""))
- time effort neffort
- (ts (if dotime (concat
- (if (stringp dotime) dotime "")
- (and org-agenda-search-headline-for-time txt))))
- (time-of-day (and dotime (org-get-time-of-day ts)))
- stamp plain s0 s1 s2 rtn srp l
- duration thecategory breadcrumbs)
- (and (derived-mode-p 'org-mode) buffer-file-name
- (add-to-list 'org-agenda-contributing-files buffer-file-name))
- (when (and dotime time-of-day)
- ;; Extract starting and ending time and move them to prefix
- (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts))
- (setq plain (string-match org-plain-time-of-day-regexp ts)))
- (setq s0 (match-string 0 ts)
- srp (and stamp (match-end 3))
- s1 (match-string (if plain 1 2) ts)
- s2 (match-string (if plain 8 (if srp 4 6)) ts))
- ;; If the times are in TXT (not in DOTIMES), and the prefix will list
- ;; them, we might want to remove them there to avoid duplication.
- ;; The user can turn this off with a variable.
- (if (and org-prefix-has-time
- org-agenda-remove-times-when-in-prefix (or stamp plain)
- (string-match (concat (regexp-quote s0) " *") txt)
- (not (equal ?\] (string-to-char (substring txt (match-end 0)))))
- (if (eq org-agenda-remove-times-when-in-prefix 'beg)
- (= (match-beginning 0) 0)
- t))
- (setq txt (replace-match "" nil nil txt))))
- ;; Normalize the time(s) to 24 hour
- (if s1 (setq s1 (org-get-time-of-day s1 'string t)))
- (if s2 (setq s2 (org-get-time-of-day s2 'string t)))
- ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set
- (let (org-time-clocksum-use-effort-durations)
- (when (and s1 (not s2) org-agenda-default-appointment-duration)
- (setq s2
- (org-minutes-to-clocksum-string
- (+ (org-hh:mm-string-to-minutes s1)
- org-agenda-default-appointment-duration)))))
- ;; Compute the duration
- (when s2
- (setq duration (- (org-hh:mm-string-to-minutes s2)
- (org-hh:mm-string-to-minutes s1)))))
- (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- txt)
- ;; Tags are in the string
- (if (or (eq org-agenda-remove-tags t)
- (and org-agenda-remove-tags
- org-prefix-has-tag))
- (setq txt (replace-match "" t t txt))
- (setq txt (replace-match
- (concat (make-string (max (- 50 (length txt)) 1) ?\ )
- (match-string 2 txt))
- t t txt))))
- (when (derived-mode-p 'org-mode)
- (setq effort (ignore-errors (get-text-property 0 'org-effort txt))))
- ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as
- ;; current buffer, so move this check outside of above
- (if effort
- (setq neffort (org-duration-string-to-minutes effort)
- effort (setq effort (concat "[" effort "]")))
- ;; prevent erroring out with %e format when there is no effort
- (setq effort ""))
- (when remove-re
- (while (string-match remove-re txt)
- (setq txt (replace-match "" t t txt))))
- ;; Set org-heading property on `txt' to mark the start of the
- ;; heading.
- (add-text-properties 0 (length txt) '(org-heading t) txt)
- ;; Prepare the variables needed in the eval of the compiled format
- (if org-prefix-has-breadcrumbs
- (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
- (let ((s (org-display-outline-path nil nil "->" t)))
- (if (eq "" s) "" (concat s "->"))))))
- (setq time (cond (s2 (concat
- (org-agenda-time-of-day-to-ampm-maybe s1)
- "-" (org-agenda-time-of-day-to-ampm-maybe s2)
- (if org-agenda-timegrid-use-ampm " ")))
- (s1 (concat
- (org-agenda-time-of-day-to-ampm-maybe s1)
- (if org-agenda-timegrid-use-ampm
- "........ "
- "......")))
- (t ""))
- extra (or (and (not habitp) extra) "")
- category (if (symbolp category) (symbol-name category) category)
- thecategory (copy-sequence category)
- level (or level ""))
- (if (string-match org-bracket-link-regexp category)
- (progn
- (setq l (if (match-end 3)
- (- (match-end 3) (match-beginning 3))
- (- (match-end 1) (match-beginning 1))))
- (when (< l (or org-prefix-category-length 0))
- (setq category (copy-sequence category))
- (org-add-props category nil
- 'extra-space (make-string
- (- org-prefix-category-length l 1) ?\ ))))
- (if (and org-prefix-category-max-length
- (>= (length category) org-prefix-category-max-length))
- (setq category (substring category 0 (1- org-prefix-category-max-length)))))
- ;; Evaluate the compiled format
- (setq rtn (concat (eval formatter) txt))
- ;; And finally add the text properties
- (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn)
- (org-add-props rtn nil
- 'org-category (if thecategory (downcase thecategory) category)
- 'tags (mapcar 'org-downcase-keep-props tags)
- 'org-highest-priority org-highest-priority
- 'org-lowest-priority org-lowest-priority
- 'time-of-day time-of-day
- 'duration duration
- 'effort effort
- 'effort-minutes neffort
- 'breadcrumbs breadcrumbs
- 'txt txt
- 'level level
- 'time time
- 'extra extra
- 'format org-prefix-format-compiled
- 'dotime dotime)))))
- (defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re)
- "Remove tags string from TXT, and add a modified list of tags.
- The modified list may contain inherited tags, and tags matched by
- `org-agenda-hide-tags-regexp' will be removed."
- (when (or add-inherited hide-re)
- (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt)
- (setq txt (substring txt 0 (match-beginning 0))))
- (setq tags
- (delq nil
- (mapcar (lambda (tg)
- (if (or (and hide-re (string-match hide-re tg))
- (and (not add-inherited)
- (get-text-property 0 'inherited tg)))
- nil
- tg))
- tags)))
- (when tags
- (let ((have-i (get-text-property 0 'inherited (car tags)))
- i)
- (setq txt (concat txt " :"
- (mapconcat
- (lambda (x)
- (setq i (get-text-property 0 'inherited x))
- (if (and have-i (not i))
- (progn
- (setq have-i nil)
- (concat ":" x))
- x))
- tags ":")
- (if have-i "::" ":"))))))
- txt)
- (defun org-downcase-keep-props (s)
- (let ((props (text-properties-at 0 s)))
- (setq s (downcase s))
- (add-text-properties 0 (length s) props s)
- s))
- (defvar org-agenda-sorting-strategy) ;; because the def is in a let form
- (defun org-agenda-add-time-grid-maybe (list ndays todayp)
- "Add a time-grid for agenda items which need it.
- LIST is the list of agenda items formatted by `org-agenda-list'.
- NDAYS is the span of the current agenda view.
- TODAYP is `t' when the current agenda view is on today."
- (catch 'exit
- (cond ((not org-agenda-use-time-grid) (throw 'exit list))
- ((and todayp (member 'today (car org-agenda-time-grid))))
- ((and (= ndays 1) (member 'daily (car org-agenda-time-grid))))
- ((member 'weekly (car org-agenda-time-grid)))
- (t (throw 'exit list)))
- (let* ((have (delq nil (mapcar
- (lambda (x) (get-text-property 1 'time-of-day x))
- list)))
- (string (nth 1 org-agenda-time-grid))
- (gridtimes (nth 2 org-agenda-time-grid))
- (req (car org-agenda-time-grid))
- (remove (member 'remove-match req))
- new time)
- (if (and (member 'require-timed req) (not have))
- ;; don't show empty grid
- (throw 'exit list))
- (while (setq time (pop gridtimes))
- (unless (and remove (member time have))
- (setq time (replace-regexp-in-string " " "0" (format "%04s" time)))
- (push (org-agenda-format-item
- nil string nil "" nil
- (concat (substring time 0 -2) ":" (substring time -2)))
- new)
- (put-text-property
- 2 (length (car new)) 'face 'org-time-grid (car new))))
- (when (and todayp org-agenda-show-current-time-in-grid)
- (push (org-agenda-format-item
- nil org-agenda-current-time-string nil "" nil
- (format-time-string "%H:%M "))
- new)
- (put-text-property
- 2 (length (car new)) 'face 'org-agenda-current-time (car new)))
- (if (member 'time-up org-agenda-sorting-strategy-selected)
- (append new list)
- (append list new)))))
- (defun org-compile-prefix-format (key)
- "Compile the prefix format into a Lisp form that can be evaluated.
- The resulting form and associated variable bindings is returned
- and stored in the variable `org-prefix-format-compiled'."
- (setq org-prefix-has-time nil
- org-prefix-has-tag nil
- org-prefix-category-length nil
- org-prefix-has-effort nil
- org-prefix-has-breadcrumbs nil)
- (let ((s (cond
- ((stringp org-agenda-prefix-format)
- org-agenda-prefix-format)
- ((assq key org-agenda-prefix-format)
- (cdr (assq key org-agenda-prefix-format)))
- (t " %-12:c%?-12t% s")))
- (start 0)
- varform vars var e c f opt)
- (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)"
- s start)
- (setq var (or (cdr (assoc (match-string 4 s)
- '(("c" . category) ("t" . time) ("l" . level) ("s" . extra)
- ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs))))
- 'eval)
- c (or (match-string 3 s) "")
- opt (match-beginning 1)
- start (1+ (match-beginning 0)))
- (if (equal var 'time) (setq org-prefix-has-time t))
- (if (equal var 'tag) (setq org-prefix-has-tag t))
- (if (equal var 'effort) (setq org-prefix-has-effort t))
- (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t))
- (setq f (concat "%" (match-string 2 s) "s"))
- (when (equal var 'category)
- (setq org-prefix-category-length
- (floor (abs (string-to-number (match-string 2 s)))))
- (setq org-prefix-category-max-length
- (let ((x (match-string 2 s)))
- (save-match-data
- (if (string-match "\\.[0-9]+" x)
- (string-to-number (substring (match-string 0 x) 1)))))))
- (if (eq var 'eval)
- (setq varform `(format ,f (org-eval ,(read (match-string 4 s)))))
- (if opt
- (setq varform
- `(if (equal "" ,var)
- ""
- (format ,f (if (equal "" ,var) "" (concat ,var ,c)))))
- (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
- (setq s (replace-match "%s" t nil s))
- (push varform vars))
- (setq vars (nreverse vars))
- (with-current-buffer (or org-agenda-buffer (current-buffer))
- (setq org-prefix-format-compiled
- (list
- `((org-prefix-has-time ,org-prefix-has-time)
- (org-prefix-has-tag ,org-prefix-has-tag)
- (org-prefix-category-length ,org-prefix-category-length)
- (org-prefix-has-effort ,org-prefix-has-effort)
- (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs))
- `(format ,s ,@vars))))))
- (defun org-set-sorting-strategy (key)
- (if (symbolp (car org-agenda-sorting-strategy))
- ;; the old format
- (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy)
- (setq org-agenda-sorting-strategy-selected
- (or (cdr (assq key org-agenda-sorting-strategy))
- (cdr (assq 'agenda org-agenda-sorting-strategy))
- '(time-up category-keep priority-down)))))
- (defun org-get-time-of-day (s &optional string mod24)
- "Check string S for a time of day.
- If found, return it as a military time number between 0 and 2400.
- If not found, return nil.
- The optional STRING argument forces conversion into a 5 character wide string
- HH:MM."
- (save-match-data
- (when
- (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s)
- (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s))
- (let* ((h (string-to-number (match-string 1 s)))
- (m (if (match-end 3) (string-to-number (match-string 3 s)) 0))
- (ampm (if (match-end 4) (downcase (match-string 4 s))))
- (am-p (equal ampm "am"))
- (h1 (cond ((not ampm) h)
- ((= h 12) (if am-p 0 12))
- (t (+ h (if am-p 0 12)))))
- (h2 (if (and string mod24 (not (and (= m 0) (= h1 24))))
- (mod h1 24) h1))
- (t0 (+ (* 100 h2) m))
- (t1 (concat (if (>= h1 24) "+" " ")
- (if (and org-agenda-time-leading-zero
- (< t0 1000)) "0" "")
- (if (< t0 100) "0" "")
- (if (< t0 10) "0" "")
- (int-to-string t0))))
- (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0)))))
- (defvar org-agenda-before-sorting-filter-function nil
- "Function to be applied to agenda items prior to sorting.
- Prior to sorting also means just before they are inserted into the agenda.
- To aid sorting, you may revisit the original entries and add more text
- properties which will later be used by the sorting functions.
- The function should take a string argument, an agenda line.
- It has access to the text properties in that line, which contain among
- other things, the property `org-hd-marker' that points to the entry
- where the line comes from. Note that not all lines going into the agenda
- have this property, only most.
- The function should return the modified string. It is probably best
- to ONLY change text properties.
- You can also use this function as a filter, by returning nil for lines
- you don't want to have in the agenda at all. For this application, you
- could bind the variable in the options section of a custom command.")
- (defun org-agenda-finalize-entries (list &optional type)
- "Sort, limit and concatenate the LIST of agenda items.
- The optional argument TYPE tells the agenda type."
- (let ((max-effort (cond ((listp org-agenda-max-effort)
- (cdr (assoc type org-agenda-max-effort)))
- (t org-agenda-max-effort)))
- (max-todo (cond ((listp org-agenda-max-todos)
- (cdr (assoc type org-agenda-max-todos)))
- (t org-agenda-max-todos)))
- (max-tags (cond ((listp org-agenda-max-tags)
- (cdr (assoc type org-agenda-max-tags)))
- (t org-agenda-max-tags)))
- (max-entries (cond ((listp org-agenda-max-entries)
- (cdr (assoc type org-agenda-max-entries)))
- (t org-agenda-max-entries))) l)
- (when org-agenda-before-sorting-filter-function
- (setq list
- (delq nil
- (mapcar
- org-agenda-before-sorting-filter-function list))))
- (setq list (mapcar 'org-agenda-highlight-todo list)
- list (mapcar 'identity (sort list 'org-entries-lessp)))
- (when max-effort
- (setq list (org-agenda-limit-entries
- list 'effort-minutes max-effort 'identity)))
- (when max-todo
- (setq list (org-agenda-limit-entries list 'todo-state max-todo)))
- (when max-tags
- (setq list (org-agenda-limit-entries list 'tags max-tags)))
- (when max-entries
- (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries)))
- (mapconcat 'identity list "\n")))
- (defun org-agenda-limit-entries (list prop limit &optional fn)
- "Limit the number of agenda entries."
- (let ((include (and limit (< limit 0))))
- (if limit
- (let ((fun (or fn (lambda (p) (if p 1))))
- (lim 0))
- (delq nil
- (mapcar
- (lambda (e)
- (let ((pval (funcall fun (get-text-property 1 prop e))))
- (if pval (setq lim (+ lim pval)))
- (cond ((and pval (<= lim (abs limit))) e)
- ((and include (not pval)) e))))
- list)))
- list)))
- (defun org-agenda-limit-interactively ()
- "In agenda, interactively limit entries to various maximums."
- (interactive)
- (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
- (num (string-to-number (read-from-minibuffer "How many? "))))
- (cond ((equal max ?e)
- (let ((org-agenda-max-entries num)) (org-agenda-redo)))
- ((equal max ?t)
- (let ((org-agenda-max-todos num)) (org-agenda-redo)))
- ((equal max ?T)
- (let ((org-agenda-max-tags num)) (org-agenda-redo)))
- ((equal max ?E)
- (let ((org-agenda-max-effort num)) (org-agenda-redo)))))
- (org-agenda-fit-window-to-buffer))
- (defun org-agenda-highlight-todo (x)
- (let ((org-done-keywords org-done-keywords-for-agenda)
- (case-fold-search nil)
- re)
- (if (eq x 'line)
- (save-excursion
- (beginning-of-line 1)
- (setq re (org-get-at-bol 'org-todo-regexp))
- (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point)))
- (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +"))
- (add-text-properties (match-beginning 0) (match-end 1)
- (list 'face (org-get-todo-face 1)))
- (let ((s (buffer-substring (match-beginning 1) (match-end 1))))
- (delete-region (match-beginning 1) (1- (match-end 0)))
- (goto-char (match-beginning 1))
- (insert (format org-agenda-todo-keyword-format s)))))
- (let ((pl (text-property-any 0 (length x) 'org-heading t x)))
- (setq re (get-text-property 0 'org-todo-regexp x))
- (when (and re
- ;; Test `pl' because if there's no heading content,
- ;; there's no point matching to highlight. Note
- ;; that if we didn't test `pl' first, and there
- ;; happened to be no keyword from `org-todo-regexp'
- ;; on this heading line, then the `equal' comparison
- ;; afterwards would spuriously succeed in the case
- ;; where `pl' is nil -- causing an args-out-of-range
- ;; error when we try to add text properties to text
- ;; that isn't there.
- pl
- (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)")
- x pl) pl))
- (add-text-properties
- (or (match-end 1) (match-end 0)) (match-end 0)
- (list 'face (org-get-todo-face (match-string 2 x)))
- x)
- (when (match-end 1)
- (setq x (concat (substring x 0 (match-end 1))
- (format org-agenda-todo-keyword-format
- (match-string 2 x))
- (org-add-props " " (text-properties-at 0 x))
- (substring x (match-end 3)))))))
- x)))
- (defsubst org-cmp-priority (a b)
- "Compare the priorities of string A and B."
- (let ((pa (or (get-text-property 1 'priority a) 0))
- (pb (or (get-text-property 1 'priority b) 0)))
- (cond ((> pa pb) +1)
- ((< pa pb) -1))))
- (defsubst org-cmp-effort (a b)
- "Compare the effort values of string A and B."
- (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1))
- (ea (or (get-text-property 1 'effort-minutes a) def))
- (eb (or (get-text-property 1 'effort-minutes b) def)))
- (cond ((> ea eb) +1)
- ((< ea eb) -1))))
- (defsubst org-cmp-category (a b)
- "Compare the string values of categories of strings A and B."
- (let ((ca (or (get-text-property 1 'org-category a) ""))
- (cb (or (get-text-property 1 'org-category b) "")))
- (cond ((string-lessp ca cb) -1)
- ((string-lessp cb ca) +1))))
- (defsubst org-cmp-todo-state (a b)
- "Compare the todo states of strings A and B."
- (let* ((ma (or (get-text-property 1 'org-marker a)
- (get-text-property 1 'org-hd-marker a)))
- (mb (or (get-text-property 1 'org-marker b)
- (get-text-property 1 'org-hd-marker b)))
- (fa (and ma (marker-buffer ma)))
- (fb (and mb (marker-buffer mb)))
- (todo-kwds
- (or (and fa (with-current-buffer fa org-todo-keywords-1))
- (and fb (with-current-buffer fb org-todo-keywords-1))))
- (ta (or (get-text-property 1 'todo-state a) ""))
- (tb (or (get-text-property 1 'todo-state b) ""))
- (la (- (length (member ta todo-kwds))))
- (lb (- (length (member tb todo-kwds))))
- (donepa (member ta org-done-keywords-for-agenda))
- (donepb (member tb org-done-keywords-for-agenda)))
- (cond ((and donepa (not donepb)) -1)
- ((and (not donepa) donepb) +1)
- ((< la lb) -1)
- ((< lb la) +1))))
- (defsubst org-cmp-alpha (a b)
- "Compare the headlines, alphabetically."
- (let* ((pla (text-property-any 0 (length a) 'org-heading t a))
- (plb (text-property-any 0 (length b) 'org-heading t b))
- (ta (and pla (substring a pla)))
- (tb (and plb (substring b plb))))
- (when pla
- (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "")
- "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta)
- (setq ta (substring ta (match-end 0))))
- (setq ta (downcase ta)))
- (when plb
- (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "")
- "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb)
- (setq tb (substring tb (match-end 0))))
- (setq tb (downcase tb)))
- (cond ((not ta) +1)
- ((not tb) -1)
- ((string-lessp ta tb) -1)
- ((string-lessp tb ta) +1))))
- (defsubst org-cmp-tag (a b)
- "Compare the string values of the first tags of A and B."
- (let ((ta (car (last (get-text-property 1 'tags a))))
- (tb (car (last (get-text-property 1 'tags b)))))
- (cond ((not ta) +1)
- ((not tb) -1)
- ((string-lessp ta tb) -1)
- ((string-lessp tb ta) +1))))
- (defsubst org-cmp-time (a b)
- "Compare the time-of-day values of strings A and B."
- (let* ((def (if org-sort-agenda-notime-is-late 9901 -1))
- (ta (or (get-text-property 1 'time-of-day a) def))
- (tb (or (get-text-property 1 'time-of-day b) def)))
- (cond ((< ta tb) -1)
- ((< tb ta) +1))))
- (defsubst org-cmp-ts (a b &optional type)
- "Compare the timestamps values of entries A and B.
- When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or
- \"timestamp_ia\", compare within each of these type. When TYPE
- is the empty string, compare all timestamps without respect of
- their type."
- (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1))
- (ta (or (and (string-match type (or (get-text-property 1 'type a) ""))
- (get-text-property 1 'ts-date a)) def))
- (tb (or (and (string-match type (or (get-text-property 1 'type b) ""))
- (get-text-property 1 'ts-date b)) def)))
- (cond ((< ta tb) -1)
- ((< tb ta) +1))))
- (defsubst org-cmp-habit-p (a b)
- "Compare the todo states of strings A and B."
- (let ((ha (get-text-property 1 'org-habit-p a))
- (hb (get-text-property 1 'org-habit-p b)))
- (cond ((and ha (not hb)) -1)
- ((and (not ha) hb) +1))))
- (defun org-entries-lessp (a b)
- "Predicate for sorting agenda entries."
- ;; The following variables will be used when the form is evaluated.
- ;; So even though the compiler complains, keep them.
- (let* ((ss org-agenda-sorting-strategy-selected)
- (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss)
- (org-cmp-ts a b "")))
- (timestamp-down (if timestamp-up (- timestamp-up) nil))
- (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss)
- (org-cmp-ts a b "scheduled")))
- (scheduled-down (if scheduled-up (- scheduled-up) nil))
- (deadline-up (and (org-em 'deadline-up 'deadline-down ss)
- (org-cmp-ts a b "deadline")))
- (deadline-down (if deadline-up (- deadline-up) nil))
- (tsia-up (and (org-em 'tsia-up 'tsia-down ss)
- (org-cmp-ts a b "iatimestamp_ia")))
- (tsia-down (if tsia-up (- tsia-up) nil))
- (ts-up (and (org-em 'ts-up 'ts-down ss)
- (org-cmp-ts a b "timestamp")))
- (ts-down (if ts-up (- ts-up) nil))
- (time-up (and (org-em 'time-up 'time-down ss)
- (org-cmp-time a b)))
- (time-down (if time-up (- time-up) nil))
- (priority-up (and (org-em 'priority-up 'priority-down ss)
- (org-cmp-priority a b)))
- (priority-down (if priority-up (- priority-up) nil))
- (effort-up (and (org-em 'effort-up 'effort-down ss)
- (org-cmp-effort a b)))
- (effort-down (if effort-up (- effort-up) nil))
- (category-up (and (or (org-em 'category-up 'category-down ss)
- (memq 'category-keep ss))
- (org-cmp-category a b)))
- (category-down (if category-up (- category-up) nil))
- (category-keep (if category-up +1 nil))
- (tag-up (and (org-em 'tag-up 'tag-down ss)
- (org-cmp-tag a b)))
- (tag-down (if tag-up (- tag-up) nil))
- (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss)
- (org-cmp-todo-state a b)))
- (todo-state-down (if todo-state-up (- todo-state-up) nil))
- (habit-up (and (org-em 'habit-up 'habit-down ss)
- (org-cmp-habit-p a b)))
- (habit-down (if habit-up (- habit-up) nil))
- (alpha-up (and (org-em 'alpha-up 'alpha-down ss)
- (org-cmp-alpha a b)))
- (alpha-down (if alpha-up (- alpha-up) nil))
- (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss))
- user-defined-up user-defined-down)
- (if (and need-user-cmp org-agenda-cmp-user-defined
- (functionp org-agenda-cmp-user-defined))
- (setq user-defined-up
- (funcall org-agenda-cmp-user-defined a b)
- user-defined-down (if user-defined-up (- user-defined-up) nil)))
- (cdr (assoc
- (eval (cons 'or org-agenda-sorting-strategy-selected))
- '((-1 . t) (1 . nil) (nil . nil))))))
- ;;; Agenda restriction lock
- (defvar org-agenda-restriction-lock-overlay (make-overlay 1 1)
- "Overlay to mark the headline to which agenda commands are restricted.")
- (overlay-put org-agenda-restriction-lock-overlay
- 'face 'org-agenda-restriction-lock)
- (overlay-put org-agenda-restriction-lock-overlay
- 'help-echo "Agendas are currently limited to this subtree.")
- (org-detach-overlay org-agenda-restriction-lock-overlay)
- ;;;###autoload
- (defun org-agenda-set-restriction-lock (&optional type)
- "Set restriction lock for agenda, to current subtree or file.
- Restriction will be the file if TYPE is `file', or if type is the
- universal prefix '(4), or if the cursor is before the first headline
- in the file. Otherwise, restriction will be to the current subtree."
- (interactive "P")
- (and (equal type '(4)) (setq type 'file))
- (setq type (cond
- (type type)
- ((org-at-heading-p) 'subtree)
- ((condition-case nil (org-back-to-heading t) (error nil))
- 'subtree)
- (t 'file)))
- (if (eq type 'subtree)
- (progn
- (setq org-agenda-restrict (current-buffer))
- (setq org-agenda-overriding-restriction 'subtree)
- (put 'org-agenda-files 'org-restrict
- (list (buffer-file-name (buffer-base-buffer))))
- (org-back-to-heading t)
- (move-overlay org-agenda-restriction-lock-overlay
- (point)
- (if org-agenda-restriction-lock-highlight-subtree
- (save-excursion (org-end-of-subtree t t) (point))
- (point-at-eol)))
- (move-marker org-agenda-restrict-begin (point))
- (move-marker org-agenda-restrict-end
- (save-excursion (org-end-of-subtree t t)))
- (message "Locking agenda restriction to subtree"))
- (put 'org-agenda-files 'org-restrict
- (list (buffer-file-name (buffer-base-buffer))))
- (setq org-agenda-restrict nil)
- (setq org-agenda-overriding-restriction 'file)
- (move-marker org-agenda-restrict-begin nil)
- (move-marker org-agenda-restrict-end nil)
- (message "Locking agenda restriction to file"))
- (setq current-prefix-arg nil)
- (org-agenda-maybe-redo))
- (defun org-agenda-remove-restriction-lock (&optional noupdate)
- "Remove the agenda restriction lock."
- (interactive "P")
- (org-detach-overlay org-agenda-restriction-lock-overlay)
- (org-detach-overlay org-speedbar-restriction-lock-overlay)
- (setq org-agenda-overriding-restriction nil)
- (setq org-agenda-restrict nil)
- (put 'org-agenda-files 'org-restrict nil)
- (move-marker org-agenda-restrict-begin nil)
- (move-marker org-agenda-restrict-end nil)
- (setq current-prefix-arg nil)
- (message "Agenda restriction lock removed")
- (or noupdate (org-agenda-maybe-redo)))
- (defun org-agenda-maybe-redo ()
- "If there is any window showing the agenda view, update it."
- (let ((w (get-buffer-window org-agenda-buffer-name t))
- (w0 (selected-window)))
- (when w
- (select-window w)
- (org-agenda-redo)
- (select-window w0)
- (if org-agenda-overriding-restriction
- (message "Agenda view shifted to new %s restriction"
- org-agenda-overriding-restriction)
- (message "Agenda restriction lock removed")))))
- ;;; Agenda commands
- (defun org-agenda-check-type (error &rest types)
- "Check if agenda buffer is of allowed type.
- If ERROR is non-nil, throw an error, otherwise just return nil.
- Allowed types are 'agenda 'timeline 'todo 'tags 'search."
- (if (not org-agenda-type)
- (error "No Org agenda currently displayed")
- (if (memq org-agenda-type types)
- t
- (if error
- (error "Not allowed in %s-type agenda buffers" org-agenda-type)
- nil))))
- (defun org-agenda-Quit ()
- "Exit the agenda and kill buffers loaded by `org-agenda'.
- Also restore the window configuration."
- (interactive)
- (if org-agenda-columns-active
- (org-columns-quit)
- (let ((buf (current-buffer)))
- (if (eq org-agenda-window-setup 'other-frame)
- (progn
- (org-agenda-reset-markers)
- (kill-buffer buf)
- (org-columns-remove-overlays)
- (setq org-agenda-archives-mode nil)
- (delete-frame))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window))
- (org-agenda-reset-markers)
- (kill-buffer buf)
- (org-columns-remove-overlays)
- (setq org-agenda-archives-mode nil)))
- (setq org-agenda-buffer nil)
- ;; Maybe restore the pre-agenda window configuration.
- (and org-agenda-restore-windows-after-quit
- (not (eq org-agenda-window-setup 'other-frame))
- org-agenda-pre-window-conf
- (set-window-configuration org-agenda-pre-window-conf)
- (setq org-agenda-pre-window-conf nil))))
- (defun org-agenda-quit ()
- "Exit the agenda and restore the window configuration.
- When `org-agenda-sticky' is non-nil, only bury the agenda."
- (interactive)
- (if (and (eq org-indirect-buffer-display 'other-window)
- org-last-indirect-buffer)
- (let ((org-last-indirect-window
- (get-buffer-window org-last-indirect-buffer)))
- (if org-last-indirect-window
- (delete-window org-last-indirect-window))))
- (if org-agenda-columns-active
- (org-columns-quit)
- (if org-agenda-sticky
- (let ((buf (current-buffer)))
- (if (eq org-agenda-window-setup 'other-frame)
- (progn
- (delete-frame))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window)))
- (with-current-buffer buf
- (bury-buffer)
- ;; Maybe restore the pre-agenda window configuration.
- (and org-agenda-restore-windows-after-quit
- (not (eq org-agenda-window-setup 'other-frame))
- org-agenda-pre-window-conf
- (set-window-configuration org-agenda-pre-window-conf)
- (setq org-agenda-pre-window-conf nil))))
- (org-agenda-Quit))))
- (defun org-agenda-exit ()
- "Exit the agenda and restore the window configuration.
- Also kill Org-mode buffers loaded by `org-agenda'. Org-mode
- buffers visited directly by the user will not be touched."
- (interactive)
- (org-release-buffers org-agenda-new-buffers)
- (setq org-agenda-new-buffers nil)
- (org-agenda-Quit))
- (defun org-agenda-kill-all-agenda-buffers ()
- "Kill all buffers in `org-agenda-mode'.
- This is used when toggling sticky agendas.
- You can also explicitly invoke it with `C-c a C-k'."
- (interactive)
- (let (blist)
- (dolist (buf (buffer-list))
- (when (with-current-buffer buf (eq major-mode 'org-agenda-mode))
- (push buf blist)))
- (mapc 'kill-buffer blist)))
- (defun org-agenda-execute (arg)
- "Execute another agenda command, keeping same window.
- So this is just a shortcut for \\<global-map>`\\[org-agenda]', available
- in the agenda."
- (interactive "P")
- (let ((org-agenda-window-setup 'current-window))
- (org-agenda arg)))
- (defun org-agenda-redo (&optional all)
- "Rebuild possibly ALL agenda view(s) in the current buffer."
- (interactive "P")
- (let* ((p (or (and (looking-at "\\'") (1- (point))) (point)))
- (cpa (unless (eq all t) current-prefix-arg))
- (org-agenda-doing-sticky-redo org-agenda-sticky)
- (org-agenda-sticky nil)
- (org-agenda-buffer-name (or org-agenda-this-buffer-name
- org-agenda-buffer-name))
- (org-agenda-keep-modes t)
- (tag-filter org-agenda-tag-filter)
- (tag-preset (get 'org-agenda-tag-filter :preset-filter))
- (top-hl-filter org-agenda-top-headline-filter)
- (cat-filter org-agenda-category-filter)
- (cat-preset (get 'org-agenda-category-filter :preset-filter))
- (re-filter org-agenda-regexp-filter)
- (re-preset (get 'org-agenda-regexp-filter :preset-filter))
- (org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
- (cols org-agenda-columns-active)
- (line (org-current-line))
- (window-line (- line (org-current-line (window-start))))
- (lprops (get 'org-agenda-redo-command 'org-lprops))
- (redo-cmd (get-text-property p 'org-redo-cmd))
- (last-args (get-text-property p 'org-last-args))
- (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
- (org-agenda-overriding-cmd-arguments
- (unless (eq all t)
- (cond ((listp last-args)
- (cons (or cpa (car last-args)) (cdr last-args)))
- ((stringp last-args)
- last-args))))
- (series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
- (put 'org-agenda-tag-filter :preset-filter nil)
- (put 'org-agenda-category-filter :preset-filter nil)
- (put 'org-agenda-regexp-filter :preset-filter nil)
- (and cols (org-columns-quit))
- (message "Rebuilding agenda buffer...")
- (if series-redo-cmd
- (eval series-redo-cmd)
- (org-let lprops redo-cmd))
- (setq org-agenda-undo-list nil
- org-agenda-pending-undo-list nil
- org-agenda-tag-filter tag-filter
- org-agenda-category-filter cat-filter
- org-agenda-regexp-filter re-filter
- org-agenda-top-headline-filter top-hl-filter)
- (message "Rebuilding agenda buffer...done")
- (put 'org-agenda-tag-filter :preset-filter tag-preset)
- (put 'org-agenda-category-filter :preset-filter cat-preset)
- (put 'org-agenda-regexp-filter :preset-filter re-preset)
- (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
- (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
- (and (or re-filter re-preset) (org-agenda-filter-apply re-filter 'regexp))
- (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
- (and cols (org-called-interactively-p 'any) (org-agenda-columns))
- (org-goto-line line)
- (recenter window-line)))
- (defvar org-global-tags-completion-table nil)
- (defvar org-agenda-filter-form nil)
- (defvar org-agenda-filtered-by-category nil)
- (defun org-agenda-filter-by-category (strip)
- "Keep only those lines in the agenda buffer that have a specific category.
- The category is that of the current line."
- (interactive "P")
- (if (and org-agenda-filtered-by-category
- org-agenda-category-filter)
- (org-agenda-filter-show-all-cat)
- (let ((cat (org-no-properties (get-text-property (point) 'org-category))))
- (cond
- ((and cat strip)
- (org-agenda-filter-apply
- (push (concat "-" cat) org-agenda-category-filter) 'category))
- ((and cat)
- (org-agenda-filter-apply
- (setq org-agenda-category-filter
- (list (concat "+" cat))) 'category))
- ((error "No category at point"))))))
- (defun org-find-top-headline (&optional pos)
- "Find the topmost parent headline and return it."
- (save-excursion
- (with-current-buffer (if pos (marker-buffer pos) (current-buffer))
- (if pos (goto-char pos))
- ;; Skip up to the topmost parent
- (while (ignore-errors (outline-up-heading 1) t))
- (ignore-errors
- (nth 4 (org-heading-components))))))
- (defvar org-agenda-filtered-by-top-headline nil)
- (defun org-agenda-filter-by-top-headline (strip)
- "Keep only those lines that are descendants from the same top headline.
- The top headline is that of the current line."
- (interactive "P")
- (if org-agenda-filtered-by-top-headline
- (progn
- (setq org-agenda-filtered-by-top-headline nil
- org-agenda-top-headline-filter nil)
- (org-agenda-filter-show-all-cat))
- (let ((cat (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
- (if cat (org-agenda-filter-top-headline-apply cat strip)
- (error "No top-level category at point")))))
- (defvar org-agenda-regexp-filter nil)
- (defun org-agenda-filter-by-regexp (strip)
- "Filter agenda entries by a regular expression.
- Regexp filters are cumulative.
- With no prefix argument, keep entries matching the regexp.
- With one prefix argument, filter out entries matching the regexp.
- With two prefix arguments, remove the regexp filters."
- (interactive "P")
- (if (not (equal strip '(16)))
- (let ((flt (concat (if (equal strip '(4)) "-" "+")
- (read-from-minibuffer
- (if (equal strip '(4))
- "Filter out entries matching regexp: "
- "Narrow to entries matching regexp: ")))))
- (push flt org-agenda-regexp-filter)
- (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
- (org-agenda-filter-show-all-re)
- (message "Regexp filter removed")))
- (defun org-agenda-filter-remove-all ()
- "Remove all filters from the current agenda buffer."
- (interactive)
- (when org-agenda-tag-filter
- (org-agenda-filter-show-all-tag))
- (when org-agenda-category-filter
- (org-agenda-filter-show-all-cat))
- (when org-agenda-regexp-filter
- (org-agenda-filter-show-all-re)))
- (defun org-agenda-filter-by-tag (strip &optional char narrow)
- "Keep only those lines in the agenda buffer that have a specific tag.
- The tag is selected with its fast selection letter, as configured.
- With prefix argument STRIP, remove all lines that do have the tag.
- A lisp caller can specify CHAR. NARROW means that the new tag should be
- used to narrow the search - the interactive user can also press `-' or `+'
- to switch to narrowing."
- (interactive "P")
- (let* ((alist org-tag-alist-for-agenda)
- (tag-chars (mapconcat
- (lambda (x) (if (and (not (symbolp (car x)))
- (cdr x))
- (char-to-string (cdr x))
- ""))
- alist ""))
- (efforts (org-split-string
- (or (cdr (assoc (concat org-effort-property "_ALL")
- org-global-properties))
- "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00"
- "")))
- (effort-op org-agenda-filter-effort-default-operator)
- (effort-prompt "")
- (inhibit-read-only t)
- (current org-agenda-tag-filter)
- maybe-refresh a n tag)
- (unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>=<?]:effort: "
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off, [>=<]:effort: " tag-chars)
- (setq char (read-char-exclusive)))
- (when (member char '(?< ?> ?= ??))
- ;; An effort operator
- (setq effort-op (char-to-string char))
- (setq alist nil) ; to make sure it will be interpreted as effort.
- (unless (equal char ??)
- (loop for i from 0 to 9 do
- (setq effort-prompt
- (concat
- effort-prompt " ["
- (if (= i 9) "0" (int-to-string (1+ i)))
- "]" (nth i efforts))))
- (message "Effort%s: %s " effort-op effort-prompt)
- (setq char (read-char-exclusive))
- (when (or (< char ?0) (> char ?9))
- (error "Need 1-9,0 to select effort"))))
- (when (equal char ?\t)
- (unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
- (org-set-local 'org-global-tags-completion-table
- (org-global-tags-completion-table)))
- (let ((completion-ignore-case t))
- (setq tag (org-icompleting-read
- "Tag: " org-global-tags-completion-table))))
- (cond
- ((equal char ?\r)
- (org-agenda-filter-show-all-tag)
- (when org-agenda-auto-exclude-function
- (setq org-agenda-tag-filter nil)
- (dolist (tag (org-agenda-get-represented-tags))
- (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
- (if modifier
- (push modifier org-agenda-tag-filter))))
- (if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
- (setq maybe-refresh t))
- ((equal char ?/)
- (org-agenda-filter-show-all-tag)
- (when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- (setq maybe-refresh t))
- ((equal char ?. )
- (setq org-agenda-tag-filter
- (mapcar (lambda(tag) (concat "+" tag))
- (org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)
- (setq maybe-refresh t))
- ((or (equal char ?\ )
- (setq a (rassoc char alist))
- (and (>= char ?0) (<= char ?9)
- (setq n (if (= char ?0) 9 (- char ?0 1))
- tag (concat effort-op (nth n efforts))
- a (cons tag nil)))
- (and (= char ??)
- (setq tag "?eff")
- a (cons tag nil))
- (and tag (setq a (cons tag nil))))
- (org-agenda-filter-show-all-tag)
- (setq tag (car a))
- (setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)
- (setq maybe-refresh t))
- (t (error "Invalid tag selection character %c" char)))
- (when (and maybe-refresh
- (eq org-agenda-clockreport-mode 'with-filter))
- (org-agenda-redo))))
- (defun org-agenda-get-represented-tags ()
- "Get a list of all tags currently represented in the agenda."
- (let (p tags)
- (save-excursion
- (goto-char (point-min))
- (while (setq p (next-single-property-change (point) 'tags))
- (goto-char p)
- (mapc (lambda (x) (add-to-list 'tags x))
- (get-text-property (point) 'tags))))
- tags))
- (defun org-agenda-filter-by-tag-refine (strip &optional char)
- "Refine the current filter. See `org-agenda-filter-by-tag'."
- (interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
- (defun org-agenda-filter-make-matcher (filter type)
- "Create the form that tests a line for agenda filter."
- (let (f f1)
- (cond
- ;; Tag filter
- ((eq type 'tag)
- (setq filter
- (delete-dups
- (append (get 'org-agenda-tag-filter :preset-filter)
- filter)))
- (dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (if (string-match "[<=>?]" x)
- (setq nf01 (org-agenda-filter-effort-form x))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags)))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
- ;; Category filter
- ((eq type 'category)
- (setq filter
- (delete-dups
- (append (get 'org-agenda-category-filter :preset-filter)
- filter)))
- (dolist (x filter)
- (if (equal "-" (substring x 0 1))
- (setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
- (setq f1 (list 'equal (substring x 1) 'cat)))
- (push f1 f)))
- ;; Regexp filter
- ((eq type 'regexp)
- (setq filter
- (delete-dups
- (append (get 'org-agenda-regexp-filter :preset-filter)
- filter)))
- (dolist (x filter)
- (if (equal "-" (substring x 0 1))
- (setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
- (setq f1 (list 'string-match (substring x 1) 'txt)))
- (push f1 f))))
- (cons 'and (nreverse f))))
- (defun org-agenda-filter-effort-form (e)
- "Return the form to compare the effort of the current line with what E says.
- E looks like \"+<2:25\"."
- (let (op)
- (setq e (substring e 1))
- (setq op (string-to-char e) e (substring e 1))
- (setq op (cond ((equal op ?<) '<=)
- ((equal op ?>) '>=)
- ((equal op ??) op)
- (t '=)))
- (list 'org-agenda-compare-effort (list 'quote op)
- (org-duration-string-to-minutes e))))
- (defun org-agenda-compare-effort (op value)
- "Compare the effort of the current line with VALUE, using OP.
- If the line does not have an effort defined, return nil."
- (let ((eff (org-get-at-bol 'effort-minutes)))
- (if (equal op ??)
- (not eff)
- (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
- value))))
- (defun org-agenda-filter-expand-tags (filter &optional no-operator)
- "Expand group tags in FILTER for the agenda.
- When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
- (if org-group-tags
- (let ((case-fold-search t) rtn)
- (mapc
- (lambda (f)
- (let (f0 dir)
- (if (string-match "^\\([+-]\\)\\(.+\\)" f)
- (setq dir (match-string 1 f) f0 (match-string 2 f))
- (setq dir (if no-operator "" "+") f0 f))
- (setq rtn (append (mapcar (lambda(f1) (concat dir f1))
- (org-tags-expand f0 t t))
- rtn))))
- filter)
- (reverse rtn))
- filter))
- (defun org-agenda-filter-apply (filter type)
- "Set FILTER as the new agenda filter and apply it."
- ;; Deactivate `org-agenda-entry-text-mode' when filtering
- (if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
- (let (tags cat txt)
- (setq org-agenda-filter-form
- (org-agenda-filter-make-matcher filter type))
- (if (and (eq type 'category)
- (not (equal (substring (car filter) 0 1) "-")))
- ;; Only set `org-agenda-filtered-by-category' to t
- ;; when a unique category is used as the filter
- (setq org-agenda-filtered-by-category t))
- (org-agenda-set-mode-name)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (if (org-get-at-bol 'org-marker)
- (progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
- cat (get-text-property (point) 'org-category)
- txt (get-text-property (point) 'txt))
- (if (not (eval org-agenda-filter-form))
- (org-agenda-filter-hide-line type))
- (beginning-of-line 2))
- (beginning-of-line 2))))
- (if (get-char-property (point) 'invisible)
- (ignore-errors (org-agenda-previous-line)))))
- (defun org-agenda-filter-top-headline-apply (hl &optional negative)
- "Filter by top headline HL."
- (org-agenda-set-mode-name)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((pos (org-get-at-bol 'org-hd-marker))
- (tophl (and pos (org-find-top-headline pos))))
- (if (and tophl (funcall (if negative 'identity 'not)
- (string= hl tophl)))
- (org-agenda-filter-hide-line 'category)))
- (beginning-of-line 2)))
- (if (get-char-property (point) 'invisible)
- (org-agenda-previous-line))
- (setq org-agenda-top-headline-filter hl
- org-agenda-filtered-by-top-headline t))
- (defun org-agenda-filter-hide-line (type)
- "Hide lines with TYPE in the agenda buffer."
- (let (ov)
- (setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
- (point-at-eol)))
- (overlay-put ov 'invisible t)
- (overlay-put ov 'type type)
- (cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays))
- ((eq type 'category) (push ov org-agenda-cat-filter-overlays))
- ((eq type 'regexp) (push ov org-agenda-re-filter-overlays)))))
- (defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
- (setq pos (or pos (point)))
- (save-excursion
- (dolist (ov (overlays-at pos))
- (when (and (overlay-get ov 'invisible)
- (eq (overlay-get ov 'type) 'tag))
- (goto-char pos)
- (if (< (overlay-start ov) (point-at-eol))
- (move-overlay ov (point-at-eol)
- (overlay-end ov)))))))
- (defun org-agenda-filter-show-all-tag nil
- "Remove tag filter overlays from the agenda buffer."
- (mapc 'delete-overlay org-agenda-tag-filter-overlays)
- (setq org-agenda-tag-filter-overlays nil
- org-agenda-tag-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
- (defun org-agenda-filter-show-all-re nil
- "Remove regexp filter overlays from the agenda buffer."
- (mapc 'delete-overlay org-agenda-re-filter-overlays)
- (setq org-agenda-re-filter-overlays nil
- org-agenda-regexp-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
- (defun org-agenda-filter-show-all-cat nil
- "Remove category filter overlays from the agenda buffer."
- (mapc 'delete-overlay org-agenda-cat-filter-overlays)
- (setq org-agenda-cat-filter-overlays nil
- org-agenda-filtered-by-category nil
- org-agenda-category-filter nil
- org-agenda-filter-form nil)
- (org-agenda-set-mode-name))
- (defun org-agenda-manipulate-query-add ()
- "Manipulate the query by adding a search term with positive selection.
- Positive selection means the term must be matched for selection of an entry."
- (interactive)
- (org-agenda-manipulate-query ?\[))
- (defun org-agenda-manipulate-query-subtract ()
- "Manipulate the query by adding a search term with negative selection.
- Negative selection means term must not be matched for selection of an entry."
- (interactive)
- (org-agenda-manipulate-query ?\]))
- (defun org-agenda-manipulate-query-add-re ()
- "Manipulate the query by adding a search regexp with positive selection.
- Positive selection means the regexp must match for selection of an entry."
- (interactive)
- (org-agenda-manipulate-query ?\{))
- (defun org-agenda-manipulate-query-subtract-re ()
- "Manipulate the query by adding a search regexp with negative selection.
- Negative selection means regexp must not match for selection of an entry."
- (interactive)
- (org-agenda-manipulate-query ?\}))
- (defun org-agenda-manipulate-query (char)
- (cond
- ((memq org-agenda-type '(timeline agenda))
- (let ((org-agenda-include-inactive-timestamps t))
- (org-agenda-redo))
- (message "Display now includes inactive timestamps as well"))
- ((eq org-agenda-type 'search)
- (org-add-to-string
- 'org-agenda-query-string
- (if org-agenda-last-search-view-search-was-boolean
- (cdr (assoc char '((?\[ . " +") (?\] . " -")
- (?\{ . " +{}") (?\} . " -{}"))))
- " "))
- (setq org-agenda-redo-command
- (list 'org-search-view
- (car (get-text-property (min (1- (point-max)) (point))
- 'org-last-args))
- org-agenda-query-string
- (+ (length org-agenda-query-string)
- (if (member char '(?\{ ?\})) 0 1))))
- (set-register org-agenda-query-register org-agenda-query-string)
- (let ((org-agenda-overriding-arguments
- (cdr org-agenda-redo-command)))
- (org-agenda-redo)))
- (t (error "Cannot manipulate query for %s-type agenda buffers"
- org-agenda-type))))
- (defun org-add-to-string (var string)
- (set var (concat (symbol-value var) string)))
- (defun org-agenda-goto-date (span)
- "Jump to DATE in agenda."
- (interactive "P")
- (let* ((org-read-date-prefer-future
- (eval org-agenda-jump-prefer-future))
- (date (org-read-date))
- (day (time-to-days (org-time-string-to-time date)))
- (org-agenda-sticky-orig org-agenda-sticky)
- (org-agenda-buffer-tmp-name (buffer-name))
- (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
- (0-arg (or current-prefix-arg (car args)))
- (2-arg (nth 2 args))
- (with-hour-p (nth 4 org-agenda-redo-command))
- (newcmd (list 'org-agenda-list 0-arg date
- (org-agenda-span-to-ndays
- 2-arg (org-time-string-to-absolute date))
- with-hour-p))
- (newargs (cdr newcmd))
- (inhibit-read-only t)
- org-agenda-sticky)
- (if (not (org-agenda-check-type t 'agenda))
- (error "Not available in non-agenda views")
- (add-text-properties (point-min) (point-max)
- `(org-redo-cmd ,newcmd org-last-args ,newargs))
- (org-agenda-redo)
- (goto-char (point-min))
- (while (not (or (= (or (get-text-property (point) 'day) 0) day)
- (save-excursion (move-beginning-of-line 2) (eobp))))
- (move-beginning-of-line 2))
- (setq org-agenda-sticky org-agenda-sticky-orig
- org-agenda-this-buffer-is-sticky org-agenda-sticky))))
- (defun org-agenda-goto-today ()
- "Go to today."
- (interactive)
- (org-agenda-check-type t 'timeline 'agenda)
- (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
- (curspan (nth 2 args))
- (tdpos (text-property-any (point-min) (point-max) 'org-today t)))
- (cond
- (tdpos (goto-char tdpos))
- ((eq org-agenda-type 'agenda)
- (let* ((sd (org-agenda-compute-starting-span
- (org-today) (or curspan org-agenda-ndays org-agenda-span)))
- (org-agenda-overriding-arguments args))
- (setf (nth 1 org-agenda-overriding-arguments) sd)
- (org-agenda-redo)
- (org-agenda-find-same-or-today-or-agenda)))
- (t (error "Cannot find today")))))
- (defun org-agenda-find-same-or-today-or-agenda (&optional cnt)
- (goto-char
- (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt))
- (text-property-any (point-min) (point-max) 'org-today t)
- (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda)
- (and (get-text-property (min (1- (point-max)) (point)) 'org-series)
- (org-agenda-goto-block-beginning))
- (point-min))))
- (defun org-agenda-goto-block-beginning ()
- "Go the agenda block beginning."
- (interactive)
- (if (not (derived-mode-p 'org-agenda-mode))
- (error "Cannot execute this command outside of org-agenda-mode buffers")
- (let (dest)
- (save-excursion
- (unless (looking-at "\\'")
- (forward-char))
- (let* ((prop 'org-agenda-structural-header)
- (p (previous-single-property-change (point) prop))
- (n (next-single-property-change (or (and (looking-at "\\`") 1)
- (1- (point))) prop)))
- (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p))))))
- (if (not dest)
- (error "Cannot find the beginning of the blog")
- (goto-char dest)
- (move-beginning-of-line 1)))))
- (defun org-agenda-later (arg)
- "Go forward in time by the current span.
- With prefix ARG, go forward that many times the current span."
- (interactive "p")
- (org-agenda-check-type t 'agenda)
- (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
- (span (or (nth 2 args) org-agenda-current-span))
- (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day))
- (greg (calendar-gregorian-from-absolute sd))
- (cnt (org-get-at-bol 'org-day-cnt))
- greg2)
- (cond
- ((numberp span)
- (setq sd (+ (* span arg) sd)))
- ((eq span 'day)
- (setq sd (+ arg sd)))
- ((eq span 'week)
- (setq sd (+ (* 7 arg) sd)))
- ((eq span 'fortnight)
- (setq sd (+ (* 14 arg) sd)))
- ((eq span 'month)
- (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg))
- sd (calendar-absolute-from-gregorian greg2))
- (setcar greg2 (1+ (car greg2))))
- ((eq span 'year)
- (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg)))
- sd (calendar-absolute-from-gregorian greg2))
- (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2))))
- (t
- (setq sd (+ (* span arg) sd))))
- (let ((org-agenda-overriding-cmd
- ;; `cmd' may have been set by `org-agenda-run-series' which
- ;; uses `org-agenda-overriding-cmd' to decide whether
- ;; overriding is allowed for `cmd'
- (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
- (org-agenda-overriding-arguments
- (list (car args) sd span)))
- (org-agenda-redo)
- (org-agenda-find-same-or-today-or-agenda cnt))))
- (defun org-agenda-earlier (arg)
- "Go backward in time by the current span.
- With prefix ARG, go backward that many times the current span."
- (interactive "p")
- (org-agenda-later (- arg)))
- (defun org-agenda-view-mode-dispatch ()
- "Call one of the view mode commands."
- (interactive)
- (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort
- time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck
- [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText")
- (let ((a (read-char-exclusive)))
- (case a
- (?\ (call-interactively 'org-agenda-reset-view))
- (?d (call-interactively 'org-agenda-day-view))
- (?w (call-interactively 'org-agenda-week-view))
- (?t (call-interactively 'org-agenda-fortnight-view))
- (?m (call-interactively 'org-agenda-month-view))
- (?y (call-interactively 'org-agenda-year-view))
- (?l (call-interactively 'org-agenda-log-mode))
- (?L (org-agenda-log-mode '(4)))
- (?c (org-agenda-log-mode 'clockcheck))
- ((?F ?f) (call-interactively 'org-agenda-follow-mode))
- (?a (call-interactively 'org-agenda-archives-mode))
- (?A (org-agenda-archives-mode 'files))
- ((?R ?r) (call-interactively 'org-agenda-clockreport-mode))
- ((?E ?e) (call-interactively 'org-agenda-entry-text-mode))
- (?G (call-interactively 'org-agenda-toggle-time-grid))
- (?D (call-interactively 'org-agenda-toggle-diary))
- (?\! (call-interactively 'org-agenda-toggle-deadlines))
- (?\[ (let ((org-agenda-include-inactive-timestamps t))
- (org-agenda-check-type t 'timeline 'agenda)
- (org-agenda-redo))
- (message "Display now includes inactive timestamps as well"))
- (?q (message "Abort"))
- (otherwise (error "Invalid key" )))))
- (defun org-agenda-reset-view ()
- "Switch to default view for agenda."
- (interactive)
- (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span)))
- (defun org-agenda-day-view (&optional day-of-month)
- "Switch to daily view for agenda.
- With argument DAY-OF-MONTH, switch to that day of the month."
- (interactive "P")
- (org-agenda-change-time-span 'day day-of-month))
- (defun org-agenda-week-view (&optional iso-week)
- "Switch to daily view for agenda.
- With argument ISO-WEEK, switch to the corresponding ISO week.
- If ISO-WEEK has more then 2 digits, only the last two encode the
- week. Any digits before this encode a year. So 200712 means
- week 12 of year 2007. Years in the range 1938-2037 can also be
- written as 2-digit years."
- (interactive "P")
- (org-agenda-change-time-span 'week iso-week))
- (defun org-agenda-fortnight-view (&optional iso-week)
- "Switch to daily view for agenda.
- With argument ISO-WEEK, switch to the corresponding ISO week.
- If ISO-WEEK has more then 2 digits, only the last two encode the
- week. Any digits before this encode a year. So 200712 means
- week 12 of year 2007. Years in the range 1938-2037 can also be
- written as 2-digit years."
- (interactive "P")
- (org-agenda-change-time-span 'fortnight iso-week))
- (defun org-agenda-month-view (&optional month)
- "Switch to monthly view for agenda.
- With argument MONTH, switch to that month."
- (interactive "P")
- (org-agenda-change-time-span 'month month))
- (defun org-agenda-year-view (&optional year)
- "Switch to yearly view for agenda.
- With argument YEAR, switch to that year.
- If MONTH has more then 2 digits, only the last two encode the
- month. Any digits before this encode a year. So 200712 means
- December year 2007. Years in the range 1938-2037 can also be
- written as 2-digit years."
- (interactive "P")
- (when year
- (setq year (org-small-year-to-year year)))
- (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ")
- (org-agenda-change-time-span 'year year)
- (error "Abort")))
- (defun org-agenda-change-time-span (span &optional n)
- "Change the agenda view to SPAN.
- SPAN may be `day', `week', `fortnight', `month', `year'."
- (org-agenda-check-type t 'agenda)
- (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args))
- (curspan (nth 2 args)))
- (if (and (not n) (equal curspan span))
- (error "Viewing span is already \"%s\"" span))
- (let* ((sd (or (org-get-at-bol 'day)
- (nth 1 args)
- org-starting-day))
- (sd (org-agenda-compute-starting-span sd span n))
- (org-agenda-overriding-cmd
- (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd))
- (org-agenda-overriding-arguments
- (list (car args) sd span)))
- (org-agenda-redo)
- (org-agenda-find-same-or-today-or-agenda))
- (org-agenda-set-mode-name)
- (message "Switched to %s view" span)))
- (defun org-agenda-compute-starting-span (sd span &optional n)
- "Compute starting date for agenda.
- SPAN may be `day', `week', `fortnight', `month', `year'. The return value
- is a cons cell with the starting date and the number of days,
- so that the date SD will be in that range."
- (let* ((greg (calendar-gregorian-from-absolute sd))
- (dg (nth 1 greg))
- (mg (car greg))
- (yg (nth 2 greg)))
- (cond
- ((eq span 'day)
- (when n
- (setq sd (+ (calendar-absolute-from-gregorian
- (list mg 1 yg))
- n -1))))
- ((or (eq span 'week) (eq span 'fortnight))
- (let* ((nt (calendar-day-of-week
- (calendar-gregorian-from-absolute sd)))
- (d (if org-agenda-start-on-weekday
- (- nt org-agenda-start-on-weekday)
- 0))
- y1)
- (setq sd (- sd (+ (if (< d 0) 7 0) d)))
- (when n
- (require 'cal-iso)
- (when (> n 99)
- (setq y1 (org-small-year-to-year (/ n 100))
- n (mod n 100)))
- (setq sd
- (calendar-absolute-from-iso
- (list n 1
- (or y1 (nth 2 (calendar-iso-from-absolute sd)))))))))
- ((eq span 'month)
- (let (y1)
- (when (and n (> n 99))
- (setq y1 (org-small-year-to-year (/ n 100))
- n (mod n 100)))
- (setq sd (calendar-absolute-from-gregorian
- (list (or n mg) 1 (or y1 yg))))))
- ((eq span 'year)
- (setq sd (calendar-absolute-from-gregorian
- (list 1 1 (or n yg))))))
- sd))
- (defun org-agenda-next-date-line (&optional arg)
- "Jump to the next line indicating a date in agenda buffer."
- (interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
- (beginning-of-line 1)
- ;; This does not work if user makes date format that starts with a blank
- (if (looking-at "^\\S-") (forward-char 1))
- (if (not (re-search-forward "^\\S-" nil t arg))
- (progn
- (backward-char 1)
- (error "No next date after this line in this buffer")))
- (goto-char (match-beginning 0)))
- (defun org-agenda-previous-date-line (&optional arg)
- "Jump to the previous line indicating a date in agenda buffer."
- (interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
- (beginning-of-line 1)
- (if (not (re-search-backward "^\\S-" nil t arg))
- (error "No previous date before this line in this buffer")))
- ;; Initialize the highlight
- (defvar org-hl (make-overlay 1 1))
- (overlay-put org-hl 'face 'highlight)
- (defun org-highlight (begin end &optional buffer)
- "Highlight a region with overlay."
- (move-overlay org-hl begin end (or buffer (current-buffer))))
- (defun org-unhighlight ()
- "Detach overlay INDEX."
- (org-detach-overlay org-hl))
- (defun org-unhighlight-once ()
- "Remove the highlight from its position, and this function from the hook."
- (remove-hook 'pre-command-hook 'org-unhighlight-once)
- (org-unhighlight))
- (defvar org-agenda-pre-follow-window-conf nil)
- (defun org-agenda-follow-mode ()
- "Toggle follow mode in an agenda buffer."
- (interactive)
- (unless org-agenda-follow-mode
- (setq org-agenda-pre-follow-window-conf
- (current-window-configuration)))
- (setq org-agenda-follow-mode (not org-agenda-follow-mode))
- (unless org-agenda-follow-mode
- (set-window-configuration org-agenda-pre-follow-window-conf))
- (org-agenda-set-mode-name)
- (org-agenda-do-context-action)
- (message "Follow mode is %s"
- (if org-agenda-follow-mode "on" "off")))
- (defun org-agenda-entry-text-mode (&optional arg)
- "Toggle entry text mode in an agenda buffer."
- (interactive "P")
- (if (or org-agenda-tag-filter
- org-agenda-category-filter
- org-agenda-regexp-filter
- org-agenda-top-headline-filter)
- (user-error "Can't show entry text in filtered views")
- (setq org-agenda-entry-text-mode (or (integerp arg)
- (not org-agenda-entry-text-mode)))
- (org-agenda-entry-text-hide)
- (and org-agenda-entry-text-mode
- (let ((org-agenda-entry-text-maxlines
- (if (integerp arg) arg org-agenda-entry-text-maxlines)))
- (org-agenda-entry-text-show)))
- (org-agenda-set-mode-name)
- (message "Entry text mode is %s%s"
- (if org-agenda-entry-text-mode "on" "off")
- (if (not org-agenda-entry-text-mode) ""
- (format " (maximum number of lines is %d)"
- (if (integerp arg) arg org-agenda-entry-text-maxlines))))))
- (defun org-agenda-clockreport-mode (&optional with-filter)
- "Toggle clocktable mode in an agenda buffer.
- With prefix arg WITH-FILTER, make the clocktable respect the current
- agenda filter."
- (interactive "P")
- (org-agenda-check-type t 'agenda)
- (if with-filter
- (setq org-agenda-clockreport-mode 'with-filter)
- (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)))
- (org-agenda-set-mode-name)
- (org-agenda-redo)
- (message "Clocktable mode is %s"
- (if org-agenda-clockreport-mode "on" "off")))
- (defun org-agenda-log-mode (&optional special)
- "Toggle log mode in an agenda buffer.
- With argument SPECIAL, show all possible log items, not only the ones
- configured in `org-agenda-log-mode-items'.
- With a double `C-u' prefix arg, show *only* log items, nothing else."
- (interactive "P")
- (org-agenda-check-type t 'agenda 'timeline)
- (setq org-agenda-show-log
- (cond
- ((equal special '(16)) 'only)
- ((eq special 'clockcheck)
- (if (eq org-agenda-show-log 'clockcheck)
- nil 'clockcheck))
- (special '(closed clock state))
- (t (not org-agenda-show-log))))
- (org-agenda-set-mode-name)
- (org-agenda-redo)
- (message "Log mode is %s"
- (if org-agenda-show-log "on" "off")))
- (defun org-agenda-archives-mode (&optional with-files)
- "Toggle inclusion of items in trees marked with :ARCHIVE:.
- When called with a prefix argument, include all archive files as well."
- (interactive "P")
- (setq org-agenda-archives-mode
- (if with-files t (if org-agenda-archives-mode nil 'trees)))
- (org-agenda-set-mode-name)
- (org-agenda-redo)
- (message
- "%s"
- (cond
- ((eq org-agenda-archives-mode nil)
- "No archives are included")
- ((eq org-agenda-archives-mode 'trees)
- (format "Trees with :%s: tag are included" org-archive-tag))
- ((eq org-agenda-archives-mode t)
- (format "Trees with :%s: tag and all active archive files are included"
- org-archive-tag)))))
- (defun org-agenda-toggle-diary ()
- "Toggle diary inclusion in an agenda buffer."
- (interactive)
- (org-agenda-check-type t 'agenda)
- (setq org-agenda-include-diary (not org-agenda-include-diary))
- (org-agenda-redo)
- (org-agenda-set-mode-name)
- (message "Diary inclusion turned %s"
- (if org-agenda-include-diary "on" "off")))
- (defun org-agenda-toggle-deadlines ()
- "Toggle inclusion of entries with a deadline in an agenda buffer."
- (interactive)
- (org-agenda-check-type t 'agenda)
- (setq org-agenda-include-deadlines (not org-agenda-include-deadlines))
- (org-agenda-redo)
- (org-agenda-set-mode-name)
- (message "Deadlines inclusion turned %s"
- (if org-agenda-include-deadlines "on" "off")))
- (defun org-agenda-toggle-time-grid ()
- "Toggle time grid in an agenda buffer."
- (interactive)
- (org-agenda-check-type t 'agenda)
- (setq org-agenda-use-time-grid (not org-agenda-use-time-grid))
- (org-agenda-redo)
- (org-agenda-set-mode-name)
- (message "Time-grid turned %s"
- (if org-agenda-use-time-grid "on" "off")))
- (defun org-agenda-set-mode-name ()
- "Set the mode name to indicate all the small mode settings."
- (setq mode-name
- (list "Org-Agenda"
- (if (get 'org-agenda-files 'org-restrict) " []" "")
- " "
- '(:eval (org-agenda-span-name org-agenda-current-span))
- (if org-agenda-follow-mode " Follow" "")
- (if org-agenda-entry-text-mode " ETxt" "")
- (if org-agenda-include-diary " Diary" "")
- (if org-agenda-include-deadlines " Ddl" "")
- (if org-agenda-use-time-grid " Grid" "")
- (if (and (boundp 'org-habit-show-habits)
- org-habit-show-habits) " Habit" "")
- (cond
- ((consp org-agenda-show-log) " LogAll")
- ((eq org-agenda-show-log 'clockcheck) " ClkCk")
- (org-agenda-show-log " Log")
- (t ""))
- (if (or org-agenda-category-filter
- (get 'org-agenda-category-filter :preset-filter))
- '(:eval (org-propertize
- (concat " <"
- (mapconcat
- 'identity
- (append
- (get 'org-agenda-category-filter :preset-filter)
- org-agenda-category-filter)
- "")
- ">")
- 'face 'org-agenda-filter-category
- 'help-echo "Category used in filtering")) "")
- (if (or org-agenda-tag-filter
- (get 'org-agenda-tag-filter :preset-filter))
- '(:eval (org-propertize
- (concat " {"
- (mapconcat
- 'identity
- (append
- (get 'org-agenda-tag-filter :preset-filter)
- org-agenda-tag-filter)
- "")
- "}")
- 'face 'org-agenda-filter-tags
- 'help-echo "Tags used in filtering")) "")
- (if (or org-agenda-regexp-filter
- (get 'org-agenda-regexp-filter :preset-filter))
- '(:eval (org-propertize
- (concat " ["
- (mapconcat
- 'identity
- (append
- (get 'org-agenda-regexp-filter :preset-filter)
- org-agenda-regexp-filter)
- "")
- "]")
- 'face 'org-agenda-filter-regexp
- 'help-echo "Regexp used in filtering")) "")
- (if org-agenda-archives-mode
- (if (eq org-agenda-archives-mode t)
- " Archives"
- (format " :%s:" org-archive-tag))
- "")
- (if org-agenda-clockreport-mode
- (if (eq org-agenda-clockreport-mode 'with-filter)
- " Clock{}" " Clock")
- "")))
- (force-mode-line-update))
- (define-obsolete-function-alias
- 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3")
- (defun org-agenda-update-agenda-type ()
- "Update the agenda type after each command."
- (setq org-agenda-type
- (or (get-text-property (point) 'org-agenda-type)
- (get-text-property (max (point-min) (1- (point))) 'org-agenda-type))))
- (defun org-agenda-next-line ()
- "Move cursor to the next line, and show if follow mode is active."
- (interactive)
- (call-interactively 'next-line)
- (org-agenda-do-context-action))
- (defun org-agenda-previous-line ()
- "Move cursor to the previous line, and show if follow-mode is active."
- (interactive)
- (call-interactively 'previous-line)
- (org-agenda-do-context-action))
- (defun org-agenda-next-item (n)
- "Move cursor to next agenda item."
- (interactive "p")
- (let ((col (current-column)))
- (dotimes (c n)
- (when (next-single-property-change (point-at-eol) 'org-marker)
- (move-end-of-line 1)
- (goto-char (next-single-property-change (point) 'org-marker))))
- (org-move-to-column col))
- (org-agenda-do-context-action))
- (defun org-agenda-previous-item (n)
- "Move cursor to next agenda item."
- (interactive "p")
- (dotimes (c n)
- (let ((col (current-column))
- (goto (save-excursion
- (move-end-of-line 0)
- (previous-single-property-change (point) 'org-marker))))
- (if goto (goto-char goto))
- (org-move-to-column col)))
- (org-agenda-do-context-action))
- (defun org-agenda-do-context-action ()
- "Show outline path and, maybe, follow mode window."
- (let ((m (org-get-at-bol 'org-marker)))
- (when (and (markerp m) (marker-buffer m))
- (and org-agenda-follow-mode
- (if org-agenda-follow-indirect
- (org-agenda-tree-to-indirect-buffer nil)
- (org-agenda-show)))
- (and org-agenda-show-outline-path
- (org-with-point-at m (org-display-outline-path t))))))
- (defun org-agenda-show-tags ()
- "Show the tags applicable to the current item."
- (interactive)
- (let* ((tags (org-get-at-bol 'tags)))
- (if tags
- (message "Tags are :%s:"
- (org-no-properties (mapconcat 'identity tags ":")))
- (message "No tags associated with this line"))))
- (defun org-agenda-goto (&optional highlight)
- "Go to the Org-mode file which contains the item at point."
- (interactive)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (switch-to-buffer-other-window buffer)
- (widen)
- (push-mark)
- (goto-char pos)
- (when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil)))) ; show the next heading
- (when (outline-invisible-p)
- (show-entry)) ; display invisible text
- (recenter (/ (window-height) 2))
- (run-hooks 'org-agenda-after-show-hook)
- (and highlight (org-highlight (point-at-bol) (point-at-eol)))))
- (defvar org-agenda-after-show-hook nil
- "Normal hook run after an item has been shown from the agenda.
- Point is in the buffer where the item originated.")
- (defun org-agenda-kill ()
- "Kill the entry or subtree belonging to the current agenda entry."
- (interactive)
- (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
- (let* ((bufname-orig (buffer-name))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (type (org-get-at-bol 'type))
- dbeg dend (n 0) conf)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (save-excursion
- (goto-char pos)
- (if (and (derived-mode-p 'org-mode) (not (member type '("sexp"))))
- (setq dbeg (progn (org-back-to-heading t) (point))
- dend (org-end-of-subtree t t))
- (setq dbeg (point-at-bol)
- dend (min (point-max) (1+ (point-at-eol)))))
- (goto-char dbeg)
- (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
- (setq conf (or (eq t org-agenda-confirm-kill)
- (and (numberp org-agenda-confirm-kill)
- (> n org-agenda-confirm-kill))))
- (and conf
- (not (y-or-n-p
- (format "Delete entry with %d lines in buffer \"%s\"? "
- n (buffer-name buffer))))
- (error "Abort"))
- (let ((org-agenda-buffer-name bufname-orig))
- (org-remove-subtree-entries-from-agenda buffer dbeg dend))
- (with-current-buffer buffer (delete-region dbeg dend))
- (message "Agenda item and source killed"))))
- (defvar org-archive-default-command) ; defined in org-archive.el
- (defun org-agenda-archive-default ()
- "Archive the entry or subtree belonging to the current agenda entry."
- (interactive)
- (require 'org-archive)
- (org-agenda-archive-with org-archive-default-command))
- (defun org-agenda-archive-default-with-confirmation ()
- "Archive the entry or subtree belonging to the current agenda entry."
- (interactive)
- (require 'org-archive)
- (org-agenda-archive-with org-archive-default-command 'confirm))
- (defun org-agenda-archive ()
- "Archive the entry or subtree belonging to the current agenda entry."
- (interactive)
- (org-agenda-archive-with 'org-archive-subtree))
- (defun org-agenda-archive-to-archive-sibling ()
- "Move the entry to the archive sibling."
- (interactive)
- (org-agenda-archive-with 'org-archive-to-archive-sibling))
- (defun org-agenda-archive-with (cmd &optional confirm)
- "Move the entry to the archive sibling."
- (interactive)
- (or (eq major-mode 'org-agenda-mode) (error "Not in agenda"))
- (let* ((bufname-orig (buffer-name))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (if (derived-mode-p 'org-mode)
- (if (and confirm
- (not (y-or-n-p "Archive this subtree or entry? ")))
- (error "Abort")
- (save-window-excursion
- (goto-char pos)
- (let ((org-agenda-buffer-name bufname-orig))
- (org-remove-subtree-entries-from-agenda))
- (org-back-to-heading t)
- (funcall cmd)))
- (error "Archiving works only in Org-mode files"))))))
- (defun org-remove-subtree-entries-from-agenda (&optional buf beg end)
- "Remove all lines in the agenda that correspond to a given subtree.
- The subtree is the one in buffer BUF, starting at BEG and ending at END.
- If this information is not given, the function uses the tree at point."
- (let ((buf (or buf (current-buffer))) m p)
- (save-excursion
- (unless (and beg end)
- (org-back-to-heading t)
- (setq beg (point))
- (org-end-of-subtree t)
- (setq end (point)))
- (set-buffer (get-buffer org-agenda-buffer-name))
- (save-excursion
- (goto-char (point-max))
- (beginning-of-line 1)
- (while (not (bobp))
- (when (and (setq m (org-get-at-bol 'org-marker))
- (equal buf (marker-buffer m))
- (setq p (marker-position m))
- (>= p beg)
- (< p end))
- (let ((inhibit-read-only t))
- (delete-region (point-at-bol) (1+ (point-at-eol)))))
- (beginning-of-line 0))))))
- (defun org-agenda-refile (&optional goto rfloc no-update)
- "Refile the item at point.
- When GOTO is 0 or '(64), clear the refile cache.
- When GOTO is '(16), go to the location of the last refiled item.
- RFLOC can be a refile location obtained in a different way.
- When NO-UPDATE is non-nil, don't redo the agenda buffer."
- (interactive "P")
- (cond
- ((member goto '(0 (64)))
- (org-refile-cache-clear))
- ((equal goto '(16))
- (org-refile-goto-last-stored))
- (t
- (let* ((buffer-orig (buffer-name))
- (marker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (rfloc (or rfloc
- (org-refile-get-location
- (if goto "Goto" "Refile to") buffer
- org-refile-allow-creating-parent-nodes))))
- (with-current-buffer buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (let ((org-agenda-buffer-name buffer-orig))
- (org-remove-subtree-entries-from-agenda))
- (org-refile goto buffer rfloc)))))
- (unless no-update (org-agenda-redo)))))
- (defun org-agenda-open-link (&optional arg)
- "Open the link(s) in the current entry, if any.
- This looks for a link in the displayed line in the agenda.
- It also looks at the text of the entry itself."
- (interactive "P")
- (let* ((marker (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker)))
- (buffer (and marker (marker-buffer marker)))
- (prefix (buffer-substring (point-at-bol) (point-at-eol)))
- (lkall (org-offer-links-in-entry buffer marker arg prefix))
- (lk0 (car lkall))
- (lk (if (stringp lk0) (list lk0) lk0))
- (lkend (cdr lkall))
- trg)
- (cond
- ((and buffer lk)
- (mapcar (lambda(l)
- (with-current-buffer buffer
- (setq trg (and (string-match org-bracket-link-regexp l)
- (match-string 1 l)))
- (if (or (not trg) (string-match org-any-link-re trg))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char marker)
- (when (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point))))
- ;; This is an internal link, widen the buffer
- (switch-to-buffer-other-window buffer)
- (widen)
- (goto-char marker)
- (when (search-forward l nil lkend)
- (goto-char (match-beginning 0))
- (org-open-at-point)))))
- lk))
- ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)"))
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)"))))
- (org-open-link-from-string (match-string 1)))
- (t (message "No link to open here")))))
- (defun org-agenda-copy-local-variable (var)
- "Get a variable from a referenced buffer and install it here."
- (let ((m (org-get-at-bol 'org-marker)))
- (when (and m (buffer-live-p (marker-buffer m)))
- (org-set-local var (with-current-buffer (marker-buffer m)
- (symbol-value var))))))
- (defun org-agenda-switch-to (&optional delete-other-windows)
- "Go to the Org-mode file which contains the item at point."
- (interactive)
- (if (and org-return-follows-link
- (not (org-get-at-bol 'org-marker))
- (org-in-regexp org-bracket-link-regexp))
- (org-open-link-from-string (match-string 0))
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (org-pop-to-buffer-same-window buffer)
- (and delete-other-windows (delete-other-windows))
- (widen)
- (goto-char pos)
- (when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (when (outline-invisible-p)
- (show-entry)) ; display invisible text
- (run-hooks 'org-agenda-after-show-hook)))))
- (defun org-agenda-goto-mouse (ev)
- "Go to the Org-mode file which contains the item at the mouse click."
- (interactive "e")
- (mouse-set-point ev)
- (org-agenda-goto))
- (defun org-agenda-show (&optional full-entry)
- "Display the Org-mode file which contains the item at point.
- With prefix argument FULL-ENTRY, make the entire entry visible
- if it was hidden in the outline."
- (interactive "P")
- (let ((win (selected-window)))
- (if full-entry
- (let ((org-show-entry-below t))
- (org-agenda-goto t))
- (org-agenda-goto t))
- (select-window win)))
- (defvar org-agenda-show-window nil)
- (defun org-agenda-show-and-scroll-up (&optional arg)
- "Display the Org-mode file which contains the item at point.
- When called repeatedly, scroll the window that is displaying the buffer.
- With a \\[universal-argument] prefix, use `org-show-entry' instead of
- `show-subtree' to display the item, so that drawers and logbooks stay
- folded."
- (interactive "P")
- (let ((win (selected-window)))
- (if (and (window-live-p org-agenda-show-window)
- (eq this-command last-command))
- (progn
- (select-window org-agenda-show-window)
- (ignore-errors (scroll-up)))
- (org-agenda-goto t)
- (if arg (org-show-entry) (show-subtree))
- (setq org-agenda-show-window (selected-window)))
- (select-window win)))
- (defun org-agenda-show-scroll-down ()
- "Scroll down the window showing the agenda."
- (interactive)
- (let ((win (selected-window)))
- (when (window-live-p org-agenda-show-window)
- (select-window org-agenda-show-window)
- (ignore-errors (scroll-down))
- (select-window win))))
- (defun org-agenda-show-1 (&optional more)
- "Display the Org-mode file which contains the item at point.
- The prefix arg selects the amount of information to display:
- 0 hide the subtree
- 1 just show the entry according to defaults.
- 2 show the children view
- 3 show the subtree view
- 4 show the entire subtree and any LOGBOOK drawers
- 5 show the entire subtree and any drawers
- With prefix argument FULL-ENTRY, make the entire entry visible
- if it was hidden in the outline."
- (interactive "p")
- (let ((win (selected-window)))
- (org-agenda-goto t)
- (org-recenter-heading 1)
- (cond
- ((= more 0)
- (hide-subtree)
- (save-excursion
- (org-back-to-heading)
- (run-hook-with-args 'org-cycle-hook 'folded))
- (message "Remote: FOLDED"))
- ((and (org-called-interactively-p 'any) (= more 1))
- (message "Remote: show with default settings"))
- ((= more 2)
- (show-entry)
- (show-children)
- (save-excursion
- (org-back-to-heading)
- (run-hook-with-args 'org-cycle-hook 'children))
- (message "Remote: CHILDREN"))
- ((= more 3)
- (show-subtree)
- (save-excursion
- (org-back-to-heading)
- (run-hook-with-args 'org-cycle-hook 'subtree))
- (message "Remote: SUBTREE"))
- ((= more 4)
- (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers)))
- (org-drawer-regexp
- (concat "^[ \t]*:\\("
- (mapconcat 'regexp-quote org-drawers "\\|")
- "\\):[ \t]*$")))
- (show-subtree)
- (save-excursion
- (org-back-to-heading)
- (org-cycle-hide-drawers 'subtree)))
- (message "Remote: SUBTREE AND LOGBOOK"))
- ((> more 4)
- (show-subtree)
- (message "Remote: SUBTREE AND ALL DRAWERS")))
- (select-window win)))
- (defun org-recenter-heading (n)
- (save-excursion
- (org-back-to-heading)
- (recenter n)))
- (defvar org-agenda-cycle-counter nil)
- (defun org-agenda-cycle-show (&optional n)
- "Show the current entry in another window, with default settings.
- Default settings are taken from `org-show-hierarchy-above' and siblings.
- When use repeatedly in immediate succession, the remote entry will cycle
- through visibility
- children -> subtree -> folded
- When called with a numeric prefix arg, that arg will be passed through to
- `org-agenda-show-1'. For the interpretation of that argument, see the
- docstring of `org-agenda-show-1'."
- (interactive "P")
- (if (integerp n)
- (setq org-agenda-cycle-counter n)
- (if (not (eq last-command this-command))
- (setq org-agenda-cycle-counter 1)
- (if (equal org-agenda-cycle-counter 0)
- (setq org-agenda-cycle-counter 2)
- (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter))
- (if (> org-agenda-cycle-counter 3)
- (setq org-agenda-cycle-counter 0)))))
- (org-agenda-show-1 org-agenda-cycle-counter))
- (defun org-agenda-recenter (arg)
- "Display the Org-mode file which contains the item at point and recenter."
- (interactive "P")
- (let ((win (selected-window)))
- (org-agenda-goto t)
- (recenter arg)
- (select-window win)))
- (defun org-agenda-show-mouse (ev)
- "Display the Org-mode file which contains the item at the mouse click."
- (interactive "e")
- (mouse-set-point ev)
- (org-agenda-show))
- (defun org-agenda-check-no-diary ()
- "Check if the entry is a diary link and abort if yes."
- (if (org-get-at-bol 'org-agenda-diary-link)
- (org-agenda-error)))
- (defun org-agenda-error ()
- (error "Command not allowed in this line"))
- (defun org-agenda-tree-to-indirect-buffer (arg)
- "Show the subtree corresponding to the current entry in an indirect buffer.
- This calls the command `org-tree-to-indirect-buffer' from the original buffer.
- With a numerical prefix ARG, go up to this level and then take that tree.
- With a negative numeric ARG, go up by this number of levels.
- With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't
- use the dedicated frame)."
- (interactive "P")
- (if current-prefix-arg
- (org-agenda-do-tree-to-indirect-buffer arg)
- (let ((agenda-buffer (buffer-name))
- (agenda-window (selected-window))
- (indirect-window
- (and org-last-indirect-buffer
- (get-buffer-window org-last-indirect-buffer))))
- (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg))
- (unless (or (eq org-indirect-buffer-display 'new-frame)
- (eq org-indirect-buffer-display 'dedicated-frame))
- (unwind-protect
- (unless (and indirect-window (window-live-p indirect-window))
- (setq indirect-window (split-window agenda-window)))
- (and indirect-window (select-window indirect-window))
- (switch-to-buffer org-last-indirect-buffer :norecord)
- (fit-window-to-buffer indirect-window)))
- (select-window (get-buffer-window agenda-buffer)))))
- (defun org-agenda-do-tree-to-indirect-buffer (arg)
- "Same as `org-agenda-tree-to-indirect-buffer' without saving window."
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (with-current-buffer buffer
- (save-excursion
- (goto-char pos)
- (funcall 'org-tree-to-indirect-buffer arg)))))
- (defvar org-last-heading-marker (make-marker)
- "Marker pointing to the headline that last changed its TODO state
- by a remote command from the agenda.")
- (defun org-agenda-todo-nextset ()
- "Switch TODO entry to next sequence."
- (interactive)
- (org-agenda-todo 'nextset))
- (defun org-agenda-todo-previousset ()
- "Switch TODO entry to previous sequence."
- (interactive)
- (org-agenda-todo 'previousset))
- (defun org-agenda-todo (&optional arg)
- "Cycle TODO state of line at point, also in Org-mode file.
- This changes the line at point, all other lines in the agenda referring to
- the same tree node, and the headline of the tree node in the Org-mode file."
- (interactive "P")
- (org-agenda-check-no-diary)
- (let* ((col (current-column))
- (marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (hdmarker (org-get-at-bol 'org-hd-marker))
- (todayp (org-agenda-todayp (org-get-at-bol 'day)))
- (inhibit-read-only t)
- org-agenda-headline-snapshot-before-repeat newhead just-one)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (let ((current-prefix-arg arg))
- (call-interactively 'org-todo))
- (and (bolp) (forward-char 1))
- (setq newhead (org-get-heading))
- (when (and (org-bound-and-true-p
- org-agenda-headline-snapshot-before-repeat)
- (not (equal org-agenda-headline-snapshot-before-repeat
- newhead))
- todayp)
- (setq newhead org-agenda-headline-snapshot-before-repeat
- just-one t))
- (save-excursion
- (org-back-to-heading)
- (move-marker org-last-heading-marker (point))))
- (beginning-of-line 1)
- (save-excursion
- (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
- (org-move-to-column col))))
- (defun org-agenda-add-note (&optional arg)
- "Add a time-stamped note to the entry at point."
- (interactive "P")
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (hdmarker (org-get-at-bol 'org-hd-marker))
- (inhibit-read-only t))
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (org-add-note))))
- (defun org-agenda-change-all-lines (newhead hdmarker
- &optional fixface just-this)
- "Change all lines in the agenda buffer which match HDMARKER.
- The new content of the line will be NEWHEAD (as modified by
- `org-agenda-format-item'). HDMARKER is checked with
- `equal' against all `org-hd-marker' text properties in the file.
- If FIXFACE is non-nil, the face of each item is modified according to
- the new TODO state.
- If JUST-THIS is non-nil, change just the current line, not all.
- If FORCE-TAGS is non nil, the car of it returns the new tags."
- (let* ((inhibit-read-only t)
- (line (org-current-line))
- (org-agenda-buffer (current-buffer))
- (thetags (with-current-buffer (marker-buffer hdmarker)
- (save-excursion (save-restriction (widen)
- (goto-char hdmarker)
- (org-get-tags-at)))))
- props m pl undone-face done-face finish new dotime level cat tags)
- (save-excursion
- (goto-char (point-max))
- (beginning-of-line 1)
- (while (not finish)
- (setq finish (bobp))
- (when (and (setq m (org-get-at-bol 'org-hd-marker))
- (or (not just-this) (= (org-current-line) line))
- (equal m hdmarker))
- (setq props (text-properties-at (point))
- dotime (org-get-at-bol 'dotime)
- cat (org-get-at-bol 'org-category)
- level (org-get-at-bol 'level)
- tags thetags
- new
- (let ((org-prefix-format-compiled
- (or (get-text-property (min (1- (point-max)) (point)) 'format)
- org-prefix-format-compiled))
- (extra (org-get-at-bol 'extra)))
- (with-current-buffer (marker-buffer hdmarker)
- (save-excursion
- (save-restriction
- (widen)
- (org-agenda-format-item extra newhead level cat tags dotime)))))
- pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t)
- undone-face (org-get-at-bol 'undone-face)
- done-face (org-get-at-bol 'done-face))
- (beginning-of-line 1)
- (cond
- ((equal new "")
- (and (looking-at ".*\n?") (replace-match "")))
- ((looking-at ".*")
- (replace-match new t t)
- (beginning-of-line 1)
- (add-text-properties (point-at-bol) (point-at-eol) props)
- (when fixface
- (add-text-properties
- (point-at-bol) (point-at-eol)
- (list 'face
- (if org-last-todo-state-is-todo
- undone-face done-face))))
- (org-agenda-highlight-todo 'line)
- (beginning-of-line 1))
- (t (error "Line update did not work")))
- (save-restriction
- (narrow-to-region (point-at-bol) (point-at-eol))
- (org-agenda-finalize)))
- (beginning-of-line 0)))))
- (defun org-agenda-align-tags (&optional line)
- "Align all tags in agenda items to `org-agenda-tags-column'."
- (let ((inhibit-read-only t) l c)
- (save-excursion
- (goto-char (if line (point-at-bol) (point-min)))
- (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
- (if line (point-at-eol) nil) t)
- (add-text-properties
- (match-beginning 2) (match-end 2)
- (list 'face (delq nil (let ((prop (get-text-property
- (match-beginning 2) 'face)))
- (or (listp prop) (setq prop (list prop)))
- (if (memq 'org-tag prop)
- prop
- (cons 'org-tag prop))))))
- (setq l (- (match-end 2) (match-beginning 2))
- c (if (< org-agenda-tags-column 0)
- (- (abs org-agenda-tags-column) l)
- org-agenda-tags-column))
- (delete-region (match-beginning 1) (match-end 1))
- (goto-char (match-beginning 1))
- (insert (org-add-props
- (make-string (max 1 (- c (current-column))) ?\ )
- (plist-put (copy-sequence (text-properties-at (point)))
- 'face nil))))
- (goto-char (point-min))
- (org-font-lock-add-tag-faces (point-max)))))
- (defun org-agenda-priority-up ()
- "Increase the priority of line at point, also in Org-mode file."
- (interactive)
- (org-agenda-priority 'up))
- (defun org-agenda-priority-down ()
- "Decrease the priority of line at point, also in Org-mode file."
- (interactive)
- (org-agenda-priority 'down))
- (defun org-agenda-priority (&optional force-direction)
- "Set the priority of line at point, also in Org-mode file.
- This changes the line at point, all other lines in the agenda referring to
- the same tree node, and the headline of the tree node in the Org-mode file.
- Called with a universal prefix arg, show the priority instead of setting it."
- (interactive "P")
- (if (equal force-direction '(4))
- (org-show-priority)
- (unless org-enable-priority-commands
- (error "Priority commands are disabled"))
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (hdmarker (org-get-at-bol 'org-hd-marker))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (funcall 'org-priority force-direction)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
- ;; FIXME: should fix the tags property of the agenda line.
- (defun org-agenda-set-tags (&optional tag onoff)
- "Set tags for the current headline."
- (interactive)
- (org-agenda-check-no-diary)
- (if (and (org-region-active-p) (org-called-interactively-p 'any))
- (call-interactively 'org-change-tag-in-region)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
- (if tag
- (org-toggle-tag tag onoff)
- (call-interactively 'org-set-tags))
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1)))))
- (defun org-agenda-set-property ()
- "Set a property for the current headline."
- (interactive)
- (org-agenda-check-no-diary)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
- (call-interactively 'org-set-property)))))
- (defun org-agenda-set-effort ()
- "Set the effort property for the current headline."
- (interactive)
- (org-agenda-check-no-diary)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (save-excursion
- (org-show-context 'agenda))
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (goto-char pos)
- (call-interactively 'org-set-effort)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker))))
- (defun org-agenda-toggle-archive-tag ()
- "Toggle the archive tag for the current entry."
- (interactive)
- (org-agenda-check-no-diary)
- (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
- (org-agenda-error)))
- (buffer (marker-buffer hdmarker))
- (pos (marker-position hdmarker))
- (inhibit-read-only t)
- newhead)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (save-excursion
- (and (outline-next-heading)
- (org-flag-heading nil))) ; show the next heading
- (call-interactively 'org-toggle-archive-tag)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)
- (beginning-of-line 1))))
- (defun org-agenda-do-date-later (arg)
- (interactive "P")
- (cond
- ((or (equal arg '(16))
- (memq last-command
- '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
- (setq this-command 'org-agenda-date-later-minutes)
- (org-agenda-date-later-minutes 1))
- ((or (equal arg '(4))
- (memq last-command
- '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
- (setq this-command 'org-agenda-date-later-hours)
- (org-agenda-date-later-hours 1))
- (t
- (org-agenda-date-later (prefix-numeric-value arg)))))
- (defun org-agenda-do-date-earlier (arg)
- (interactive "P")
- (cond
- ((or (equal arg '(16))
- (memq last-command
- '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes)))
- (setq this-command 'org-agenda-date-earlier-minutes)
- (org-agenda-date-earlier-minutes 1))
- ((or (equal arg '(4))
- (memq last-command
- '(org-agenda-date-later-hours org-agenda-date-earlier-hours)))
- (setq this-command 'org-agenda-date-earlier-hours)
- (org-agenda-date-earlier-hours 1))
- (t
- (org-agenda-date-earlier (prefix-numeric-value arg)))))
- (defun org-agenda-date-later (arg &optional what)
- "Change the date of this item to ARG day(s) later."
- (interactive "p")
- (org-agenda-check-type t 'agenda 'timeline)
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- cdate today)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (if (not (org-at-timestamp-p))
- (error "Cannot find time stamp"))
- (when (and org-agenda-move-date-from-past-immediately-to-today
- (equal arg 1)
- (or (not what) (eq what 'day))
- (not (save-match-data (org-at-date-range-p))))
- (setq cdate (org-parse-time-string (match-string 0) 'nodefault)
- cdate (calendar-absolute-from-gregorian
- (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate)))
- today (org-today))
- (if (> today cdate)
- ;; immediately shift to today
- (setq arg (- today cdate))))
- (org-timestamp-change arg (or what 'day))
- (when (and (org-at-date-range-p)
- (re-search-backward org-tr-regexp-both (point-at-bol)))
- (let ((end org-last-changed-timestamp))
- (org-timestamp-change arg (or what 'day))
- (setq org-last-changed-timestamp
- (concat org-last-changed-timestamp "--" end)))))
- (org-agenda-show-new-time marker org-last-changed-timestamp))
- (message "Time stamp changed to %s" org-last-changed-timestamp)))
- (defun org-agenda-date-earlier (arg &optional what)
- "Change the date of this item to ARG day(s) earlier."
- (interactive "p")
- (org-agenda-date-later (- arg) what))
- (defun org-agenda-date-later-minutes (arg)
- "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
- (interactive "p")
- (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
- (org-agenda-date-later arg 'minute))
- (defun org-agenda-date-earlier-minutes (arg)
- "Change the time of this item, in units of `org-time-stamp-rounding-minutes'."
- (interactive "p")
- (setq arg (* arg (cadr org-time-stamp-rounding-minutes)))
- (org-agenda-date-earlier arg 'minute))
- (defun org-agenda-date-later-hours (arg)
- "Change the time of this item, in hour steps."
- (interactive "p")
- (org-agenda-date-later arg 'hour))
- (defun org-agenda-date-earlier-hours (arg)
- "Change the time of this item, in hour steps."
- (interactive "p")
- (org-agenda-date-earlier arg 'hour))
- (defun org-agenda-show-new-time (marker stamp &optional prefix)
- "Show new date stamp via text properties."
- ;; We use text properties to make this undoable
- (let ((inhibit-read-only t))
- (setq stamp (concat prefix " => " stamp " "))
- (save-excursion
- (goto-char (point-max))
- (while (not (bobp))
- (when (equal marker (org-get-at-bol 'org-marker))
- (org-move-to-column (- (window-width) (length stamp)) t nil t)
- (org-agenda-fix-tags-filter-overlays-at (point))
- (if (featurep 'xemacs)
- ;; Use `duplicable' property to trigger undo recording
- (let ((ex (make-extent nil nil))
- (gl (make-glyph stamp)))
- (set-glyph-face gl 'secondary-selection)
- (set-extent-properties
- ex (list 'invisible t 'end-glyph gl 'duplicable t))
- (insert-extent ex (1- (point)) (point-at-eol)))
- (add-text-properties
- (1- (point)) (point-at-eol)
- (list 'display (org-add-props stamp nil
- 'face 'secondary-selection))))
- (beginning-of-line 1))
- (beginning-of-line 0)))))
- (defun org-agenda-date-prompt (arg)
- "Change the date of this item. Date is prompted for, with default today.
- The prefix ARG is passed to the `org-time-stamp' command and can therefore
- be used to request time specification in the time stamp."
- (interactive "P")
- (org-agenda-check-type t 'agenda 'timeline)
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (if (not (org-at-timestamp-p t))
- (error "Cannot find time stamp"))
- (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[)))
- (org-agenda-show-new-time marker org-last-changed-timestamp))
- (message "Time stamp changed to %s" org-last-changed-timestamp)))
- (defun org-agenda-schedule (arg &optional time)
- "Schedule the item at point.
- ARG is passed through to `org-schedule'."
- (interactive "P")
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (type (marker-insertion-type marker))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (org-insert-labeled-timestamps-at-point nil)
- ts)
- (set-marker-insertion-type marker t)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (setq ts (org-schedule arg time)))
- (org-agenda-show-new-time marker ts " S"))
- (message "%s" ts)))
- (defun org-agenda-deadline (arg &optional time)
- "Schedule the item at point.
- ARG is passed through to `org-deadline'."
- (interactive "P")
- (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search)
- (org-agenda-check-no-diary)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- (org-insert-labeled-timestamps-at-point nil)
- ts)
- (org-with-remote-undo buffer
- (with-current-buffer buffer
- (widen)
- (goto-char pos)
- (setq ts (org-deadline arg time)))
- (org-agenda-show-new-time marker ts " D"))
- (message "%s" ts)))
- (defun org-agenda-clock-in (&optional arg)
- "Start the clock on the currently selected item."
- (interactive "P")
- (org-agenda-check-no-diary)
- (if (equal arg '(4))
- (org-clock-in arg)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (hdmarker (or (org-get-at-bol 'org-hd-marker) marker))
- (pos (marker-position marker))
- (col (current-column))
- newhead)
- (org-with-remote-undo (marker-buffer marker)
- (with-current-buffer (marker-buffer marker)
- (widen)
- (goto-char pos)
- (org-show-context 'agenda)
- (org-show-entry)
- (org-cycle-hide-drawers 'children)
- (org-clock-in arg)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker))
- (org-move-to-column col))))
- (defun org-agenda-clock-out ()
- "Stop the currently running clock."
- (interactive)
- (unless (marker-buffer org-clock-marker)
- (error "No running clock"))
- (let ((marker (make-marker)) (col (current-column)) newhead)
- (org-with-remote-undo (marker-buffer org-clock-marker)
- (with-current-buffer (marker-buffer org-clock-marker)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char org-clock-marker)
- (org-back-to-heading t)
- (move-marker marker (point))
- (org-clock-out)
- (setq newhead (org-get-heading))))))
- (org-agenda-change-all-lines newhead marker)
- (move-marker marker nil)
- (org-move-to-column col)
- (org-agenda-unmark-clocking-task)))
- (defun org-agenda-clock-cancel (&optional arg)
- "Cancel the currently running clock."
- (interactive "P")
- (unless (marker-buffer org-clock-marker)
- (user-error "No running clock"))
- (org-with-remote-undo (marker-buffer org-clock-marker)
- (org-clock-cancel)))
- (defun org-agenda-clock-goto ()
- "Jump to the currently clocked in task within the agenda.
- If the currently clocked in task is not listed in the agenda
- buffer, display it in another window."
- (interactive)
- (let (pos)
- (mapc (lambda (o)
- (if (eq (overlay-get o 'type) 'org-agenda-clocking)
- (setq pos (overlay-start o))))
- (overlays-in (point-min) (point-max)))
- (cond (pos (goto-char pos))
- ;; If the currently clocked entry is not in the agenda
- ;; buffer, we visit it in another window:
- (org-clock-current-task
- (org-switch-to-buffer-other-window (org-clock-goto)))
- (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one")))))
- (defun org-agenda-diary-entry-in-org-file ()
- "Make a diary entry in the file `org-agenda-diary-file'."
- (let (d1 d2 char (text "") dp1 dp2)
- (if (equal (buffer-name) "*Calendar*")
- (setq d1 (calendar-cursor-to-date t)
- d2 (car calendar-mark-ring))
- (setq dp1 (get-text-property (point-at-bol) 'day))
- (unless dp1 (user-error "No date defined in current line"))
- (setq d1 (calendar-gregorian-from-absolute dp1)
- d2 (and (ignore-errors (mark))
- (save-excursion
- (goto-char (mark))
- (setq dp2 (get-text-property (point-at-bol) 'day)))
- (calendar-gregorian-from-absolute dp2))))
- (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree")
- (setq char (read-char-exclusive))
- (cond
- ((equal char ?d)
- (setq text (read-string "Day entry: "))
- (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1)
- (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
- ((equal char ?a)
- (setq d1 (list (car d1) (nth 1 d1)
- (read-number (format "Reference year [%d]: " (nth 2 d1))
- (nth 2 d1))))
- (setq text (read-string "Anniversary (use %d to show years): "))
- (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1)
- (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
- ((equal char ?b)
- (setq text (read-string "Block entry: "))
- (unless (and d1 d2 (not (equal d1 d2)))
- (user-error "No block of days selected"))
- (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2)
- (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo)))
- ((equal char ?j)
- (org-switch-to-buffer-other-window
- (find-file-noselect org-agenda-diary-file))
- (require 'org-datetree)
- (org-datetree-find-date-create d1)
- (org-reveal t))
- (t (user-error "Invalid selection character `%c'" char)))))
- (defcustom org-agenda-insert-diary-strategy 'date-tree
- "Where in `org-agenda-diary-file' should new entries be added?
- Valid values:
- date-tree in the date tree, as child of the date
- top-level as top-level entries at the end of the file."
- :group 'org-agenda
- :type '(choice
- (const :tag "in a date tree" date-tree)
- (const :tag "as top level at end of file" top-level)))
- (defcustom org-agenda-insert-diary-extract-time nil
- "Non-nil means extract any time specification from the diary entry."
- :group 'org-agenda
- :version "24.1"
- :type 'boolean)
- (defcustom org-agenda-bulk-mark-char ">"
- "A single-character string to be used as the bulk mark."
- :group 'org-agenda
- :version "24.1"
- :type 'string)
- (defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2)
- "Add a diary entry with TYPE to `org-agenda-diary-file'.
- If TEXT is not empty, it will become the headline of the new entry, and
- the resulting entry will not be shown. When TEXT is empty, switch to
- `org-agenda-diary-file' and let the user finish the entry there."
- (let ((cw (current-window-configuration)))
- (org-switch-to-buffer-other-window
- (find-file-noselect org-agenda-diary-file))
- (widen)
- (goto-char (point-min))
- (cond
- ((eq type 'anniversary)
- (or (re-search-forward "^*[ \t]+Anniversaries" nil t)
- (progn
- (or (org-at-heading-p t)
- (progn
- (outline-next-heading)
- (insert "* Anniversaries\n\n")
- (beginning-of-line -1)))))
- (outline-next-heading)
- (org-back-over-empty-lines)
- (backward-char 1)
- (insert "\n")
- (insert (format "%%%%(org-anniversary %d %2d %2d) %s"
- (nth 2 d1) (car d1) (nth 1 d1) text)))
- ((eq type 'day)
- (let ((org-prefix-has-time t)
- (org-agenda-time-leading-zero t)
- fmt time time2)
- (if org-agenda-insert-diary-extract-time
- ;; Use org-agenda-format-item to parse text for a time-range and
- ;; remove it. FIXME: This is a hack, we should refactor
- ;; that function to make time extraction available separately
- (setq fmt (org-agenda-format-item nil text nil nil nil t)
- time (get-text-property 0 'time fmt)
- time2 (if (> (length time) 0)
- ;; split-string removes trailing ...... if
- ;; no end time given. First space
- ;; separates time from date.
- (concat " " (car (split-string time "\\.")))
- nil)
- text (get-text-property 0 'txt fmt)))
- (if (eq org-agenda-insert-diary-strategy 'top-level)
- (org-agenda-insert-diary-as-top-level text)
- (require 'org-datetree)
- (org-datetree-find-date-create d1)
- (org-agenda-insert-diary-make-new-entry text))
- (org-insert-time-stamp (org-time-from-absolute
- (calendar-absolute-from-gregorian d1))
- nil nil nil nil time2))
- (end-of-line 0))
- ((eq type 'block)
- (if (> (calendar-absolute-from-gregorian d1)
- (calendar-absolute-from-gregorian d2))
- (setq d1 (prog1 d2 (setq d2 d1))))
- (if (eq org-agenda-insert-diary-strategy 'top-level)
- (org-agenda-insert-diary-as-top-level text)
- (require 'org-datetree)
- (org-datetree-find-date-create d1)
- (org-agenda-insert-diary-make-new-entry text))
- (org-insert-time-stamp (org-time-from-absolute
- (calendar-absolute-from-gregorian d1)))
- (insert "--")
- (org-insert-time-stamp (org-time-from-absolute
- (calendar-absolute-from-gregorian d2)))
- (end-of-line 0)))
- (if (string-match "\\S-" text)
- (progn
- (set-window-configuration cw)
- (message "%s entry added to %s"
- (capitalize (symbol-name type))
- (abbreviate-file-name org-agenda-diary-file)))
- (org-reveal t)
- (message "Please finish entry here"))))
- (defun org-agenda-insert-diary-as-top-level (text)
- "Make new entry as a top-level entry at the end of the file.
- Add TEXT as headline, and position the cursor in the second line so that
- a timestamp can be added there."
- (widen)
- (goto-char (point-max))
- (or (bolp) (insert "\n"))
- (insert "* " text "\n")
- (if org-adapt-indentation (org-indent-to-column 2)))
- (defun org-agenda-insert-diary-make-new-entry (text)
- "Make new entry as last child of current entry.
- Add TEXT as headline, and position the cursor in the second line so that
- a timestamp can be added there."
- (let ((org-show-following-heading t)
- (org-show-siblings t)
- (org-show-hierarchy-above t)
- (org-show-entry-below t)
- col)
- (outline-next-heading)
- (org-back-over-empty-lines)
- (or (looking-at "[ \t]*$")
- (progn (insert "\n") (backward-char 1)))
- (org-insert-heading nil t)
- (org-do-demote)
- (setq col (current-column))
- (insert text "\n")
- (if org-adapt-indentation (org-indent-to-column col))
- (let ((org-show-following-heading t)
- (org-show-siblings t)
- (org-show-hierarchy-above t)
- (org-show-entry-below t))
- (org-show-context))))
- (defun org-agenda-diary-entry ()
- "Make a diary entry, like the `i' command from the calendar.
- All the standard commands work: block, weekly etc.
- When `org-agenda-diary-file' points to a file,
- `org-agenda-diary-entry-in-org-file' is called instead to create
- entries in that Org-mode file."
- (interactive)
- (if (not (eq org-agenda-diary-file 'diary-file))
- (org-agenda-diary-entry-in-org-file)
- (require 'diary-lib)
- (let* ((char (progn
- (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic")
- (read-char-exclusive)))
- (cmd (cdr (assoc char
- '((?d . insert-diary-entry)
- (?w . insert-weekly-diary-entry)
- (?m . insert-monthly-diary-entry)
- (?y . insert-yearly-diary-entry)
- (?a . insert-anniversary-diary-entry)
- (?b . insert-block-diary-entry)
- (?c . insert-cyclic-diary-entry)))))
- (oldf (symbol-function 'calendar-cursor-to-date))
- ;; (buf (get-file-buffer (substitute-in-file-name diary-file)))
- (point (point))
- (mark (or (mark t) (point))))
- (unless cmd
- (user-error "No command associated with <%c>" char))
- (unless (and (get-text-property point 'day)
- (or (not (equal ?b char))
- (get-text-property mark 'day)))
- (user-error "Don't know which date to use for diary entry"))
- ;; We implement this by hacking the `calendar-cursor-to-date' function
- ;; and the `calendar-mark-ring' variable. Saves a lot of code.
- (let ((calendar-mark-ring
- (list (calendar-gregorian-from-absolute
- (or (get-text-property mark 'day)
- (get-text-property point 'day))))))
- (unwind-protect
- (progn
- (fset 'calendar-cursor-to-date
- (lambda (&optional error dummy)
- (calendar-gregorian-from-absolute
- (get-text-property point 'day))))
- (call-interactively cmd))
- (fset 'calendar-cursor-to-date oldf))))))
- (defun org-agenda-execute-calendar-command (cmd)
- "Execute a calendar command from the agenda with date from cursor."
- (org-agenda-check-type t 'agenda 'timeline)
- (require 'diary-lib)
- (unless (get-text-property (min (1- (point-max)) (point)) 'day)
- (user-error "Don't know which date to use for the calendar command"))
- (let* ((oldf (symbol-function 'calendar-cursor-to-date))
- (point (point))
- (date (calendar-gregorian-from-absolute
- (get-text-property point 'day)))
- ;; the following 2 vars are needed in the calendar
- (displayed-month (car date))
- (displayed-year (nth 2 date)))
- (unwind-protect
- (progn
- (fset 'calendar-cursor-to-date
- (lambda (&optional error dummy)
- (calendar-gregorian-from-absolute
- (get-text-property point 'day))))
- (call-interactively cmd))
- (fset 'calendar-cursor-to-date oldf))))
- (defun org-agenda-phases-of-moon ()
- "Display the phases of the moon for the 3 months around the cursor date."
- (interactive)
- (org-agenda-execute-calendar-command 'calendar-phases-of-moon))
- (defun org-agenda-holidays ()
- "Display the holidays for the 3 months around the cursor date."
- (interactive)
- (org-agenda-execute-calendar-command 'list-calendar-holidays))
- (defvar calendar-longitude) ; defined in calendar.el
- (defvar calendar-latitude) ; defined in calendar.el
- (defvar calendar-location-name) ; defined in calendar.el
- (defun org-agenda-sunrise-sunset (arg)
- "Display sunrise and sunset for the cursor date.
- Latitude and longitude can be specified with the variables
- `calendar-latitude' and `calendar-longitude'. When called with prefix
- argument, latitude and longitude will be prompted for."
- (interactive "P")
- (require 'solar)
- (let ((calendar-longitude (if arg nil calendar-longitude))
- (calendar-latitude (if arg nil calendar-latitude))
- (calendar-location-name
- (if arg "the given coordinates" calendar-location-name)))
- (org-agenda-execute-calendar-command 'calendar-sunrise-sunset)))
- (defun org-agenda-goto-calendar ()
- "Open the Emacs calendar with the date at the cursor."
- (interactive)
- (org-agenda-check-type t 'agenda 'timeline)
- (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
- (user-error "Don't know which date to open in calendar")))
- (date (calendar-gregorian-from-absolute day))
- (calendar-move-hook nil)
- (calendar-view-holidays-initially-flag nil)
- (calendar-view-diary-initially-flag nil))
- (calendar)
- (calendar-goto-date date)))
- ;;;###autoload
- (defun org-calendar-goto-agenda ()
- "Compute the Org-mode agenda for the calendar date displayed at the cursor.
- This is a command that has to be installed in `calendar-mode-map'."
- (interactive)
- (org-agenda-list nil (calendar-absolute-from-gregorian
- (calendar-cursor-to-date))
- nil))
- (defun org-agenda-convert-date ()
- (interactive)
- (org-agenda-check-type t 'agenda 'timeline)
- (let ((day (get-text-property (min (1- (point-max)) (point)) 'day))
- date s)
- (unless day
- (user-error "Don't know which date to convert"))
- (setq date (calendar-gregorian-from-absolute day))
- (setq s (concat
- "Gregorian: " (calendar-date-string date) "\n"
- "ISO: " (calendar-iso-date-string date) "\n"
- "Day of Yr: " (calendar-day-of-year-string date) "\n"
- "Julian: " (calendar-julian-date-string date) "\n"
- "Astron. JD: " (calendar-astro-date-string date)
- " (Julian date number at noon UTC)\n"
- "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n"
- "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n"
- "French: " (calendar-french-date-string date) "\n"
- "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n"
- "Mayan: " (calendar-mayan-date-string date) "\n"
- "Coptic: " (calendar-coptic-date-string date) "\n"
- "Ethiopic: " (calendar-ethiopic-date-string date) "\n"
- "Persian: " (calendar-persian-date-string date) "\n"
- "Chinese: " (calendar-chinese-date-string date) "\n"))
- (with-output-to-temp-buffer "*Dates*"
- (princ s))
- (org-fit-window-to-buffer (get-buffer-window "*Dates*"))))
- ;;; Bulk commands
- (defun org-agenda-bulk-marked-p ()
- (eq (get-char-property (point-at-bol) 'type)
- 'org-marked-entry-overlay))
- (defun org-agenda-bulk-mark (&optional arg)
- "Mark the entry at point for future bulk action."
- (interactive "p")
- (dotimes (i (or arg 1))
- (unless (org-get-at-bol 'org-agenda-diary-link)
- (let* ((m (org-get-at-bol 'org-hd-marker))
- ov)
- (unless (org-agenda-bulk-marked-p)
- (unless m (user-error "Nothing to mark at point"))
- (push m org-agenda-bulk-marked-entries)
- (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol))))
- (org-overlay-display ov (concat org-agenda-bulk-mark-char " ")
- (org-get-todo-face "TODO")
- 'evaporate)
- (overlay-put ov 'type 'org-marked-entry-overlay))
- (end-of-line 1)
- (or (ignore-errors
- (goto-char (next-single-property-change (point) 'txt)))
- (beginning-of-line 2))
- (while (and (get-char-property (point) 'invisible) (not (eobp)))
- (beginning-of-line 2))
- (message "%d entries marked for bulk action"
- (length org-agenda-bulk-marked-entries))))))
- (defun org-agenda-bulk-mark-all ()
- "Mark all entries for future agenda bulk action."
- (interactive)
- (org-agenda-bulk-mark-regexp "."))
- (defun org-agenda-bulk-mark-regexp (regexp)
- "Mark entries matching REGEXP for future agenda bulk action."
- (interactive "sMark entries matching regexp: ")
- (let ((entries-marked 0) txt-at-point)
- (save-excursion
- (goto-char (point-min))
- (goto-char (next-single-property-change (point) 'txt))
- (while (and (re-search-forward regexp nil t)
- (setq txt-at-point (get-text-property (point) 'txt)))
- (when (string-match regexp txt-at-point)
- (setq entries-marked (1+ entries-marked))
- (call-interactively 'org-agenda-bulk-mark))))
- (if (not entries-marked)
- (message "No entry matching this regexp."))))
- (defun org-agenda-bulk-unmark (&optional arg)
- "Unmark the entry at point for future bulk action."
- (interactive "P")
- (if arg
- (org-agenda-bulk-unmark-all)
- (cond ((org-agenda-bulk-marked-p)
- (org-agenda-bulk-remove-overlays
- (point-at-bol) (+ 2 (point-at-bol)))
- (setq org-agenda-bulk-marked-entries
- (delete (org-get-at-bol 'org-hd-marker)
- org-agenda-bulk-marked-entries))
- (end-of-line 1)
- (or (ignore-errors
- (goto-char (next-single-property-change (point) 'txt)))
- (beginning-of-line 2))
- (while (and (get-char-property (point) 'invisible) (not (eobp)))
- (beginning-of-line 2))
- (message "%d entries left marked for bulk action"
- (length org-agenda-bulk-marked-entries)))
- (t (message "No entry to unmark here")))))
- (defun org-agenda-bulk-toggle-all ()
- "Toggle all marks for bulk action."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (while (ignore-errors
- (goto-char (next-single-property-change (point) 'txt)))
- (org-agenda-bulk-toggle))))
- (defun org-agenda-bulk-toggle ()
- "Toggle the mark at point for bulk action."
- (interactive)
- (if (org-agenda-bulk-marked-p)
- (org-agenda-bulk-unmark)
- (org-agenda-bulk-mark)))
- (defun org-agenda-bulk-remove-overlays (&optional beg end)
- "Remove the mark overlays between BEG and END in the agenda buffer.
- BEG and END default to the buffer limits.
- This only removes the overlays, it does not remove the markers
- from the list in `org-agenda-bulk-marked-entries'."
- (interactive)
- (mapc (lambda (ov)
- (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay)
- (delete-overlay ov)))
- (overlays-in (or beg (point-min)) (or end (point-max)))))
- (defun org-agenda-bulk-unmark-all ()
- "Remove all marks in the agenda buffer.
- This will remove the markers and the overlays."
- (interactive)
- (if (null org-agenda-bulk-marked-entries)
- (message "No entry to unmark")
- (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries)
- (setq org-agenda-bulk-marked-entries nil)
- (org-agenda-bulk-remove-overlays (point-min) (point-max))))
- (defcustom org-agenda-persistent-marks nil
- "Non-nil means marked items will stay marked after a bulk action.
- You can toggle this interactively by typing `p' when prompted for a
- bulk action."
- :group 'org-agenda
- :version "24.1"
- :type 'boolean)
- (defun org-agenda-bulk-action (&optional arg)
- "Execute an remote-editing action on all marked entries.
- The prefix arg is passed through to the command if possible."
- (interactive "P")
- ;; Make sure we have markers, and only valid ones
- (unless org-agenda-bulk-marked-entries (user-error "No entries are marked"))
- (mapc
- (lambda (m)
- (unless (and (markerp m)
- (marker-buffer m)
- (buffer-live-p (marker-buffer m))
- (marker-position m))
- (user-error "Marker %s for bulk command is invalid" m)))
- org-agenda-bulk-marked-entries)
- ;; Prompt for the bulk command
- (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: ")))
- (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
- "[S]catter [f]unction "
- (when org-agenda-bulk-custom-functions
- (concat " Custom: ["
- (mapconcat (lambda(f) (char-to-string (car f)))
- org-agenda-bulk-custom-functions "")
- "]"))))
- (catch 'exit
- (let* ((action (read-char-exclusive))
- (org-log-refile (if org-log-refile 'time nil))
- (entries (reverse org-agenda-bulk-marked-entries))
- (org-overriding-default-time
- (if (get-text-property (point) 'org-agenda-date-header)
- (org-get-cursor-date)))
- redo-at-end
- cmd rfloc state e tag pos (cnt 0) (cntskip 0))
- (cond
- ((equal action ?p)
- (let ((org-agenda-persistent-marks
- (not org-agenda-persistent-marks)))
- (org-agenda-bulk-action)
- (throw 'exit nil)))
- ((equal action ?$)
- (setq cmd '(org-agenda-archive)))
- ((equal action ?A)
- (setq cmd '(org-agenda-archive-to-archive-sibling)))
- ((member action '(?r ?w))
- (setq rfloc (org-refile-get-location
- "Refile to"
- (marker-buffer (car entries))
- org-refile-allow-creating-parent-nodes))
- (if (nth 3 rfloc)
- (setcar (nthcdr 3 rfloc)
- (move-marker (make-marker) (nth 3 rfloc)
- (or (get-file-buffer (nth 1 rfloc))
- (find-buffer-visiting (nth 1 rfloc))
- (error "This should not happen")))))
- (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t)
- redo-at-end t))
- ((equal action ?t)
- (setq state (org-icompleting-read
- "Todo state: "
- (with-current-buffer (marker-buffer (car entries))
- (mapcar 'list org-todo-keywords-1))))
- (setq cmd `(let ((org-inhibit-blocking t)
- (org-inhibit-logging 'note))
- (org-agenda-todo ,state))))
- ((memq action '(?- ?+))
- (setq tag (org-icompleting-read
- (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
- (with-current-buffer (marker-buffer (car entries))
- (delq nil
- (mapcar (lambda (x)
- (if (stringp (car x)) x)) org-tag-alist)))))
- (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off))))
- ((memq action '(?s ?d))
- (let* ((time
- (unless arg
- (org-read-date
- nil nil nil
- (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to")
- org-overriding-default-time)))
- (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline)))
- (setq cmd `(eval '(,c1 arg ,time)))))
- ((equal action ?S)
- (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo))
- (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type)
- (let ((days (read-number
- (format "Scatter tasks across how many %sdays: "
- (if arg "week" "")) 7)))
- (setq cmd
- `(let ((distance (1+ (random ,days))))
- (if arg
- (let ((dist distance)
- (day-of-week
- (calendar-day-of-week
- (calendar-gregorian-from-absolute (org-today)))))
- (dotimes (i (1+ dist))
- (while (member day-of-week org-agenda-weekend-days)
- (incf distance)
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))
- (incf day-of-week)
- (if (= day-of-week 7)
- (setq day-of-week 0)))))
- ;; silently fail when try to replan a sexp entry
- (condition-case nil
- (let* ((date (calendar-gregorian-from-absolute
- (+ (org-today) distance)))
- (time (encode-time 0 0 0 (nth 1 date) (nth 0 date)
- (nth 2 date))))
- (org-agenda-schedule nil time))
- (error nil)))))))
- ((assoc action org-agenda-bulk-custom-functions)
- (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions)))
- redo-at-end t))
- ((equal action ?f)
- (setq cmd (list (intern
- (org-icompleting-read "Function: "
- obarray 'fboundp t nil nil)))))
- (t (user-error "Invalid bulk action")))
- ;; Sort the markers, to make sure that parents are handled before children
- (setq entries (sort entries
- (lambda (a b)
- (cond
- ((equal (marker-buffer a) (marker-buffer b))
- (< (marker-position a) (marker-position b)))
- (t
- (string< (buffer-name (marker-buffer a))
- (buffer-name (marker-buffer b))))))))
- ;; Now loop over all markers and apply cmd
- (while (setq e (pop entries))
- (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e))
- (if (not pos)
- (progn (message "Skipping removed entry at %s" e)
- (setq cntskip (1+ cntskip)))
- (goto-char pos)
- (let (org-loop-over-headlines-in-active-region)
- (eval cmd))
- (setq cnt (1+ cnt))))
- (when redo-at-end (org-agenda-redo))
- (unless org-agenda-persistent-marks
- (org-agenda-bulk-unmark-all))
- (message "Acted on %d entries%s%s"
- cnt
- (if (= cntskip 0)
- ""
- (format ", skipped %d (disappeared before their turn)"
- cntskip))
- (if (not org-agenda-persistent-marks)
- "" " (kept marked)"))))))
- (defun org-agenda-capture (&optional with-time)
- "Call `org-capture' with the date at point.
- With a `C-1' prefix, use the HH:MM value at point (if any) or the
- current HH:MM time."
- (interactive "P")
- (if (not (eq major-mode 'org-agenda-mode))
- (user-error "You cannot do this outside of agenda buffers")
- (let ((org-overriding-default-time
- (org-get-cursor-date (equal with-time 1))))
- (call-interactively 'org-capture))))
- ;;; Dragging agenda lines forward/backward
- (defun org-agenda-drag-line-forward (arg)
- "Drag an agenda line forward by ARG lines."
- (interactive "p")
- (let ((inhibit-read-only t) lst)
- (if (or (not (get-text-property (point) 'txt))
- (save-excursion
- (dotimes (n arg)
- (move-beginning-of-line 2)
- (push (not (get-text-property (point) 'txt)) lst))
- (delq nil lst)))
- (message "Cannot move line forward")
- (org-drag-line-forward arg))))
- (defun org-agenda-drag-line-backward (arg)
- "Drag an agenda line backward by ARG lines."
- (interactive "p")
- (let ((inhibit-read-only t) lst)
- (if (or (not (get-text-property (point) 'txt))
- (save-excursion
- (dotimes (n arg)
- (move-beginning-of-line 0)
- (push (not (get-text-property (point) 'txt)) lst))
- (delq nil lst)))
- (message "Cannot move line backward")
- (org-drag-line-backward arg))))
- ;;; Flagging notes
- (defun org-agenda-show-the-flagging-note ()
- "Display the flagging note in the other window.
- When called a second time in direct sequence, offer to remove the FLAGGING
- tag and (if present) the flagging note."
- (interactive)
- (let ((hdmarker (org-get-at-bol 'org-hd-marker))
- (win (selected-window))
- note heading newhead)
- (unless hdmarker
- (user-error "No linked entry at point"))
- (if (and (eq this-command last-command)
- (y-or-n-p "Unflag and remove any flagging note? "))
- (progn
- (org-agenda-remove-flag hdmarker)
- (let ((win (get-buffer-window "*Flagging Note*")))
- (and win (delete-window win)))
- (message "Entry unflagged"))
- (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE"))
- (unless note
- (user-error "No flagging note"))
- (org-kill-new note)
- (org-switch-to-buffer-other-window "*Flagging Note*")
- (erase-buffer)
- (insert note)
- (goto-char (point-min))
- (while (re-search-forward "\\\\n" nil t)
- (replace-match "\n" t t))
- (goto-char (point-min))
- (select-window win)
- (message "Flagging note pushed to kill ring. Press [?] again to remove tag and note"))))
- (defun org-agenda-remove-flag (marker)
- "Remove the FLAGGED tag and any flagging note in the entry."
- (let (newhead)
- (org-with-point-at marker
- (org-toggle-tag "FLAGGED" 'off)
- (org-entry-delete nil "THEFLAGGINGNOTE")
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead marker)
- (message "Entry unflagged")))
- (defun org-agenda-get-any-marker (&optional pos)
- (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker)
- (get-text-property (or pos (point-at-bol)) 'org-marker)))
- ;;; Appointment reminders
- (defvar appt-time-msg-list) ; defined in appt.el
- ;;;###autoload
- (defun org-agenda-to-appt (&optional refresh filter &rest args)
- "Activate appointments found in `org-agenda-files'.
- With a \\[universal-argument] prefix, refresh the list of
- appointments.
- If FILTER is t, interactively prompt the user for a regular
- expression, and filter out entries that don't match it.
- If FILTER is a string, use this string as a regular expression
- for filtering entries out.
- If FILTER is a function, filter out entries against which
- calling the function returns nil. This function takes one
- argument: an entry from `org-agenda-get-day-entries'.
- FILTER can also be an alist with the car of each cell being
- either 'headline or 'category. For example:
- '((headline \"IMPORTANT\")
- (category \"Work\"))
- will only add headlines containing IMPORTANT or headlines
- belonging to the \"Work\" category.
- ARGS are symbols indicating what kind of entries to consider.
- By default `org-agenda-to-appt' will use :deadline*, :scheduled*
- \(i.e., deadlines and scheduled items with a hh:mm specification)
- and :timestamp entries. See the docstring of `org-diary' for
- details and examples.
- If an entry has a APPT_WARNTIME property, its value will be used
- to override `appt-message-warning-time'."
- (interactive "P")
- (if refresh (setq appt-time-msg-list nil))
- (if (eq filter t)
- (setq filter (read-from-minibuffer "Regexp filter: ")))
- (let* ((cnt 0) ; count added events
- (scope (or args '(:deadline* :scheduled* :timestamp)))
- (org-agenda-new-buffers nil)
- (org-deadline-warning-days 0)
- ;; Do not use `org-today' here because appt only takes
- ;; time and without date as argument, so it may pass wrong
- ;; information otherwise
- (today (org-date-to-gregorian
- (time-to-days (current-time))))
- (org-agenda-restrict nil)
- (files (org-agenda-files 'unrestricted)) entries file
- (org-agenda-buffer nil))
- ;; Get all entries which may contain an appt
- (org-agenda-prepare-buffers files)
- (while (setq file (pop files))
- (setq entries
- (delq nil
- (append entries
- (apply 'org-agenda-get-day-entries
- file today scope)))))
- ;; Map thru entries and find if we should filter them out
- (mapc
- (lambda(x)
- (let* ((evt (org-trim
- (replace-regexp-in-string
- org-bracket-link-regexp "\\3"
- (or (get-text-property 1 'txt x) ""))))
- (cat (get-text-property 1 'org-category x))
- (tod (get-text-property 1 'time-of-day x))
- (ok (or (null filter)
- (and (stringp filter) (string-match filter evt))
- (and (functionp filter) (funcall filter x))
- (and (listp filter)
- (let ((cat-filter (cadr (assoc 'category filter)))
- (evt-filter (cadr (assoc 'headline filter))))
- (or (and (stringp cat-filter)
- (string-match cat-filter cat))
- (and (stringp evt-filter)
- (string-match evt-filter evt)))))))
- (wrn (get-text-property 1 'warntime x)))
- ;; FIXME: Shall we remove text-properties for the appt text?
- ;; (setq evt (set-text-properties 0 (length evt) nil evt))
- (when (and ok tod)
- (setq tod (concat "00" (number-to-string tod))
- tod (when (string-match
- "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
- (concat (match-string 1 tod) ":"
- (match-string 2 tod))))
- (if (version< emacs-version "23.3")
- (appt-add tod evt)
- (appt-add tod evt wrn))
- (setq cnt (1+ cnt))))) entries)
- (org-release-buffers org-agenda-new-buffers)
- (if (eq cnt 0)
- (message "No event to add")
- (message "Added %d event%s for today" cnt (if (> cnt 1) "s" "")))))
- (defun org-agenda-todayp (date)
- "Does DATE mean today, when considering `org-extend-today-until'?"
- (let ((today (org-today))
- (date (if (and date (listp date)) (calendar-absolute-from-gregorian date)
- date)))
- (eq date today)))
- (defun org-agenda-todo-yesterday (&optional arg)
- "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday."
- (interactive "P")
- (let* ((hour (third (decode-time
- (org-current-time))))
- (org-extend-today-until (1+ hour)))
- (org-agenda-todo arg)))
- (provide 'org-agenda)
- ;;; org-agenda.el ends here
|