1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033703470357036703770387039704070417042704370447045704670477048704970507051705270537054705570567057705870597060706170627063706470657066706770687069707070717072707370747075707670777078707970807081708270837084708570867087708870897090709170927093709470957096709770987099710071017102710371047105710671077108710971107111711271137114711571167117711871197120712171227123712471257126712771287129713071317132713371347135713671377138713971407141714271437144714571467147714871497150715171527153715471557156715771587159716071617162716371647165716671677168716971707171717271737174717571767177717871797180718171827183718471857186718771887189719071917192719371947195719671977198719972007201720272037204720572067207720872097210721172127213721472157216721772187219722072217222722372247225722672277228722972307231723272337234723572367237723872397240724172427243724472457246724772487249725072517252725372547255725672577258725972607261726272637264726572667267726872697270727172727273727472757276727772787279728072817282728372847285728672877288728972907291729272937294729572967297729872997300730173027303730473057306730773087309731073117312731373147315731673177318731973207321732273237324732573267327732873297330733173327333733473357336733773387339734073417342734373447345734673477348734973507351735273537354735573567357735873597360736173627363736473657366736773687369737073717372737373747375737673777378737973807381738273837384738573867387738873897390739173927393739473957396739773987399740074017402740374047405740674077408740974107411741274137414741574167417741874197420742174227423742474257426742774287429743074317432743374347435743674377438743974407441744274437444744574467447744874497450745174527453745474557456745774587459746074617462746374647465746674677468746974707471747274737474747574767477747874797480748174827483748474857486748774887489749074917492749374947495749674977498749975007501750275037504750575067507750875097510751175127513751475157516751775187519752075217522752375247525752675277528752975307531753275337534753575367537753875397540754175427543754475457546754775487549755075517552755375547555755675577558755975607561756275637564756575667567756875697570757175727573757475757576757775787579758075817582758375847585758675877588758975907591759275937594759575967597759875997600760176027603760476057606760776087609761076117612761376147615761676177618761976207621762276237624762576267627762876297630763176327633763476357636763776387639764076417642764376447645764676477648764976507651765276537654765576567657765876597660766176627663766476657666766776687669767076717672767376747675767676777678767976807681768276837684768576867687768876897690769176927693769476957696769776987699770077017702770377047705770677077708770977107711771277137714771577167717771877197720772177227723772477257726772777287729773077317732773377347735773677377738773977407741774277437744774577467747774877497750775177527753775477557756775777587759776077617762776377647765776677677768776977707771777277737774777577767777777877797780778177827783778477857786778777887789779077917792779377947795779677977798779978007801780278037804780578067807780878097810781178127813781478157816781778187819782078217822782378247825782678277828782978307831783278337834783578367837783878397840784178427843784478457846784778487849785078517852785378547855785678577858785978607861786278637864786578667867786878697870787178727873787478757876787778787879788078817882788378847885788678877888788978907891789278937894789578967897789878997900790179027903790479057906790779087909791079117912791379147915791679177918791979207921792279237924792579267927792879297930793179327933793479357936793779387939794079417942794379447945794679477948794979507951795279537954795579567957795879597960796179627963796479657966796779687969797079717972797379747975797679777978797979807981798279837984798579867987798879897990799179927993799479957996799779987999800080018002800380048005800680078008800980108011801280138014801580168017801880198020802180228023802480258026802780288029803080318032803380348035803680378038803980408041804280438044804580468047804880498050805180528053805480558056805780588059806080618062806380648065806680678068806980708071807280738074807580768077807880798080808180828083808480858086808780888089809080918092809380948095809680978098809981008101810281038104810581068107810881098110811181128113811481158116811781188119812081218122812381248125812681278128812981308131813281338134813581368137813881398140814181428143814481458146814781488149815081518152815381548155815681578158815981608161816281638164816581668167816881698170817181728173817481758176817781788179818081818182818381848185818681878188818981908191819281938194819581968197819881998200820182028203820482058206820782088209821082118212821382148215821682178218821982208221822282238224822582268227822882298230823182328233823482358236823782388239824082418242824382448245824682478248824982508251825282538254825582568257825882598260826182628263826482658266826782688269827082718272827382748275827682778278827982808281828282838284828582868287828882898290829182928293829482958296829782988299830083018302830383048305830683078308830983108311831283138314831583168317831883198320832183228323832483258326832783288329833083318332833383348335833683378338833983408341834283438344834583468347834883498350835183528353835483558356835783588359836083618362836383648365836683678368836983708371837283738374837583768377837883798380838183828383838483858386838783888389839083918392839383948395839683978398839984008401840284038404840584068407840884098410841184128413841484158416841784188419842084218422842384248425842684278428842984308431843284338434843584368437843884398440844184428443844484458446844784488449845084518452845384548455845684578458845984608461846284638464846584668467846884698470847184728473847484758476847784788479848084818482848384848485848684878488848984908491849284938494849584968497849884998500850185028503850485058506850785088509851085118512851385148515851685178518851985208521852285238524852585268527852885298530853185328533853485358536853785388539854085418542854385448545854685478548854985508551855285538554855585568557855885598560856185628563856485658566856785688569857085718572857385748575857685778578857985808581858285838584858585868587858885898590859185928593859485958596859785988599860086018602860386048605860686078608860986108611861286138614861586168617861886198620862186228623862486258626862786288629863086318632863386348635863686378638863986408641864286438644864586468647864886498650865186528653865486558656865786588659866086618662866386648665866686678668866986708671867286738674867586768677867886798680868186828683868486858686868786888689869086918692869386948695869686978698869987008701870287038704870587068707870887098710871187128713871487158716871787188719872087218722872387248725872687278728872987308731873287338734873587368737873887398740874187428743874487458746874787488749875087518752875387548755875687578758875987608761876287638764876587668767876887698770877187728773877487758776877787788779878087818782878387848785878687878788878987908791879287938794879587968797879887998800880188028803880488058806880788088809881088118812881388148815881688178818881988208821882288238824882588268827882888298830883188328833883488358836883788388839884088418842884388448845884688478848884988508851885288538854885588568857885888598860886188628863886488658866886788688869887088718872887388748875887688778878887988808881888288838884888588868887888888898890889188928893889488958896889788988899890089018902890389048905890689078908890989108911891289138914891589168917891889198920892189228923892489258926892789288929893089318932893389348935893689378938893989408941894289438944894589468947894889498950895189528953895489558956895789588959896089618962896389648965896689678968896989708971897289738974897589768977897889798980898189828983898489858986898789888989899089918992899389948995899689978998899990009001900290039004900590069007900890099010901190129013901490159016901790189019902090219022902390249025902690279028902990309031903290339034903590369037903890399040904190429043904490459046904790489049905090519052905390549055905690579058905990609061906290639064906590669067906890699070907190729073907490759076907790789079908090819082908390849085908690879088908990909091909290939094909590969097909890999100910191029103910491059106910791089109911091119112911391149115911691179118911991209121912291239124912591269127912891299130913191329133913491359136913791389139914091419142914391449145914691479148914991509151915291539154915591569157915891599160916191629163916491659166916791689169917091719172917391749175917691779178917991809181918291839184918591869187918891899190919191929193919491959196919791989199920092019202920392049205920692079208920992109211921292139214921592169217921892199220922192229223922492259226922792289229923092319232923392349235923692379238923992409241924292439244924592469247924892499250925192529253925492559256925792589259926092619262926392649265926692679268926992709271927292739274927592769277927892799280928192829283928492859286928792889289929092919292929392949295929692979298929993009301930293039304930593069307930893099310931193129313931493159316931793189319932093219322932393249325932693279328932993309331933293339334933593369337933893399340934193429343934493459346934793489349935093519352935393549355935693579358935993609361936293639364936593669367936893699370937193729373937493759376937793789379938093819382938393849385938693879388938993909391939293939394939593969397939893999400940194029403940494059406940794089409941094119412941394149415941694179418941994209421942294239424942594269427942894299430943194329433943494359436943794389439944094419442944394449445944694479448944994509451945294539454945594569457945894599460946194629463946494659466946794689469947094719472947394749475947694779478947994809481948294839484948594869487948894899490949194929493949494959496949794989499950095019502950395049505950695079508950995109511951295139514951595169517951895199520952195229523952495259526952795289529953095319532953395349535953695379538953995409541954295439544954595469547954895499550955195529553955495559556955795589559956095619562956395649565956695679568956995709571957295739574957595769577957895799580958195829583958495859586958795889589959095919592959395949595959695979598959996009601960296039604960596069607960896099610961196129613961496159616961796189619962096219622962396249625962696279628962996309631963296339634963596369637963896399640964196429643964496459646964796489649965096519652965396549655965696579658965996609661966296639664966596669667966896699670967196729673967496759676967796789679968096819682968396849685968696879688968996909691969296939694969596969697969896999700970197029703970497059706970797089709971097119712971397149715971697179718971997209721972297239724972597269727972897299730973197329733973497359736973797389739974097419742974397449745974697479748974997509751975297539754975597569757975897599760976197629763976497659766976797689769977097719772977397749775977697779778977997809781978297839784978597869787978897899790979197929793979497959796979797989799980098019802980398049805980698079808980998109811981298139814981598169817981898199820982198229823982498259826982798289829983098319832983398349835983698379838983998409841984298439844984598469847984898499850985198529853985498559856985798589859986098619862986398649865986698679868986998709871987298739874987598769877987898799880988198829883988498859886988798889889989098919892989398949895989698979898989999009901990299039904990599069907990899099910991199129913991499159916991799189919992099219922992399249925992699279928992999309931993299339934993599369937993899399940994199429943994499459946994799489949995099519952995399549955995699579958995999609961996299639964996599669967996899699970997199729973997499759976997799789979998099819982998399849985998699879988998999909991999299939994999599969997999899991000010001100021000310004100051000610007100081000910010100111001210013100141001510016100171001810019100201002110022100231002410025100261002710028100291003010031100321003310034100351003610037100381003910040100411004210043100441004510046100471004810049100501005110052100531005410055100561005710058100591006010061100621006310064100651006610067100681006910070100711007210073100741007510076100771007810079100801008110082100831008410085100861008710088100891009010091100921009310094100951009610097100981009910100101011010210103101041010510106101071010810109101101011110112101131011410115101161011710118101191012010121101221012310124101251012610127101281012910130101311013210133101341013510136101371013810139101401014110142101431014410145101461014710148101491015010151101521015310154101551015610157101581015910160101611016210163101641016510166101671016810169101701017110172101731017410175101761017710178101791018010181101821018310184101851018610187101881018910190101911019210193101941019510196101971019810199102001020110202102031020410205102061020710208102091021010211102121021310214102151021610217102181021910220102211022210223102241022510226102271022810229102301023110232102331023410235102361023710238102391024010241102421024310244102451024610247102481024910250102511025210253102541025510256102571025810259102601026110262102631026410265102661026710268102691027010271102721027310274102751027610277102781027910280102811028210283102841028510286102871028810289102901029110292102931029410295102961029710298102991030010301103021030310304103051030610307103081030910310103111031210313103141031510316103171031810319103201032110322103231032410325103261032710328103291033010331103321033310334103351033610337103381033910340103411034210343103441034510346103471034810349103501035110352103531035410355103561035710358103591036010361103621036310364103651036610367103681036910370103711037210373103741037510376103771037810379103801038110382103831038410385103861038710388103891039010391103921039310394103951039610397103981039910400104011040210403104041040510406104071040810409104101041110412104131041410415104161041710418104191042010421104221042310424104251042610427104281042910430104311043210433104341043510436104371043810439104401044110442104431044410445104461044710448104491045010451104521045310454104551045610457104581045910460104611046210463104641046510466104671046810469104701047110472104731047410475104761047710478104791048010481104821048310484104851048610487104881048910490104911049210493104941049510496104971049810499105001050110502105031050410505105061050710508105091051010511105121051310514105151051610517105181051910520105211052210523105241052510526105271052810529105301053110532105331053410535105361053710538105391054010541105421054310544105451054610547105481054910550105511055210553105541055510556105571055810559105601056110562105631056410565105661056710568105691057010571105721057310574105751057610577105781057910580105811058210583105841058510586105871058810589105901059110592105931059410595105961059710598105991060010601106021060310604106051060610607106081060910610106111061210613106141061510616106171061810619106201062110622106231062410625106261062710628106291063010631106321063310634106351063610637106381063910640106411064210643106441064510646106471064810649106501065110652106531065410655106561065710658106591066010661106621066310664106651066610667106681066910670106711067210673106741067510676106771067810679106801068110682106831068410685106861068710688106891069010691106921069310694106951069610697106981069910700107011070210703107041070510706107071070810709107101071110712107131071410715107161071710718107191072010721107221072310724107251072610727107281072910730107311073210733107341073510736107371073810739107401074110742107431074410745107461074710748107491075010751107521075310754107551075610757107581075910760107611076210763107641076510766107671076810769107701077110772107731077410775107761077710778107791078010781107821078310784107851078610787107881078910790107911079210793107941079510796107971079810799108001080110802108031080410805108061080710808108091081010811108121081310814108151081610817108181081910820108211082210823108241082510826108271082810829108301083110832108331083410835108361083710838108391084010841108421084310844108451084610847108481084910850108511085210853108541085510856108571085810859108601086110862108631086410865108661086710868108691087010871108721087310874108751087610877108781087910880108811088210883108841088510886108871088810889108901089110892108931089410895108961089710898108991090010901109021090310904109051090610907 |
- ;;; org-agenda.el --- Dynamic task and appointment lists for Org -*- lexical-binding: t; -*-
- ;; Copyright (C) 2004-2022 Free Software Foundation, Inc.
- ;; Author: Carsten Dominik <carsten.dominik@gmail.com>
- ;; Keywords: outlines, hypermedia, calendar, wp
- ;; Homepage: https://orgmode.org
- ;;
- ;; This file is part of GNU Emacs.
- ;;
- ;; GNU Emacs is free software: you can redistribute it and/or modify
- ;; it under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation, either version 3 of the License, or
- ;; (at your option) any later version.
- ;; GNU Emacs is distributed in the hope that it will be useful,
- ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ;; GNU General Public License for more details.
- ;; You should have received a copy of the GNU General Public License
- ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;;
- ;;; Commentary:
- ;; This file contains the code for creating and using the Agenda for Org.
- ;;
- ;; 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 'cl-lib)
- (require 'ol)
- (require 'org)
- (require 'org-macs)
- (require 'org-refile)
- (declare-function diary-add-to-list "diary-lib"
- (date string specifier &optional marker globcolor literal))
- (declare-function calendar-iso-to-absolute "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-columns-remove-overlays "org-colview" ())
- (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-agenda-columns "org-colview" ())
- (declare-function org-add-archive-files "org-archive" (files))
- (declare-function org-capture "org-capture" (&optional goto keys))
- (declare-function org-clock-modify-effort-estimate "org-clock" (&optional value))
- (declare-function org-element-type "org-element" (&optional element))
- (defvar calendar-mode-map)
- (defvar org-clock-current-task)
- (defvar org-current-tag-alist)
- (defvar org-mobile-force-id-on-agenda-items)
- (defvar org-habit-show-habits)
- (defvar org-habit-show-habits-only-for-today)
- (defvar org-habit-show-all-today)
- (defvar org-habit-scheduled-past-days)
- ;; Defined somewhere in this file, but used before definition.
- (defvar org-agenda-buffer-name "*Org Agenda*")
- (defvar org-agenda-title-append nil)
- (defvar org-agenda-overriding-header)
- ;; (with-no-warnings (defvar entry)) ;; unprefixed, from calendar.el
- ;; (with-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
- ;; FIXME: Do we really want to evaluate those settings and thus force
- ;; the user to use `quote' all the time?
- "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 is 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'.
- (defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
- (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
- :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* 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)
- (list
- (const :format "" quote)
- (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 "Effort filter preset"
- (const org-agenda-effort-filter-preset)
- (list
- (const :format "" quote)
- (repeat
- (string :tag "+=10 or -=10 or +<10 or ->10"))))
- (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 "Columns format"
- (const org-overriding-columns-format)
- (string :tag "Format"))
- (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 TODOs" ((agenda "") (alltodo ""))))
- "Custom commands for the agenda.
- \\<org-mode-map>
- 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/property/todo match expression for 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 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/Property match (all agenda files)"
- (const :format "" tags)
- (string :tag "Match")
- ,org-agenda-custom-commands-local-options)
- (list :tag "Tags/Property match of TODO entries (all agenda files)"
- (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'
- \(bound to `\\[org-agenda] #') 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")))
- (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 search agenda view."
- :tag "Org Agenda Search 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 deadline 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
- is not going to happen anytime soon. This is useful if you 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. 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. It applies only to the
- actual 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)))
- (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)
- (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)
- (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-filter-hook nil
- "Hook run just after filtering with `org-agenda-filter'."
- :group 'org-agenda-startup
- :package-version '(Org . "9.4")
- :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. 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. To add entry text
- when exporting the agenda, configure the variable
- `org-agenda-add-entry-text-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.
- 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.
- only-window Show agenda, deleting all other windows.
- 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.
- other-tab Use `switch-to-buffer-other-tab' to display the
- agenda, making use of the `tab-bar-mode' introduced
- in Emacs version 27.1. Also, kill that tab when
- exiting the agenda view.
- See also the variable `org-agenda-restore-windows-after-quit'."
- :group 'org-agenda-windows
- :type '(choice
- (const current-window)
- (const other-frame)
- (const other-tab)
- (const other-window)
- (const only-window)
- (const reorganize-frame))
- :package-version '(Org . "9.4"))
- (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' or
- `other-tab', the value of this option will be ignored."
- :group 'org-agenda-windows
- :type 'boolean)
- (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. 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-end-of-line ()
- "Go to the end of visible line."
- (interactive)
- (goto-char (line-end-position)))
- (defun org-agenda-format-date-aligned (date)
- "Format a DATE string for display in the daily/weekly agenda.
- 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.
- This is 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."
- :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 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-diary-file 'diary-file
- "File to which to add new entries with the `i' key in agenda and calendar.
- When this is the symbol `diary-file', the functionality in the Emacs
- calendar will be used to add entries to the `diary-file'. But when this
- points to a file, `org-agenda-diary-entry' will be used instead."
- :group 'org-agenda
- :type '(choice
- (const :tag "The standard Emacs diary file" diary-file)
- (file :tag "Special Org file diary entries")))
- (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-show-future-repeats t
- "Non-nil shows repeated entries in the future part of the agenda.
- When set to the symbol `next' only the first future repeat is shown."
- :group 'org-agenda-daily/weekly
- :type '(choice
- (const :tag "Show all repeated entries" t)
- (const :tag "Show next repeated entry" next)
- (const :tag "Do not show repeated entries" nil))
- :version "26.1"
- :package-version '(Org . "9.1")
- :safe #'symbolp)
- (defcustom org-agenda-prefer-last-repeat nil
- "Non-nil sets date for repeated entries to their last repeat.
- When nil, display SCHEDULED and DEADLINE dates at their base
- date, and in today's agenda, as a reminder. Display plain
- time-stamps, on the other hand, at every repeat date in the past
- in addition to the base date.
- When non-nil, show a repeated entry at its latest repeat date,
- possibly being today even if it wasn't marked as done. This
- setting is useful if you do not always mark repeated entries as
- done and, yet, consider that reaching repeat date starts the task
- anew.
- When set to a list of strings, prefer last repeats only for
- entries with these TODO keywords."
- :group 'org-agenda-daily/weekly
- :type '(choice
- (const :tag "Prefer last repeat" t)
- (const :tag "Prefer base date" nil)
- (repeat :tag "Prefer last repeat for entries with these TODO keywords"
- (string :tag "TODO keyword")))
- :version "26.1"
- :package-version '(Org . "9.1")
- :safe (lambda (x) (or (booleanp x) (consp x))))
- (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 or for the
- number of days given here."
- :group 'org-agenda-daily/weekly
- :type 'integer
- :safe 'integerp)
- (defcustom org-deadline-past-days 10000
- "Number of days to warn about missed deadlines.
- When an item has deadline on a date, it shows up in the agenda on
- this day and will appear as a reminder until it is marked DONE or
- for the number of days given here."
- :group 'org-agenda-daily/weekly
- :type 'integer
- :version "26.1"
- :package-version '(Org . "9.1")
- :safe 'integerp)
- (defcustom org-agenda-log-mode-items '(closed clock)
- "List of items that should be shown in agenda log mode.
- \\<org-agenda-mode-map>\
- 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 \
- `\\[universal-argument] \\[org-agenda-log-mode]' 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)
- (defvaralias 'org-agenda-search-view-search-words-only
- 'org-agenda-search-view-always-boolean)
- (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)
- (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 "26.1"
- :package-version '(Org . "8.3")
- :type 'integer)
- (defgroup org-agenda-time-grid nil
- "Options concerning the time grid in the Org 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 four 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
- remove-match skip grid times already present in an entry
- The second item is a list of integers, indicating the times that
- should have a grid line.
- The third item is a string which will be placed right after the
- times that have a grid line.
- The fourth item is a string placed after the grid times. This
- will align with agenda items."
- :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))
- (repeat :tag "Grid Times" (integer :tag "Time"))
- (string :tag "Grid String (after agenda times)")
- (string :tag "Grid String (aligns with agenda items)")))
- (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 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-agenda-sort-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-agenda-sort-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 agenda display."
- :tag "Org Agenda Line Format"
- :group 'org-agenda)
- (defcustom org-agenda-prefix-format
- '((agenda . " %i %-12:c%?-12t% 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 one entry per agenda type. The keys of the
- sublists are `agenda', `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 todo) (string :tag "Format"))
- (cons (const tags) (string :tag "Format"))
- (cons (const search) (string :tag "Format"))))
- :group 'org-agenda-line-format
- :version "26.1"
- :package-version '(Org . "9.1"))
- (defcustom org-agenda-breadcrumbs-separator "->"
- "The separator of breadcrumbs in agenda lines."
- :group 'org-agenda-line-format
- :package-version '(Org . "9.3")
- :type 'string
- :safe #'stringp)
- (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 takes precedence 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' enables tag inheritance for the
- given agenda type.
- This can be set to a list of agenda types in which the agenda
- must display the inherited tags. Available types are `todo',
- `agenda' and `search'.
- 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 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' 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 "26.1"
- :package-version '(Org . "9.1")
- :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)
- (regexp :tag "Regexp ")))
- (defvaralias 'org-agenda-remove-tags-when-in-prefix
- 'org-agenda-remove-tags)
- (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)))
- (defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column)
- (defcustom org-agenda-tags-column 'auto
- "Shift tags in agenda items to this column.
- If set to `auto', tags will be automatically aligned to the right
- edge of the window.
- If set to a positive number, tags will be left-aligned to that
- column. If set to a negative number, tags will be right-aligned
- to that column. For example, -80 works well for a normal 80
- character screen."
- :group 'org-agenda-line-format
- :type '(choice
- (const :tag "Automatically align to right edge of window" auto)
- (integer :tag "Specific column" -80))
- :package-version '(Org . "9.1")
- :version "26.1")
- (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-priority-highest',
- `org-priority-default', and `org-priority-lowest' (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 (regexp :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 sexp))
- (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-view-columns-initially nil
- "When non-nil, switch to columns view right after creating the agenda."
- :group 'org-agenda-column-view
- :type 'boolean
- :version "26.1"
- :package-version '(Org . "9.0")
- :safe #'booleanp)
- (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 \
- \\<org-agenda-mode-map>`\\[org-agenda-filter-by-tag] 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, \"-<TAG>\" to exclude the tag, or \"+<TAG>\" to exclude
- lines not carrying this 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.
- You can also specify a function which collects arguments to be
- used for each call to your bulk custom function. The argument
- collecting function will be run once and should return a list of
- arguments to pass to the bulk function. For example:
- \\='((?R set-category get-category))
- Now, `B R' will call the custom `get-category' which would prompt
- the user once for a category. That category is then passed as an
- argument to `set-category' for each entry it's called against."
- :type
- '(alist :key-type character
- :value-type
- (group (function :tag "Bulk Custom Function")
- (choice (function :tag "Bulk Custom Argument Function")
- (const :tag "No Bulk Custom Argument Function" nil))))
- :package-version '(Org . "9.5")
- :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."
- (declare (debug t))
- (org-with-gensyms (marker)
- `(let ((,marker (get-text-property (if ,string 0 (line-beginning-position))
- 'org-hd-marker ,string)))
- (with-current-buffer (marker-buffer ,marker)
- (save-excursion
- (goto-char ,marker)
- ,@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))))
- (defmacro org-agenda--insert-overriding-header (default)
- "Insert header into agenda view.
- The inserted header depends on `org-agenda-overriding-header'.
- If the empty string, don't insert a header. If any other string,
- insert it as a header. If nil, insert DEFAULT, which should
- evaluate to a string. If a function, call it and insert the
- string that it returns."
- (declare (debug (form)) (indent defun))
- `(cond
- ((not org-agenda-overriding-header) (insert ,default))
- ((equal org-agenda-overriding-header "") nil)
- ((stringp org-agenda-overriding-header)
- (insert (propertize org-agenda-overriding-header
- 'face 'org-agenda-structure)
- "\n"))
- ((functionp org-agenda-overriding-header)
- (insert (funcall org-agenda-overriding-header)))
- (t (user-error "Invalid value for `org-agenda-overriding-header': %S"
- org-agenda-overriding-header))))
- ;;; Define the org-agenda-mode
- (defvaralias 'org-agenda-keymap 'org-agenda-mode-map)
- (defvar org-agenda-mode-map (make-sparse-keymap)
- "Keymap for `org-agenda-mode'.")
- (org-remap org-agenda-mode-map 'move-end-of-line 'org-agenda-end-of-line)
- (defvar org-agenda-menu) ; defined later in this file.
- (defvar org-agenda-restrict nil)
- (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
- "When non-nil, show the log in the agenda.
- Do not set this directly; instead use
- `org-agenda-start-with-log-mode', which see.")
- (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.")
- (defvar org-agenda-current-date nil
- "Active date when building 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 (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 (called-interactively-p 'interactive)
- (message "Sticky agenda %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)
- (defvar org-agenda-last-indirect-buffer nil
- "Last buffer loaded by `org-agenda-tree-to-indirect-buffer'.")
- (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
- org-agenda-category-filter
- org-agenda-top-headline-filter
- org-agenda-regexp-filter
- org-agenda-effort-filter
- org-agenda-markers
- org-agenda-last-search-view-search-was-boolean
- org-agenda-last-indirect-buffer
- 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 files.
- The following commands are available:
- \\{org-agenda-mode-map}"
- (interactive)
- (ignore-errors (require 'face-remap))
- (let ((agenda-local-vars-to-keep
- '(text-scale-mode-amount
- text-scale-mode
- text-scale-mode-lighter
- face-remapping-alist))
- (save (buffer-local-variables)))
- (kill-all-local-variables)
- (cl-flet ((reset-saved (var-set)
- "Reset variables in VAR-SET to possibly stored value in SAVE."
- (dolist (elem save)
- (pcase elem
- (`(,var . ,val) ;ignore unbound variables
- (when (and val (memq var var-set))
- (set var val)))))))
- (cond (org-agenda-doing-sticky-redo
- ;; Refreshing sticky agenda-buffer
- ;;
- ;; Preserve the value of `org-agenda-local-vars' variables.
- (mapc #'make-local-variable org-agenda-local-vars)
- (reset-saved org-agenda-local-vars)
- (setq-local org-agenda-this-buffer-is-sticky t))
- (org-agenda-sticky
- ;; Creating a sticky Agenda buffer for the first time
- (mapc #'make-local-variable org-agenda-local-vars)
- (setq-local org-agenda-this-buffer-is-sticky t))
- (t
- ;; Creating a non-sticky agenda buffer
- (setq-local org-agenda-this-buffer-is-sticky nil)))
- (mapc #'make-local-variable agenda-local-vars-to-keep)
- (reset-saved agenda-local-vars-to-keep)))
- (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
- (setq-local font-lock-global-modes (list 'not major-mode))
- (setq mode-name "Org-Agenda")
- (setq indent-tabs-mode nil)
- (use-local-map org-agenda-mode-map)
- (when org-startup-truncated (setq truncate-lines t))
- (setq-local line-move-visual nil)
- (add-hook 'post-command-hook #'org-agenda-update-agenda-type nil 'local)
- (add-hook 'pre-command-hook #'org-unhighlight nil 'local)
- ;; Make sure properties are removed when copying text
- (if (boundp 'filter-buffer-substring-functions)
- (add-hook 'filter-buffer-substring-functions
- (lambda (fun start end delete)
- (substring-no-properties (funcall fun start end delete)))
- nil t)
- ;; Emacs >= 24.4.
- (add-function :filter-return (local 'filter-buffer-substring-function)
- #'substring-no-properties))
- (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-show-log org-agenda-start-with-log-mode
- org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode))
- (add-to-invisibility-spec '(org-filtered))
- (add-to-invisibility-spec '(org-link))
- (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)
- (run-mode-hooks '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
- (number-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" #'org-agenda-redo-all)
- (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 "\C-c\C-x<" #'org-agenda-set-restriction-lock-from-agenda)
- (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-effort)
- (org-defkey org-agenda-mode-map "=" #'org-agenda-filter-by-regexp)
- (org-defkey org-agenda-mode-map "/" #'org-agenda-filter)
- (org-defkey org-agenda-mode-map "|" #'org-agenda-filter-remove-all)
- (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)
- (org-defkey org-agenda-mode-map "\C-c\C-x_" #'org-timer-stop)
- (org-defkey 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 "\C-c\C-xI" #'org-info-find-node)
- (org-defkey org-agenda-mode-map [mouse-2] #'org-agenda-goto-mouse)
- (org-defkey org-agenda-mode-map [mouse-3] #'org-agenda-show-mouse)
- (org-defkey org-agenda-mode-map [remap forward-paragraph] #'org-agenda-forward-block)
- (org-defkey org-agenda-mode-map [remap backward-paragraph] #'org-agenda-backward-block)
- (org-defkey org-agenda-mode-map "\C-c\C-c" #'org-agenda-ctrl-c-ctrl-c)
- (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)]
- ["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 t"]
- ["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)
- :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])
- ("Filter current view"
- ["with generic interface" org-agenda-filter t]
- "--"
- ["by category at cursor" org-agenda-filter-by-category t]
- ["by tag" org-agenda-filter-by-tag t]
- ["by effort" org-agenda-filter-by-effort t]
- ["by regexp" org-agenda-filter-by-regexp t]
- ["by top-level headline" org-agenda-filter-by-top-headline t]
- "--"
- ["Remove all filtering" org-agenda-filter-remove-all t]
- "--"
- ["limit" org-agenda-limit-interactively t])
- ["Rebuild buffer" org-agenda-redo t]
- ["Write view to file" org-agenda-write t]
- ["Save all Org 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)]
- ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda)]
- ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u S-right"]
- ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u S-left"]
- ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-right"]
- ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda) :keys "C-u C-u S-left"]
- ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda)])
- ("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-priority-show t])
- ("Calendar/Diary"
- ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda)]
- ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda)]
- ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda)]
- ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda)]
- ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda)]
- ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda)]
- "--"
- ["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 "\\[org-agenda] ?"]
- ["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"))
- (when (not (eq this-command last-command))
- (setq org-agenda-undo-has-started-in nil
- org-agenda-pending-undo-list org-agenda-undo-list))
- (when (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)))
- (when (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))
- (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 TODOs")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search))
- (integer :tag "Max number of TODOs")))))
- (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 tagged entries")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search))
- (integer :tag "Max number of tagged 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 minutes")
- (repeat
- (cons (choice :tag "Agenda type"
- (const agenda)
- (const todo)
- (const tags)
- (const search))
- (integer :tag "Max number of minutes")))))
- (defvar org-agenda-keep-restricted-file-list nil)
- (defvar org-keys nil)
- (defvar org-match nil)
- ;;;###autoload
- (defun org-agenda (&optional arg 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.
- 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* ((org-keys keys)
- (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 type org-match lprops ans) ;; key
- ;; Turn off restriction unless there is an overriding one,
- (unless org-agenda-overriding-restriction
- (unless 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.
- (when 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)))))
- ((and (eq restriction 'buffer)
- (or (< 1 (point-min))
- (< (point-max) (1+ (buffer-size)))))
- (setq org-agenda-restrict (current-buffer))
- (move-marker org-agenda-restrict-begin (point-min))
- (move-marker org-agenda-restrict-end (point-max)))))
- ;; 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
- ;; FIXME: Is (nth 3 entry) supposed to have access (via dynvars)
- ;; to some of the local variables? There's no doc about
- ;; that for `org-agenda-custom-commands'.
- (setq type (nth 2 entry) org-match (eval (nth 3 entry) t)
- lprops (nth 4 entry))
- (when 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)
- (cl-progv
- (mapcar #'car lprops)
- (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
- (pcase type
- (`agenda
- (org-agenda-list current-prefix-arg))
- (`agenda*
- (org-agenda-list current-prefix-arg nil nil t))
- (`alltodo
- (org-todo-list current-prefix-arg))
- (`search
- (org-search-view current-prefix-arg org-match nil))
- (`stuck
- (org-agenda-list-stuck-projects current-prefix-arg))
- (`tags
- (org-tags-view current-prefix-arg org-match))
- (`tags-todo
- (org-tags-view '(4) org-match))
- (`todo
- (org-todo-list org-match))
- (`tags-tree
- (org-check-for-org-mode)
- (org-match-sparse-tree current-prefix-arg org-match))
- (`todo-tree
- (org-check-for-org-mode)
- (org-occur (concat "^" org-outline-regexp "[ \t]*"
- (regexp-quote org-match) "\\>")))
- (`occur-tree
- (org-check-for-org-mode)
- (org-occur org-match))
- ((pred functionp)
- (funcall type org-match))
- ;; FIXME: Will signal an error since it's not `functionp'!
- ((pred fboundp) (funcall type org-match))
- (_ (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")
- (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 "FLAGGING-NOTE ([?] for more info): %s"
- (org-add-props
- (replace-regexp-in-string
- "\\\\n" "//"
- (copy-sequence note))
- nil 'face 'org-warning))))))
- t t))
- ((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
- (copy-sequence
- "Press key for an agenda command:
- -------------------------------- < Buffer, subtree/region restriction
- a Agenda for current week or day > Remove restriction
- t List of all TODO entries e Export agenda views
- m Match a TAGS/PROP/TODO query T Entries with special TODO kwd
- s Search for keywords M Like m, but only TODO entries
- / Multi-occur S Like s, but only TODO entries
- ? Find :FLAGGED: entries C Configure custom agenda commands
- * Toggle sticky agenda views # List stuck projects (!=configure)
- "))
- (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) (line-end-position))
- (forward-char 1)
- (looking-at "-+")
- (delete-region (match-end 0) (line-end-position))
- (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)
- (cl-pushnew (string-to-char key) prefixes :test #'equal)
- (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 "???"))))
- (cond
- ((not (org-string-nw-p match)) nil)
- (org-agenda-menu-show-matcher
- (setq line
- (concat line ": "
- (cond
- ((stringp match)
- (propertize match 'face 'org-warning))
- ((listp type)
- (format "set of %d commands" (length type)))))))
- (t
- (org-add-props line nil 'help-echo (concat "Matcher: " match))))
- (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
- (when (not (pos-visible-in-window-p (point-max)))
- (org-fit-window-to-buffer))
- (setq second-time t)
- (org-fit-window-to-buffer))
- ;; Hint to navigation if window too small for all information
- (setq header-line-format
- (when (not (pos-visible-in-window-p (point-max)))
- "Use C-v, M-v, C-n or C-p to navigate."))
- ;; Ask for selection
- (cl-loop
- do (progn
- (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)))
- until (not (memq c '(14 16 22 134217846)))
- do (org-scroll c))
- (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 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) (user-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)
- (if (and (= (cdr org-agenda-window-frame-fractions) 1.0)
- (= (car org-agenda-window-frame-fractions) 1.0))
- (delete-other-windows)
- (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-let (list &rest body) ;FIXME: So many kittens are suffering here.
- (declare (indent 1) (obsolete cl-progv "2021"))
- (eval (cons 'let (cons list body))))
- (defun org-let2 (list1 list2 &rest body) ;FIXME: Where did our karma go?
- (declare (indent 2) (obsolete cl-progv "2021"))
- (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body)))))))
- (defun org-agenda-run-series (name series)
- "Run agenda NAME as a SERIES of agenda commands."
- (let* ((gprops (nth 1 series))
- (gvars (mapcar #'car gprops))
- (gvals (mapcar (lambda (binding) (eval (cadr binding) t)) gprops)))
- (cl-progv gvars gvals (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)
- (with-no-warnings
- (defvar match)) ;Used via the `eval' below.
- (let* ((org-agenda-multi t)
- ;; FIXME: Redo should contain lists of (FUNS . ARGS) rather
- ;; than expressions, so you don't need to `quote' the args
- ;; and you just need to `apply' instead of `eval' when using it.
- (redo (list 'org-agenda-run-series name (list 'quote series)))
- (cmds (car series))
- match
- org-cmd type lprops)
- (while (setq org-cmd (pop cmds))
- (setq type (car org-cmd))
- (setq match (eval (nth 1 org-cmd) t))
- (setq 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)))
- (lvars (mapcar #'car lprops))
- (lvals (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)))
- (cl-progv (append gvars lvars) (append gvals lvals)
- (pcase type
- (`agenda
- (call-interactively 'org-agenda-list))
- (`agenda*
- (funcall 'org-agenda-list nil nil t))
- (`alltodo
- (call-interactively 'org-todo-list))
- (`search
- (org-search-view current-prefix-arg match nil))
- (`stuck
- (call-interactively 'org-agenda-list-stuck-projects))
- (`tags
- (org-tags-view current-prefix-arg match))
- (`tags-todo
- (org-tags-view '(4) match))
- (`todo
- (org-todo-list match))
- ((pred fboundp)
- (funcall type match))
- (_ (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)
- (cl-progv gvars gvals (org-agenda-finalize))))
- (defun org-agenda--split-plist (plist)
- ;; We could/should arguably use `map-keys' and `map-values'.
- (let (keys vals)
- (while plist
- (push (pop plist) keys)
- (push (pop plist) vals))
- (cons (nreverse keys) (nreverse vals))))
- ;;;###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."
- (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
- `(org--batch-agenda ,cmd-key ',vars (list ,@exps))))
- (defun org--batch-agenda (cmd-key vars vals)
- ;; `org-batch-agenda' is a macro because every other "parameter" is
- ;; a variable name rather than an expression to evaluate. Yuck!
- (cl-progv vars vals
- (let (org-agenda-sticky)
- (if (> (length cmd-key) 1)
- (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 String 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"
- (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
- `(org--batch-agenda-csv ,cmd-key ',vars (list ,@exps))))
- (defun org--batch-agenda-csv (cmd-key vars vals)
- ;; `org-batch-agenda-csv' is a macro because every other "parameter" is
- ;; a variable name rather than an expression to evaluate. Yuck!
- (let ((org-agenda-remove-tags t))
- (cl-progv vars vals
- ;; FIXME: Shouldn't this be 1 (see commit 10173ad6d610b)?
- (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")))
- (dolist (line lines)
- (when (get-text-property 0 'org-category line)
- (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))
- (when (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))
- (when (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 " ?"))
- (let ((case-fold-search nil)) (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))))
- (org-trim (replace-regexp-in-string "," ";" res nil t))))
- ;;;###autoload
- (defun org-store-agenda-views (&rest _parameters)
- "Store agenda views."
- (interactive)
- (org--batch-store-agenda-views nil nil))
- ;;;###autoload
- (defmacro org-batch-store-agenda-views (&rest parameters)
- "Run all custom agenda commands that have a file argument."
- (pcase-let ((`(,vars . ,exps) (org-agenda--split-plist parameters)))
- `(org--batch-store-agenda-views ',vars (list ,@exps))))
- (defun org--batch-store-agenda-views (vars vals)
- (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands))
- (pop-up-frames nil)
- (dir default-directory)
- 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
- (let* ((opts (append org-agenda-exporter-settings opts))
- (vars (append (mapcar #'car opts) vars))
- (vals (append (mapcar (lambda (binding) (eval (cadr binding) t))
- opts)
- vals)))
- (cl-progv vars vals
- (org-agenda nil thiscmdkey))
- (set-buffer bufname)
- (while files
- (cl-progv vars vals
- (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 (line-beginning-position) (line-end-position)
- 'org-agenda-structural-header t)
- (when org-agenda-title-append
- (put-text-property (line-beginning-position) (line-end-position)
- '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, translate visible agenda into iCalendar
- format. 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 is provided, 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 (called-interactively-p 'any)
- (not (y-or-n-p (format "Overwrite existing file %s? " file))))))
- (user-error "Cannot write agenda to file %s" file))
- (cl-progv
- (if nosettings nil (mapcar #'car org-agenda-exporter-settings))
- (if nosettings nil (mapcar (lambda (binding) (eval (cadr binding) t))
- org-agenda-exporter-settings))
- (save-excursion
- (save-window-excursion
- (let ((bs (copy-sequence (buffer-string)))
- (extension (file-name-extension file))
- (default-directory (file-name-directory file))
- ) ;; beg content
- (with-temp-buffer
- (rename-buffer org-agenda-write-buffer-name t)
- (set-buffer-modified-p nil)
- (insert bs)
- (org-agenda-remove-marked-text 'invisible 'org-filtered)
- (run-hooks 'org-agenda-before-write-hook)
- (cond
- ((bound-and-true-p org-mobile-creating-agendas)
- (org-mobile-write-agenda-for-mobile file))
- ((string= "org" extension)
- (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 (with-current-buffer (marker-buffer m)
- (goto-char m)
- (org-copy-subtree 1 nil t t)
- org-subtree-clip)
- content)))
- (find-file file)
- (erase-buffer)
- (dolist (s content) (org-paste-subtree 1 s))
- (write-file file)
- (kill-buffer (current-buffer))
- (message "Org file written to %s" file)))
- ((member extension '("html" "htm"))
- (or (require 'htmlize nil t)
- (error "Please install htmlize from https://github.com/hniksic/emacs-htmlize"))
- (declare-function htmlize-buffer "htmlize" (&optional buffer))
- (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= "ps" extension)
- (require 'ps-print)
- (ps-print-buffer-with-faces file)
- (message "Postscript written to %s" file))
- ((string= "pdf" extension)
- (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= "ics" extension)
- (require 'ox-icalendar)
- (declare-function org-icalendar-export-current-agenda
- "ox-icalendar" (file))
- (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
- ;; FIXME: I'm pretty sure called-interactively-p
- ;; doesn't do what we want here!
- (and (called-interactively-p 'any) (buffer-name))
- org-agenda-buffer-name)))
- (when open (org-open-file file)))
- (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 property)
- (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 (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 "")
- (org-with-wide-buffer
- (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-links (point-max))
- (goto-char (match-end 0))))
- (goto-char (point-min))
- (while (re-search-forward org-link-bracket-re (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")
- (when (looking-at "[ \t\n]+\\'") (replace-match ""))
- ;; find and remove min common indentation
- (goto-char (point-min))
- (untabify (point-min) (point-max))
- (setq ind (current-indentation))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (setq ind (min ind (current-indentation))))
- (beginning-of-line 2))
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "[ \t]*$")
- (move-to-column ind)
- (delete-region (line-beginning-position) (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 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-effort-filter nil)
- (defvar org-agenda-top-headline-filter nil)
- (defvar org-agenda-represented-categories nil
- "Cache for the list of all categories in the agenda.")
- (defvar org-agenda-represented-tags nil
- "Cache for the list of all categories in the agenda.")
- (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.")
- (defconst org-agenda-filter-variables
- '((category . org-agenda-category-filter)
- (tag . org-agenda-tag-filter)
- (effort . org-agenda-effort-filter)
- (regexp . org-agenda-regexp-filter))
- "Alist of filter types and associated variables.")
- (defun org-agenda-filter-any ()
- "Is any filter active?"
- (cl-some (lambda (x)
- (or (symbol-value (cdr x))
- (get :preset-filter x)))
- org-agenda-filter-variables))
- (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 regexp
- 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-effort-filter-preset nil
- "A preset of the effort condition used for secondary agenda filtering.
- This must be a list of strings, each string must be a single regexp
- 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))))
- (defvar org-agenda-buffer-tmp-name nil)
- (defun org-agenda--get-buffer-name (sticky-name)
- (or org-agenda-buffer-tmp-name
- (and org-agenda-doing-sticky-redo org-agenda-buffer-name)
- sticky-name
- "*Org Agenda*"))
- (defun org-agenda-prepare-window (abuf filter-alist)
- "Setup agenda buffer in the window.
- ABUF is the buffer for the agenda window.
- FILTER-ALIST is an alist of filters we need to apply when
- `org-agenda-persistent-filter' is non-nil."
- (let* ((awin (get-buffer-window abuf)) wconf)
- (cond
- ((equal (current-buffer) abuf) nil)
- (awin (select-window awin))
- ((not (setq wconf (current-window-configuration))))
- ((eq org-agenda-window-setup 'current-window)
- (pop-to-buffer-same-window abuf))
- ((eq org-agenda-window-setup 'other-window)
- (org-switch-to-buffer-other-window abuf))
- ((eq org-agenda-window-setup 'other-frame)
- (switch-to-buffer-other-frame abuf))
- ((eq org-agenda-window-setup 'other-tab)
- (if (fboundp 'switch-to-buffer-other-tab)
- (switch-to-buffer-other-tab abuf)
- (user-error "Your version of Emacs does not have tab bar support")))
- ((eq org-agenda-window-setup 'only-window)
- (delete-other-windows)
- (pop-to-buffer-same-window abuf))
- ((eq org-agenda-window-setup 'reorganize-frame)
- (delete-other-windows)
- (org-switch-to-buffer-other-window abuf)))
- (setq org-agenda-tag-filter (cdr (assq 'tag filter-alist)))
- (setq org-agenda-category-filter (cdr (assq 'cat filter-alist)))
- (setq org-agenda-effort-filter (cdr (assq 'effort filter-alist)))
- (setq org-agenda-regexp-filter (cdr (assq 're filter-alist)))
- ;; Additional test in case agenda is invoked from within agenda
- ;; buffer via elisp link.
- (unless (equal (current-buffer) abuf)
- (pop-to-buffer-same-window abuf))
- (setq org-agenda-pre-window-conf
- (or wconf org-agenda-pre-window-conf))))
- (defun org-agenda-prepare (&optional name)
- (let ((filter-alist (when org-agenda-persistent-filter
- (with-current-buffer
- (get-buffer-create org-agenda-buffer-name)
- `((tag . ,org-agenda-tag-filter)
- (re . ,org-agenda-regexp-filter)
- (effort . ,org-agenda-effort-filter)
- (cat . ,org-agenda-category-filter))))))
- (if (org-agenda-use-sticky-p)
- (progn
- (put 'org-agenda-tag-filter :preset-filter nil)
- (put 'org-agenda-category-filter :preset-filter nil)
- (put 'org-agenda-regexp-filter :preset-filter nil)
- (put 'org-agenda-effort-filter :preset-filter nil)
- ;; Popup existing buffer
- (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
- filter-alist)
- (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)
- (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)
- (put 'org-agenda-effort-filter :preset-filter
- org-agenda-effort-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) filter-alist)
- (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-agenda-last-prefix-arg current-prefix-arg)
- (setq org-agenda-this-buffer-name org-agenda-buffer-name)
- (and name (not org-agenda-name)
- (setq-local org-agenda-name name)))
- (setq buffer-read-only nil))))
- (defvar org-overriding-columns-format)
- (defvar org-local-columns-format)
- (defun org-agenda-finalize ()
- "Finishing touch for the agenda buffer.
- This function is called just before displaying the agenda. If
- you want to add your own functions to the finalization of the
- agenda display, configure `org-agenda-finalize-hook'."
- (unless org-agenda-multi
- (let ((inhibit-read-only t))
- (save-excursion
- (goto-char (point-min))
- (save-excursion
- (while (org-activate-links (point-max))
- (goto-char (match-end 0))))
- (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)))
- (when (bound-and-true-p org-overriding-columns-format)
- (setq-local org-local-columns-format
- org-overriding-columns-format))
- (when 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))
- (org-agenda-mark-clocking-task)
- (when org-agenda-entry-text-mode
- (org-agenda-entry-text-hide)
- (org-agenda-entry-text-show))
- (when (and (featurep 'org-habit)
- (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 (get-text-property (point) 'org-hd-marker))
- (put-text-property (line-beginning-position) (line-end-position)
- 'tags
- (org-with-point-at mrk
- (org-get-tags))))))))
- (setq org-agenda-represented-tags nil
- org-agenda-represented-categories nil)
- (when org-agenda-top-headline-filter
- (org-agenda-filter-top-headline-apply
- org-agenda-top-headline-filter))
- (when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
- (when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag t))
- (when org-agenda-category-filter
- (org-agenda-filter-apply org-agenda-category-filter 'category))
- (when (get 'org-agenda-category-filter :preset-filter)
- (org-agenda-filter-apply
- (get 'org-agenda-category-filter :preset-filter) 'category))
- (when org-agenda-regexp-filter
- (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
- (when (get 'org-agenda-regexp-filter :preset-filter)
- (org-agenda-filter-apply
- (get 'org-agenda-regexp-filter :preset-filter) 'regexp))
- (when org-agenda-effort-filter
- (org-agenda-filter-apply org-agenda-effort-filter 'effort))
- (when (get 'org-agenda-effort-filter :preset-filter)
- (org-agenda-filter-apply
- (get 'org-agenda-effort-filter :preset-filter) 'effort))
- (add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
- (run-hooks 'org-agenda-finalize-hook))))
- (defun org-agenda-mark-clocking-task ()
- "Mark the current clock entry in the agenda if it is present."
- ;; We need to widen when `org-agenda-finalize' is called from
- ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in').
- (when (bound-and-true-p org-clock-current-task)
- (save-restriction
- (widen)
- (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 (line-beginning-position)
- (1+ (line-end-position))))
- (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)
- (when (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) (when (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 org-priority-regexp nil t)
- (setq h (or (get-char-property (point) 'org-priority-highest)
- org-priority-highest)
- l (or (get-char-property (point) 'org-priority-lowest)
- org-priority-lowest)
- p (string-to-char (match-string 2))
- b (match-beginning 1)
- e (if (eq org-agenda-fontify-priorities 'cookies)
- (1+ (match-end 2))
- (line-end-position))
- ov (make-overlay b e))
- (overlay-put
- ov 'face
- (let ((special-face
- (cond ((org-face-from-face-or-color
- 'priority 'org-priority
- (cdr (assoc p org-priority-faces))))
- ((and (listp org-agenda-fontify-priorities)
- (org-face-from-face-or-color
- 'priority 'org-priority
- (cdr (assoc p org-agenda-fontify-priorities)))))
- ((equal p l) 'italic)
- ((equal p h) 'bold))))
- (if special-face (list special-face 'org-priority) '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 TODOs in the agenda display.
- When INVISIBLE is non-nil, hide currently blocked TODO instead of
- dimming them." ;FIXME: The arg isn't used, actually!
- (interactive "P")
- (when (called-interactively-p 'interactive)
- (message "Dim or hide blocked tasks..."))
- (dolist (o (overlays-in (point-min) (point-max)))
- (when (eq (overlay-get o 'face) 'org-agenda-dimmed-todo-face)
- (delete-overlay o)))
- (save-excursion
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (let ((pos (text-property-not-all
- (point) (point-max) 'org-todo-blocked nil)))
- (when pos (goto-char pos)))
- (let* ((invisible
- (eq (org-get-at-bol 'org-todo-blocked) 'invisible))
- (todo-blocked
- (eq (org-get-at-bol 'org-filter-type) 'todo-blocked))
- (ov (make-overlay (if invisible
- (line-end-position 0)
- (line-beginning-position))
- (line-end-position))))
- (when todo-blocked
- (overlay-put ov 'face 'org-agenda-dimmed-todo-face))
- (when invisible
- (org-agenda-filter-hide-line 'todo-blocked)))
- (if (= (point-max) (line-end-position))
- (goto-char (point-max))
- (move-beginning-of-line 2)))))
- (when (called-interactively-p 'interactive)
- (message "Dim or hide blocked tasks...done")))
- (defun org-agenda--mark-blocked-entry (entry)
- "If ENTRY is blocked, mark it for fontification or invisibility.
- If the header at `org-hd-marker' is blocked according to
- `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is
- `invisible' and the header is not blocked by checkboxes, set the
- text property `org-todo-blocked' to `invisible', otherwise set it
- to t."
- (when (get-text-property 0 'todo-state entry)
- (let ((entry-marker (get-text-property 0 'org-hd-marker entry))
- (org-blocked-by-checkboxes nil)
- ;; Necessary so that `org-entry-blocked-p' does not change
- ;; the buffer.
- (org-depend-tag-blocked nil))
- (when entry-marker
- (let ((blocked
- (with-current-buffer (marker-buffer entry-marker)
- (save-excursion
- (goto-char entry-marker)
- (org-entry-blocked-p)))))
- (when blocked
- (let ((really-invisible
- (and (not org-blocked-by-checkboxes)
- (eq org-agenda-dim-blocked-tasks 'invisible))))
- (put-text-property
- 0 (length entry) 'org-todo-blocked
- (if really-invisible 'invisible t)
- entry)
- (put-text-property
- 0 (length entry) 'org-filter-type 'todo-blocked entry)))))))
- entry)
- (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 (line-beginning-position)) to)
- (when (or
- (save-excursion (goto-char p) (looking-at comment-start-skip))
- (and org-agenda-skip-archived-trees (not org-agenda-archives-mode)
- (or (and (get-text-property p :org-archived)
- (org-end-of-subtree t))
- (and (member org-archive-tag org-file-tags)
- (goto-char (point-max)))))
- (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 t)))))))
- (defvar org-agenda-markers nil
- "List of all currently active markers created by `org-agenda'.")
- (defvar org-agenda-last-marker-time (float-time)
- "Creation time of the last agenda marker.")
- (defun org-agenda-new-marker (&optional pos)
- "Return a new agenda marker.
- Marker is at point, or at POS if non-nil. 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)) t)))
- (setq org-agenda-last-marker-time (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 (line-beginning-position) (line-end-position)))
- (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."
- (mapc (lambda (o)
- (when (eq (overlay-get o 'org-overlay-type)
- 'agenda-entry-content)
- (delete-overlay o)))
- (overlays-in (point-min) (point-max))))
- (defun org-agenda-get-day-face (date)
- "Return the face DATE should be displayed with."
- (cond ((and (functionp org-agenda-day-face-function)
- (funcall org-agenda-day-face-function date)))
- ((and (org-agenda-today-p date)
- (memq (calendar-day-of-week date) org-agenda-weekend-days))
- 'org-agenda-date-weekend-today)
- ((org-agenda-today-p date) 'org-agenda-date-today)
- ((memq (calendar-day-of-week date) org-agenda-weekend-days)
- 'org-agenda-date-weekend)
- (t 'org-agenda-date)))
- (defvar org-agenda-show-log-scoped)
- ;;; 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
- ;;;###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")
- (when 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)))
- (when (and (integerp arg) (> arg 0))
- (setq span arg arg nil))
- (when (numberp span)
- (unless (< 0 span)
- (user-error "Agenda creation impossible for this span(=%d days)" span)))
- (catch 'exit
- (setq org-agenda-buffer-name
- (org-agenda--get-buffer-name
- (and 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-prepare "Day/Week")
- (setq start-day (or start-day org-agenda-start-day))
- (when (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-span)))
- (today (org-today))
- (sd (or start-day today))
- (ndays (org-agenda-span-to-ndays span sd))
- (org-agenda-start-on-weekday
- (and (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 rtn rtnall file date d start-pos end-pos todayp ;; e
- 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 (_ (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)))
- (setq-local org-starting-day (car day-numbers))
- (setq-local org-arg-loc arg)
- (setq-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))
- (org-agenda--insert-overriding-header
- (concat (org-agenda-span-name span)
- "-agenda"
- (cond ((<= 350 (- d2 d1)) "")
- ((= w1 w2) (format " (W%02d)" w1))
- (t (format " (W%02d-W%02d)" w1 w2)))
- ":\n")))
- ;; Add properties if we actually inserted a header.
- (when (> (point) s)
- (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))
- (when (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
- (when 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))))
- (when (or rtnall org-agenda-show-all-dates)
- (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))
- (when 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))
- (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 (or (not (get-buffer-window org-agenda-buffer-name))
- (and (pos-visible-in-window-p (point-min))
- (pos-visible-in-window-p (point-max))))
- (goto-char (1- (point-max)))
- (recenter -1)
- (when (not (pos-visible-in-window-p (or start-pos 1)))
- (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))
- (when (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) (cl-caddr date))))
- ((eq span 'year)
- (let ((date (calendar-gregorian-from-absolute start-day)))
- (if (calendar-leap-year-p (cl-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 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' unless a restriction lock
- is active."
- (interactive "P")
- (when 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 "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 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
- (setq org-agenda-buffer-name
- (org-agenda--get-buffer-name
- (and org-agenda-sticky
- (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)))
- (when (or org-agenda-search-view-always-boolean
- (member (string-to-char words) '(?- ?+ ?\{)))
- (setq boolean t))
- (setq words (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))
- (when (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 #'regexp-quote 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+))
- (when hdl-only (setq regexp (concat org-outline-regexp-bol ".*?"
- regexp))))
- (setq files (org-agenda-files nil 'ifmode))
- ;; Add `org-agenda-text-search-extra-files' unless there is some
- ;; restriction.
- (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives)
- (pop org-agenda-text-search-extra-files)
- (unless (get 'org-agenda-files 'org-restrict)
- (setq files (org-add-archive-files files))))
- ;; Uniquify files. However, let `org-check-agenda-file' handle
- ;; non-existent ones.
- (setq files (cl-remove-duplicates
- (append files org-agenda-text-search-extra-files)
- :test (lambda (a b)
- (and (file-exists-p a)
- (file-exists-p b)
- (file-equal-p a b))))
- 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)))
- (unless 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)
- (org-back-to-heading t)))
- (skip-chars-forward "* ")
- (setq beg (line-beginning-position)
- 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
- (line-beginning-position)
- (if hdl-only (line-end-position) 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)) ? )
- 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 nil (not inherited-tags))
- txt (org-agenda-format-item
- ""
- (buffer-substring-no-properties
- beg1 (line-end-position))
- 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
- 'type "search")
- (push txt ee)
- (goto-char (1- end))))))))))
- (setq rtn (nreverse ee))
- (setq rtnall (append rtnall rtn)))
- (org-agenda--insert-overriding-header
- (with-temp-buffer
- (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-agenda-structure-filter))
- (setq pos (point))
- (unless org-agenda-multi
- (insert (substitute-command-keys "\\<org-agenda-mode-map>\
- Press `\\[org-agenda-manipulate-query-add]', \
- `\\[org-agenda-manipulate-query-subtract]' to add/sub word, \
- `\\[org-agenda-manipulate-query-add-re]', \
- `\\[org-agenda-manipulate-query-subtract-re]' to add/sub regexp, \
- `\\[universal-argument] \\[org-agenda-redo]' for a fresh search\n"))
- (add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure-secondary)))
- (buffer-string)))
- (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 'org-agenda-structure-filter)
- (mapconcat
- (lambda (kw)
- (propertize kw 'face (list (org-get-todo-face kw) 'org-agenda-structure)))
- (org-split-string keywords "|")
- "|"))
- "\n"))
- (defvar org-select-this-todo-keyword nil)
- (defvar org-last-arg nil)
- (defvar crm-separator)
- ;;;###autoload
- (defun org-todo-list (&optional arg)
- "Show all (not done) TODO entries from all agenda files 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")
- (when org-agenda-overriding-arguments
- (setq arg org-agenda-overriding-arguments))
- (when (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
- (let* ((today (org-today))
- (date (calendar-gregorian-from-absolute today))
- (completion-ignore-case t)
- kwds org-select-this-todo-keyword rtn rtnall files file pos)
- (catch 'exit
- (setq org-agenda-buffer-name
- (org-agenda--get-buffer-name
- (and org-agenda-sticky
- (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")
- (setq kwds org-todo-keywords-for-agenda
- org-select-this-todo-keyword (if (stringp arg) arg
- (and (integerp arg)
- (> arg 0)
- (nth (1- arg) kwds))))
- (when (equal arg '(4))
- (setq org-select-this-todo-keyword
- (mapconcat #'identity
- (let ((crm-separator "|"))
- (completing-read-multiple
- "Keyword (or KWD1|KWD2|...): "
- (mapcar #'list kwds) nil nil))
- "|")))
- (and (equal 0 arg) (setq org-select-this-todo-keyword nil))
- (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))))
- (org-agenda--insert-overriding-header
- (with-temp-buffer
- (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 (substitute-command-keys "Press \
- \\<org-agenda-mode-map>`N \\[org-agenda-redo]' (e.g. `0 \\[org-agenda-redo]') \
- to search again: (0)[ALL]"))
- (let ((n 0))
- (dolist (k kwds)
- (let ((s (format "(%d)%s" (cl-incf n) k)))
- (when (> (+ (current-column) (string-width s) 1) (window-width))
- (insert "\n "))
- (insert " " s))))
- (insert "\n"))
- (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure-secondary))
- (buffer-string)))
- (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")
- (when 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)
- (org--matcher-tags-todo-only todo-only)
- rtn rtnall files file pos matcher
- buffer)
- (when (and (stringp match) (not (string-match "\\S-" match)))
- (setq match nil))
- (catch 'exit
- (setq org-agenda-buffer-name
- (org-agenda--get-buffer-name
- (and org-agenda-sticky
- (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"))))))
- (setq matcher (org-make-tags-matcher match))
- ;; Prepare agendas (and `org-tag-alist-for-agenda') before
- ;; expanding tags within `org-make-tags-matcher'
- (org-agenda-prepare (concat "TAGS " match))
- (setq 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 ,org--matcher-tags-todo-only)
- `(if current-prefix-arg nil ,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
- org--matcher-tags-todo-only))
- (setq rtnall (append rtnall rtn))))))))
- (org-agenda--insert-overriding-header
- (with-temp-buffer
- (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-agenda-structure-filter))
- (setq pos (point))
- (unless org-agenda-multi
- (insert (substitute-command-keys
- "Press \
- \\<org-agenda-mode-map>`\\[universal-argument] \\[org-agenda-redo]' \
- to search again\n")))
- (add-text-properties pos (1- (point))
- (list 'face 'org-agenda-structure-secondary))
- (buffer-string)))
- (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 (,org--matcher-tags-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.
- If an empty string, no header will be inserted. If any other
- string, it will be inserted as a header. If a function, insert
- the string returned by the function as a header. If nil, a
- header will be generated automatically according to the command.
- This variable should not be set directly, but custom commands can
- bind it in the options section.")
- (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 subtree 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)
- "Check 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."
- (org-back-to-heading t)
- (let* (;; (beg (point))
- (end (if subtree (save-excursion (org-end-of-subtree t) (point))
- (org-entry-end-position)))
- (planning-end (if subtree end (line-end-position 2)))
- m)
- (and
- (or (and (memq 'scheduled conditions)
- (re-search-forward org-scheduled-time-regexp planning-end t))
- (and (memq 'notscheduled conditions)
- (not
- (save-excursion
- (re-search-forward org-scheduled-time-regexp planning-end t))))
- (and (memq 'deadline conditions)
- (re-search-forward org-deadline-time-regexp planning-end t))
- (and (memq 'notdeadline conditions)
- (not
- (save-excursion
- (re-search-forward org-deadline-time-regexp planning-end t))))
- (and (memq 'timestamp conditions)
- (re-search-forward org-ts-regexp end t))
- (and (memq 'nottimestamp conditions)
- (not (save-excursion (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 (save-excursion (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 ((todo-re
- (concat "^\\*+[ \t]+"
- (regexp-opt
- (pcase args
- (`(,_ todo)
- (org-delete-all org-done-keywords
- (copy-sequence org-todo-keywords-1)))
- (`(,_ done) org-done-keywords)
- (`(,_ any) org-todo-keywords-1)
- (`(,_ ,(pred atom))
- (error "Invalid TODO class or type: %S" args))
- (`(,_ ,(pred (member "*"))) org-todo-keywords-1)
- (`(,_ ,todo-list) todo-list))
- 'words))))
- (pcase args
- (`(todo . ,_)
- (let (case-fold-search) (re-search-forward todo-re end t)))
- (`(nottodo . ,_)
- (not (let (case-fold-search) (re-search-forward todo-re end t))))
- (`(todo-unblocked . ,_)
- (catch :unblocked
- (while (let (case-fold-search) (re-search-forward todo-re end t))
- (when (org-entry-blocked-p) (throw :unblocked t)))
- nil))
- (`(nottodo-unblocked . ,_)
- (catch :unblocked
- (while (let (case-fold-search) (re-search-forward todo-re end t))
- (when (org-entry-blocked-p) (throw :unblocked nil)))
- t))
- (`(,type . ,_) (error "Unknown TODO skip type: %S" type)))))
- ;;;###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-overriding-header
- (or org-agenda-overriding-header "List of stuck projects: "))
- (matcher (nth 0 org-stuck-projects))
- (todo (nth 1 org-stuck-projects))
- (tags (nth 2 org-stuck-projects))
- (gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
- (todo-wds
- (if (not (member "*" todo)) todo
- (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-re (and todo
- (format "^\\*+[ \t]+\\(%s\\)\\>"
- (mapconcat #'identity todo-wds "\\|"))))
- (tags-re (cond ((null tags) nil)
- ((member "*" tags) org-tag-line-re)
- (tags
- (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re)))
- (concat org-outline-regexp-bol
- ".*?[ \t]:"
- other-tags
- (regexp-opt tags t)
- ":" other-tags "[ \t]*$")))
- (t nil)))
- (re-list (delq nil (list todo-re tags-re gen-re)))
- (skip-re
- (if (null re-list)
- (error "Missing information to identify unstuck projects")
- (mapconcat #'identity re-list "\\|")))
- (org-agenda-skip-function
- ;; Skip entry if `org-agenda-skip-regexp' matches anywhere
- ;; in the subtree.
- (lambda ()
- (and (save-excursion
- (let ((case-fold-search nil))
- (re-search-forward
- skip-re (save-excursion (org-end-of-subtree t)) t)))
- (progn (outline-next-heading) (point))))))
- (org-tags-view nil matcher)
- (setq org-agenda-buffer-name (buffer-name))
- (with-current-buffer org-agenda-buffer-name
- (setq org-agenda-redo-command
- `(org-agenda-list-stuck-projects ,current-prefix-arg))
- (let ((inhibit-read-only t))
- (add-text-properties
- (point-min) (point-max)
- `(org-redo-cmd ,org-agenda-redo-command))))))
- ;;; Diary integration
- (defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param.
- (defvar diary-list-entries-hook)
- (defvar diary-time-regexp)
- (defvar diary-modify-entry-list-string-function)
- (defvar diary-file-name-prefix)
- (defvar diary-display-function)
- (defun org-get-entries-from-diary (date)
- "Get the (Emacs Calendar) diary entries for DATE."
- (require 'diary-lib)
- (declare-function diary-fancy-display "diary-lib" ())
- (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*")
- (diary-display-function #'diary-fancy-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)
- (diary-time-regexp (concat "^" diary-time-regexp))
- entries
- (org-disable-agenda-to-diary t))
- (save-excursion
- (save-window-excursion
- (diary-list-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))
- (when (re-search-forward "^Org mode dummy\n?" nil t)
- (replace-match ""))
- (run-hooks 'org-agenda-cleanup-fancy-diary-hook))
- (defun org-modify-diary-entry-string (string)
- "Add text properties to string, allowing Org 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 (line-beginning-position))))
- (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
- (diary-add-to-list original-date "Org mode dummy" "")))
- (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."
- (with-no-warnings (defvar date) (defvar entry))
- (when (> (- (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 (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.
- (when 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-link-bracket-re "\\2" i))
- results))
- (concat (org-agenda-finalize-entries results) "\n"))))
- ;;; Agenda entry finders
- (defun org-agenda--timestamp-to-absolute (&rest args)
- "Call `org-time-string-to-absolute' with ARGS.
- However, throw `:skip' whenever an error is raised."
- (condition-case e
- (apply #'org-time-string-to-absolute args)
- (org-diary-sexp-no-match (throw :skip nil))
- (error
- (message "%s; Skipping entry" (error-message-string e))
- (throw :skip nil))))
- (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'."
- (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))))
- (if (not buffer)
- ;; If file does not exist, signal it in diary nonetheless.
- (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))
- (setf org-agenda-current-date date)
- (save-excursion
- (save-restriction
- (if (eq buffer org-agenda-restrict)
- (narrow-to-region org-agenda-restrict-begin
- org-agenda-restrict-end)
- (widen))
- ;; Rationalize ARGS. Also make sure `:deadline' comes
- ;; first in order to populate DEADLINES before passing it.
- ;;
- ;; We use `delq' since `org-uniquify' duplicates ARGS,
- ;; guarding us from modifying `org-agenda-entry-types'.
- (setf args (org-uniquify (or args org-agenda-entry-types)))
- (when (and (memq :scheduled args) (memq :scheduled* args))
- (setf args (delq :scheduled* args)))
- (cond
- ((memq :deadline args)
- (setf args (cons :deadline
- (delq :deadline (delq :deadline* args)))))
- ((memq :deadline* args)
- (setf args (cons :deadline* (delq :deadline* args)))))
- ;; Collect list of headlines. Return them flattened.
- (let ((case-fold-search nil) results deadlines)
- (org-dlet
- ((date date))
- (dolist (arg args (apply #'nconc (nreverse results)))
- (pcase arg
- ((and :todo (guard (org-agenda-today-p date)))
- (push (org-agenda-get-todos) results))
- (:timestamp
- (push (org-agenda-get-blocks) results)
- (push (org-agenda-get-timestamps deadlines) results))
- (:sexp
- (push (org-agenda-get-sexps) results))
- (:scheduled
- (push (org-agenda-get-scheduled deadlines) results))
- (:scheduled*
- (push (org-agenda-get-scheduled deadlines t) results))
- (:closed
- (push (org-agenda-get-progress) results))
- (:deadline
- (setf deadlines (org-agenda-get-deadlines))
- (push deadlines results))
- (:deadline*
- (setf deadlines (org-agenda-get-deadlines t))
- (push deadlines 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-entry-get-agenda-timestamp (pom)
- "Retrieve timestamp information for sorting agenda views.
- Given a point or marker POM, returns a cons cell of the timestamp
- and the timestamp type relevant for the sorting strategy in
- `org-agenda-sorting-strategy-selected'."
- (let (ts ts-date-type)
- (save-match-data
- (cond ((org-em 'scheduled-up 'scheduled-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "SCHEDULED")
- ts-date-type " scheduled"))
- ((org-em 'deadline-up 'deadline-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "DEADLINE")
- ts-date-type " deadline"))
- ((org-em 'ts-up 'ts-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "TIMESTAMP")
- ts-date-type " timestamp"))
- ((org-em 'tsia-up 'tsia-down
- org-agenda-sorting-strategy-selected)
- (setq ts (org-entry-get pom "TIMESTAMP_IA")
- ts-date-type " timestamp_ia"))
- ((org-em 'timestamp-up 'timestamp-down
- org-agenda-sorting-strategy-selected)
- (setq ts (or (org-entry-get pom "SCHEDULED")
- (org-entry-get pom "DEADLINE")
- (org-entry-get pom "TIMESTAMP")
- (org-entry-get pom "TIMESTAMP_IA"))
- ts-date-type ""))
- (t (setq ts-date-type "")))
- (cons (when ts (ignore-errors (org-time-string-to-absolute ts)))
- ts-date-type))))
- (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))))
- (case-fold-search nil)
- (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 level tags todo-state
- ts-date ts-date-type ts-date-pair
- 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-pair (org-agenda-entry-get-agenda-timestamp (point))
- ts-date (car ts-date-pair)
- ts-date-type (cdr ts-date-pair)
- 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 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
- 'level level
- 'ts-date ts-date
- '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
- ((eq org-agenda-todo-ignore-deadlines 'all) t)
- ((eq org-agenda-todo-ignore-deadlines 'far)
- (not (org-deadline-close-p (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-p (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 deadlines)
- "Return the date stamp information for agenda display.
- Optional argument DEADLINES is a list of deadline items to be
- displayed in agenda view."
- (with-no-warnings (defvar date))
- (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))))
- (current (calendar-absolute-from-gregorian date))
- (today (org-today))
- (deadline-position-alist
- (mapcar (lambda (d)
- (let ((m (get-text-property 0 'org-hd-marker d)))
- (and m (marker-position m))))
- deadlines))
- ;; Match time-stamps set to current date, time-stamps with
- ;; a repeater, and S-exp time-stamps.
- (regexp
- (concat
- (if org-agenda-include-inactive-timestamps "[[<]" "<")
- (regexp-quote
- (substring
- (format-time-string
- (car org-time-stamp-formats)
- (encode-time ; DATE bound by calendar
- 0 0 0 (nth 1 date) (car date) (nth 2 date)))
- 1 11))
- "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)"
- "\\|\\(<%%\\(([^>\n]+)\\)>\\)"))
- timestamp-items)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- ;; Skip date ranges, scheduled and deadlines, which are handled
- ;; specially. Also skip time-stamps before first headline as
- ;; there would be no entry to add to the agenda. Eventually,
- ;; ignore clock entries.
- (catch :skip
- (save-match-data
- (when (or (org-at-date-range-p)
- (org-at-planning-p)
- (org-before-first-heading-p)
- (and org-agenda-include-inactive-timestamps
- (org-at-clock-log-p))
- (not (org-at-timestamp-p 'agenda)))
- (throw :skip nil))
- (org-agenda-skip))
- (let* ((pos (match-beginning 0))
- (repeat (match-string 1))
- (sexp-entry (match-string 3))
- (time-stamp (if (or repeat sexp-entry) (match-string 0)
- (save-excursion
- (goto-char pos)
- (looking-at org-ts-regexp-both)
- (match-string 0))))
- (todo-state (org-get-todo-state))
- (warntime (get-text-property (point) 'org-appt-warntime))
- (done? (member todo-state org-done-keywords)))
- ;; Possibly skip done tasks.
- (when (and done? org-agenda-skip-timestamp-if-done)
- (throw :skip t))
- ;; S-exp entry doesn't match current day: skip it.
- (when (and sexp-entry (not (org-diary-sexp-entry sexp-entry "" date)))
- (throw :skip nil))
- (when repeat
- (let* ((past
- ;; A repeating time stamp is shown at its base
- ;; date and every repeated date up to TODAY. If
- ;; `org-agenda-prefer-last-repeat' is non-nil,
- ;; however, only the last repeat before today
- ;; (inclusive) is shown.
- (org-agenda--timestamp-to-absolute
- repeat
- (if (or (> current today)
- (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- today
- current)
- 'past (current-buffer) pos))
- (future
- ;; Display every repeated date past TODAY
- ;; (exclusive) unless
- ;; `org-agenda-show-future-repeats' is nil. If
- ;; this variable is set to `next', only display
- ;; the first repeated date after TODAY
- ;; (exclusive).
- (cond
- ((<= current today) past)
- ((not org-agenda-show-future-repeats) past)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
- (org-agenda--timestamp-to-absolute
- repeat base 'future (current-buffer) pos))))))
- (when (and (/= current past) (/= current future))
- (throw :skip nil))))
- (save-excursion
- (re-search-backward org-outline-regexp-bol nil t)
- ;; Possibly skip time-stamp when a deadline is set.
- (when (and org-agenda-skip-timestamp-if-deadline-is-shown
- (assq (point) deadline-position-alist))
- (throw :skip nil))
- (let* ((category (org-get-category pos))
- (inherited-tags
- (or (eq org-agenda-show-inherited-tags 'always)
- (and (consp 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 nil (not inherited-tags)))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (and (looking-at "\\*+[ \t]+\\(.*\\)")
- (match-string 1)))
- (inactive? (= (char-after pos) ?\[))
- (habit? (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
- (item
- (org-agenda-format-item
- (and inactive? org-agenda-inactive-leader)
- head level category tags time-stamp org-ts-regexp habit?)))
- (org-add-props item props
- 'priority (if habit?
- (org-habit-get-priority (org-habit-parse-todo))
- (org-get-priority item))
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker)
- 'date date
- 'level level
- 'ts-date (if repeat (org-agenda--timestamp-to-absolute repeat)
- current)
- 'todo-state todo-state
- 'warntime warntime
- 'type "timestamp")
- (push item timestamp-items))))
- (when org-agenda-skip-additional-timestamps-same-entry
- (outline-next-heading))))
- (nreverse timestamp-items)))
- (defun org-agenda-get-sexps ()
- "Return the sexp information for agenda display."
- (require 'diary-lib)
- (with-no-warnings (defvar date) (defvar entry))
- (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 "^&?%%(")
- ;; FIXME: Is this `entry' binding intended to be dynamic,
- ;; so as to "hide" any current binding for it?
- marker category extra 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)
- 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 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
- 'date date 'todo-state todo-state
- 'level level 'type "sexp" 'warntime warntime)
- (push txt ee)))))
- (nreverse ee)))
- ;; Calendar sanity: define some functions that are independent of
- ;; `calendar-date-style'.
- (defun org-anniversary (year month day &optional mark)
- "Like `diary-anniversary', but with fixed (ISO) order of arguments."
- (with-no-warnings
- (let ((calendar-date-style 'iso))
- (diary-anniversary year month day mark))))
- (defun org-cyclic (N year month day &optional mark)
- "Like `diary-cyclic', but with fixed (ISO) order of arguments."
- (with-no-warnings
- (let ((calendar-date-style 'iso))
- (diary-cyclic N year month day mark))))
- (defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark)
- "Like `diary-block', but with fixed (ISO) order of arguments."
- (with-no-warnings
- (let ((calendar-date-style 'iso))
- (diary-block Y1 M1 D1 Y2 M2 D2 mark))))
- (defun org-date (year month day &optional mark)
- "Like `diary-date', but with fixed (ISO) order of arguments."
- (with-no-warnings
- (let ((calendar-date-style 'iso))
- (diary-date year month day 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."
- (with-no-warnings (defvar date) (defvar entry))
- (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)))
- (defalias 'org-get-closed #'org-agenda-get-progress)
- (defun org-agenda-get-progress ()
- "Return the logged TODO entries for agenda display."
- (with-no-warnings (defvar date))
- (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
- (when (memq 'closed items) (concat "\\<" org-closed-string))
- (when (memq 'clock items) (concat "\\<" org-clock-string))
- (when (memq 'state items)
- (format "- +State \"%s\".*?" org-todo-regexp)))))
- (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)
- (encode-time ; DATE bound by calendar
- 0 0 0 (nth 1 date) (car date) (nth 2 date)))
- 1 11))))
- (org-agenda-search-headline-for-time nil)
- marker hdmarker priority category level tags closedp type
- 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))
- timestr (buffer-substring (match-beginning 0) (line-end-position)))
- (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 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 type (cond (closedp "closed")
- (statep "state")
- (t "clock")))
- (setq priority 100000)
- (org-add-props txt props
- 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done
- 'priority priority 'level level
- 'type type 'date date
- 'undone-face 'org-warning 'done-face 'org-agenda-done)
- (push txt ee))
- (goto-char (line-end-position))))
- (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* ((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-duration-to-minutes
- (or (plist-get pl :max-duration) "24:00")))
- (mintime (org-duration-to-minutes
- (or (plist-get pl :min-duration) 0)))
- (maxgap (org-duration-to-minutes
- ;; default 30:00 means never complain
- (or (plist-get pl :max-gap) "30:00")))
- (gapok (mapcar #'org-duration-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 (line-beginning-position))
- (unless (looking-at re)
- (error "No valid Clock line")
- (throw 'next t))
- (unless (match-end 3)
- (setq issue
- (format
- "No end time: (%s)"
- (org-duration-from-minutes
- (floor
- (- (float-time (org-current-time))
- (float-time (org-time-string-to-time (match-string 1))))
- 60)))
- face (or (plist-get pl :no-end-time-face) face))
- (throw 'next t))
- (setq ts (match-string 1)
- te (match-string 3)
- ts (float-time (org-time-string-to-time ts))
- te (float-time (org-time-string-to-time te))
- dt (- te ts))))
- (cond
- ((> dt (* 60 maxtime))
- ;; a very long clocking chunk
- (setq issue (format "Clocking interval is very long: %s"
- (org-duration-from-minutes (floor 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-duration-from-minutes (floor 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 (line-beginning-position) (line-end-position)))
- (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))
- (when (> (- (/ 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 (org-decode-time t1))
- (t2dec (org-decode-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
- (when (< 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."
- (with-no-warnings (defvar date))
- (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))
- (today (org-today))
- (today? (org-agenda-today-p date)) ; DATE bound by calendar.
- (current (calendar-absolute-from-gregorian date))
- deadline-items)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
- (org-agenda-skip)
- (let* ((s (match-string 1))
- (pos (1- (match-beginning 1)))
- (todo-state (save-match-data (org-get-todo-state)))
- (done? (member todo-state org-done-keywords))
- (sexp? (string-prefix-p "%%" s))
- ;; DEADLINE is the deadline date for the entry. It is
- ;; either the base date or the last repeat, according
- ;; to `org-agenda-prefer-last-repeat'.
- (deadline
- (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- ((or (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))
- (t (org-agenda--timestamp-to-absolute s))))
- ;; REPEAT is the future repeat closest from CURRENT,
- ;; according to `org-agenda-show-future-repeats'. If
- ;; the latter is nil, or if the time stamp has no
- ;; repeat part, default to DEADLINE.
- (repeat
- (cond
- (sexp? deadline)
- ((<= current today) deadline)
- ((not org-agenda-show-future-repeats) deadline)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
- (org-agenda--timestamp-to-absolute
- s base 'future (current-buffer) pos)))))
- (diff (- deadline current))
- (suppress-prewarning
- (let ((scheduled
- (and org-agenda-skip-deadline-prewarning-if-scheduled
- (org-entry-get nil "SCHEDULED"))))
- (cond
- ((not scheduled) nil)
- ;; The current item has a scheduled date, 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 pre-warning to no earlier than SCHEDULED.
- (min (- deadline
- (org-agenda--timestamp-to-absolute scheduled))
- org-deadline-warning-days))
- ;; Set pre-warning to deadline.
- (t 0))))
- (wdays (or suppress-prewarning (org-get-wdays s))))
- (cond
- ;; Only display deadlines at their base date, at future
- ;; repeat occurrences or in today agenda.
- ((= current deadline) nil)
- ((= current repeat) nil)
- ((not today?) (throw :skip nil))
- ;; Upcoming deadline: display within warning period WDAYS.
- ((> deadline current) (when (> diff wdays) (throw :skip nil)))
- ;; Overdue deadline: warn about it for
- ;; `org-deadline-past-days' duration.
- (t (when (< org-deadline-past-days (- diff)) (throw :skip nil))))
- ;; Possibly skip done tasks.
- (when (and done?
- (or org-agenda-skip-deadline-if-done
- (/= deadline current)))
- (throw :skip nil))
- (save-excursion
- (re-search-backward "^\\*+[ \t]+" nil t)
- (goto-char (match-end 0))
- (let* ((category (org-get-category))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (buffer-substring (point) (line-end-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 nil (not inherited-tags)))
- (time
- (cond
- ;; No time of day designation if it is only
- ;; a reminder.
- ((and (/= current deadline) (/= current repeat)) nil)
- ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (concat (substring s (match-beginning 1)) " "))
- (t 'time)))
- (item
- (org-agenda-format-item
- ;; Insert appropriate suffixes before deadlines.
- ;; Those only apply to today agenda.
- (pcase-let ((`(,now ,future ,past)
- org-agenda-deadline-leaders))
- (cond
- ((and today? (< deadline today)) (format past (- diff)))
- ((and today? (> deadline today)) (format future diff))
- (t now)))
- head level category tags time))
- (face (org-agenda-deadline-face
- (- 1 (/ (float diff) (max wdays 1)))))
- (upcoming? (and today? (> deadline today)))
- (warntime (get-text-property (point) 'org-appt-warntime)))
- (org-add-props item props
- 'org-marker (org-agenda-new-marker pos)
- 'org-hd-marker (org-agenda-new-marker (line-beginning-position))
- 'warntime warntime
- 'level level
- 'ts-date deadline
- 'priority
- ;; Adjust priority to today reminders about deadlines.
- ;; Overdue deadlines get the highest priority
- ;; increase, then imminent deadlines and eventually
- ;; more distant deadlines.
- (let ((adjust (if today? (- diff) 0)))
- (+ adjust (org-get-priority item)))
- 'todo-state todo-state
- 'type (if upcoming? "upcoming-deadline" "deadline")
- 'date (if upcoming? date deadline)
- 'face (if done? 'org-agenda-done face)
- 'undone-face face
- 'done-face 'org-agenda-done)
- (push item deadline-items))))))
- (nreverse deadline-items)))
- (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."
- (assoc-default fraction org-agenda-deadline-faces #'<=))
- (defun org-agenda-get-scheduled (&optional deadlines with-hour)
- "Return the scheduled information for agenda display.
- Optional argument DEADLINES is a list of deadline items to be
- displayed in agenda view. When WITH-HOUR is non-nil, only return
- scheduled items with an hour specification like [h]h:mm."
- (with-no-warnings (defvar date))
- (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))
- (today (org-today))
- (todayp (org-agenda-today-p date)) ; DATE bound by calendar.
- (current (calendar-absolute-from-gregorian date))
- (deadline-pos
- (mapcar (lambda (d)
- (let ((m (get-text-property 0 'org-hd-marker d)))
- (and m (marker-position m))))
- deadlines))
- scheduled-items)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (catch :skip
- (unless (save-match-data (org-at-planning-p)) (throw :skip nil))
- (org-agenda-skip)
- (let* ((s (match-string 1))
- (pos (1- (match-beginning 1)))
- (todo-state (save-match-data (org-get-todo-state)))
- (donep (member todo-state org-done-keywords))
- (sexp? (string-prefix-p "%%" s))
- ;; SCHEDULE is the scheduled date for the entry. It is
- ;; either the bare date or the last repeat, according
- ;; to `org-agenda-prefer-last-repeat'.
- (schedule
- (cond
- (sexp? (org-agenda--timestamp-to-absolute s current))
- ((or (eq org-agenda-prefer-last-repeat t)
- (member todo-state org-agenda-prefer-last-repeat))
- (org-agenda--timestamp-to-absolute
- s today 'past (current-buffer) pos))
- (t (org-agenda--timestamp-to-absolute s))))
- ;; REPEAT is the future repeat closest from CURRENT,
- ;; according to `org-agenda-show-future-repeats'. If
- ;; the latter is nil, or if the time stamp has no
- ;; repeat part, default to SCHEDULE.
- (repeat
- (cond
- (sexp? schedule)
- ((<= current today) schedule)
- ((not org-agenda-show-future-repeats) schedule)
- (t
- (let ((base (if (eq org-agenda-show-future-repeats 'next)
- (1+ today)
- current)))
- (org-agenda--timestamp-to-absolute
- s base 'future (current-buffer) pos)))))
- (diff (- current schedule))
- (warntime (get-text-property (point) 'org-appt-warntime))
- (pastschedp (< schedule today))
- (futureschedp (> schedule today))
- (habitp (and (fboundp 'org-is-habit-p) (org-is-habit-p)))
- (suppress-delay
- (let ((deadline (and org-agenda-skip-scheduled-delay-if-deadline
- (org-entry-get nil "DEADLINE"))))
- (cond
- ((not deadline) nil)
- ;; The current item has a deadline date, 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 (- schedule
- (org-agenda--timestamp-to-absolute deadline))
- org-scheduled-delay-days))
- (t 0))))
- (ddays
- (cond
- ;; Nullify delay when a repeater triggered already
- ;; and the delay is of the form --Xd.
- ((and (string-match-p "--[0-9]+[hdwmy]" s)
- (> schedule (org-agenda--timestamp-to-absolute s)))
- 0)
- (suppress-delay
- (let ((org-scheduled-delay-days suppress-delay))
- (org-get-wdays s t t)))
- (t (org-get-wdays s t)))))
- ;; Display scheduled items at base date (SCHEDULE), today if
- ;; scheduled before the current date, and at any repeat past
- ;; today. However, skip delayed items and items that have
- ;; been displayed for more than `org-scheduled-past-days'.
- (unless (and todayp
- habitp
- (bound-and-true-p org-habit-show-all-today))
- (when (or (and (> ddays 0) (< diff ddays))
- (> diff (or (and habitp org-habit-scheduled-past-days)
- org-scheduled-past-days))
- (> schedule current)
- (and (/= current schedule)
- (/= current today)
- (/= current repeat)))
- (throw :skip nil)))
- ;; Possibly skip done tasks.
- (when (and donep
- (or org-agenda-skip-scheduled-if-done
- (/= schedule current)))
- (throw :skip nil))
- ;; Skip entry if it already appears as a deadline, per
- ;; `org-agenda-skip-scheduled-if-deadline-is-shown'. This
- ;; doesn't apply to habits.
- (when (pcase org-agenda-skip-scheduled-if-deadline-is-shown
- ((guard
- (or (not (memq (line-beginning-position 0) deadline-pos))
- habitp))
- nil)
- (`repeated-after-deadline
- (let ((deadline (time-to-days
- (org-get-deadline-time (point)))))
- (and (<= schedule deadline) (> current deadline))))
- (`not-today pastschedp)
- (`t t)
- (_ nil))
- (throw :skip nil))
- ;; Skip habits if `org-habit-show-habits' is nil, or if we
- ;; only show them for today. Also skip done habits.
- (when (and habitp
- (or donep
- (not (bound-and-true-p org-habit-show-habits))
- (and (not todayp)
- (bound-and-true-p
- org-habit-show-habits-only-for-today))))
- (throw :skip nil))
- (save-excursion
- (re-search-backward "^\\*+[ \t]+" nil t)
- (goto-char (match-end 0))
- (let* ((category (org-get-category))
- (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 nil (not inherited-tags)))
- (level (make-string (org-reduced-level (org-outline-level))
- ?\s))
- (head (buffer-substring (point) (line-end-position)))
- (time
- (cond
- ;; No time of day designation if it is only a
- ;; reminder, except for habits, which always show
- ;; the time of day. Habits are an exception
- ;; because if there is a time of day, that is
- ;; interpreted to mean they should usually happen
- ;; then, even if doing the habit was missed.
- ((and
- (not habitp)
- (/= current schedule)
- (/= current repeat))
- nil)
- ((string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s)
- (concat (substring s (match-beginning 1)) " "))
- (t 'time)))
- (item
- (org-agenda-format-item
- (pcase-let ((`(,first ,past) org-agenda-scheduled-leaders))
- ;; Show a reminder of a past scheduled today.
- (if (and todayp pastschedp)
- (format past diff)
- first))
- head level category tags time nil habitp))
- (face (cond ((and (not habitp) pastschedp)
- 'org-scheduled-previously)
- ((and habitp futureschedp)
- 'org-agenda-done)
- (todayp 'org-scheduled-today)
- (t 'org-scheduled)))
- (habitp (and habitp (org-habit-parse-todo))))
- (org-add-props item 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 (line-beginning-position))
- 'type (if pastschedp "past-scheduled" "scheduled")
- 'date (if pastschedp schedule date)
- 'ts-date schedule
- 'warntime warntime
- 'level level
- 'priority (if habitp (org-habit-get-priority habitp)
- (+ 99 diff (org-get-priority item)))
- 'org-habit-p habitp
- 'todo-state todo-state)
- (push item scheduled-items))))))
- (nreverse scheduled-items)))
- (defun org-agenda-get-blocks ()
- "Return the date-range information for agenda display."
- (with-no-warnings (defvar date))
- (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
- 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
- (condition-case err
- (org-time-string-to-time s1)
- (error
- (error
- "Bad timestamp %S at %d in buffer %S\nError was: %s"
- s1
- pos
- (current-buffer)
- (error-message-string err)))))
- d2 (time-to-days
- (condition-case err
- (org-time-string-to-time s2)
- (error
- (error
- "Bad timestamp %S at %d in buffer %S\nError was: %s"
- s2
- pos
- (current-buffer)
- (error-message-string err))))))
- (when (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))
- (when (and donep org-agenda-skip-timestamp-if-done)
- (throw :skip t))
- (setq marker (org-agenda-new-marker (point))
- category (org-get-category))
- (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 nil (not inherited-tags)))
- (setq level (make-string (org-reduced-level (org-outline-level)) ? ))
- (looking-at "\\*+[ \t]+\\(.*\\)")
- (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
- (save-match-data
- (let ((hhmm1 (and (string-match org-ts-regexp1 s1)
- (match-string 6 s1)))
- (hhmm2 (and (string-match org-ts-regexp1 s2)
- (match-string 6 s2))))
- (cond ((string= hhmm1 hhmm2)
- (concat "<" start-time ">--<" end-time ">"))
- ((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))
- (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'."
- (cl-dolist (entry org-agenda-category-icon-alist)
- (when (string-match-p (car entry) category)
- (if (listp (cadr entry))
- (cl-return (cadr entry))
- (cl-return (apply #'create-image (cdr entry)))))))
- (defun org-agenda-format-item (extra txt &optional with-level with-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.
- WITH-LEVEL may be a string to replace the `%l' specifier.
- WITH-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)))
- (cl-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))
- (with-no-warnings
- ;; `time', `tag', `effort' are needed for the eval of the prefix format.
- ;; Based on what I see in `org-compile-prefix-format', I added
- ;; a few more.
- (defvar breadcrumbs) (defvar category) (defvar category-icon)
- (defvar effort) (defvar extra)
- (defvar level) (defvar tag) (defvar time))
- (let* ((category (or with-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)
- ""))
- (effort (and (not (string= txt ""))
- (get-text-property 1 'effort txt)))
- (tag (if tags (nth (1- (length tags)) tags) ""))
- (time-grid-trailing-characters (nth 2 org-agenda-time-grid))
- (extra (or (and (not habitp) extra) ""))
- time
- (ts (when 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 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.
- (when (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.
- (when s1 (setq s1 (org-get-time-of-day s1 t)))
- (when s2 (setq s2 (org-get-time-of-day s2 t)))
- ;; Try to set s2 if s1 and
- ;; `org-agenda-default-appointment-duration' are set
- (when (and s1 (not s2) org-agenda-default-appointment-duration)
- (setq s2
- (org-duration-from-minutes
- (+ (org-duration-to-minutes s1 t)
- org-agenda-default-appointment-duration)
- nil t)))
- ;; Compute the duration
- (when s2
- (setq duration (- (org-duration-to-minutes s2)
- (org-duration-to-minutes s1))))
- ;; Format S1 and S2 for display.
- (when s1 (setq s1 (format "%5s" (org-get-time-of-day s1 'overtime))))
- (when s2 (setq s2 (org-get-time-of-day s2 'overtime))))
- (when (string-match org-tag-group-re 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 1 txt))
- t t txt))))
- (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
- (when org-prefix-has-breadcrumbs
- (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker)
- (let ((s (org-format-outline-path (org-get-outline-path)
- (1- (frame-width))
- nil org-agenda-breadcrumbs-separator)))
- (if (eq "" s) "" (concat s org-agenda-breadcrumbs-separator))))))
- (setq time (cond (s2 (concat
- (org-agenda-time-of-day-to-ampm-maybe s1)
- "-" (org-agenda-time-of-day-to-ampm-maybe s2)
- (when org-agenda-timegrid-use-ampm " ")))
- (s1 (concat
- (org-agenda-time-of-day-to-ampm-maybe s1)
- (if org-agenda-timegrid-use-ampm
- (concat time-grid-trailing-characters " ")
- time-grid-trailing-characters)))
- (t ""))
- category (if (symbolp category) (symbol-name category) category)
- level (or with-level ""))
- (if (string-match org-link-bracket-re category)
- (progn
- (setq l (string-width (or (match-string 2) (match-string 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) ?\ ))))
- (when (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 t) 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 category
- 'tags tags
- 'org-priority-highest org-priority-highest
- 'org-priority-lowest org-priority-lowest
- 'time-of-day time-of-day
- 'duration duration
- '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)
- (when (string-match org-tag-group-re 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)
- (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 3 org-agenda-time-grid))
- (gridtimes (nth 1 org-agenda-time-grid))
- (req (car org-agenda-time-grid))
- (remove (member 'remove-match req))
- new time)
- (when (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 c f opt) ;; e
- (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)))
- (cl-case var
- (time (setq org-prefix-has-time t))
- (tag (setq org-prefix-has-tag t))
- (effort (setq org-prefix-has-effort t))
- (breadcrumbs (setq org-prefix-has-breadcrumbs t)))
- (setq f (concat "%" (match-string 2 s) "s"))
- (when (eq 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
- (and (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 (substring s (match-beginning 4))))))
- (if opt
- (setq varform
- `(if (member ,var '("" nil))
- ""
- (format ,f (concat ,var ,c))))
- (setq varform
- `(format ,f (if (member ,var '("" nil)) ""
- (concat ,var ,c (get-text-property 0 'extra-space ,var)))))))
- (if (eq var 'eval)
- (setf (substring s (match-beginning 0)
- (+ (match-beginning 4)
- (length (format "%S" (read (substring s (match-beginning 4)))))))
- "%s")
- (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)
- (setq org-agenda-sorting-strategy-selected
- (if (symbolp (car org-agenda-sorting-strategy))
- ;; the old format
- org-agenda-sorting-strategy
- (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)
- "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. When it is `overtime', any time above 24:00 is turned into \"+H:MM\"
- where H:MM is the duration above midnight."
- (let ((case-fold-search t)
- (time-regexp
- (rx word-start
- (group (opt (any "012")) digit) ;group 1: hours
- (or (and ":" (group (any "012345") digit) ;group 2: minutes
- (opt (group (or "am" "pm")))) ;group 3: am/pm
- ;; Special "HHam/pm" case.
- (group-n 3 (or "am" "pm")))
- word-end)))
- (save-match-data
- (when (and (string-match time-regexp s)
- (not (eq 'org-link (get-text-property 1 'face s))))
- (let ((hours
- (let* ((ampm (and (match-end 3) (downcase (match-string 3 s))))
- (am-p (equal ampm "am")))
- (pcase (string-to-number (match-string 1 s))
- ((and (guard (not ampm)) h) h)
- (12 (if am-p 0 12))
- (h (+ h (if am-p 0 12))))))
- (minutes
- (if (match-end 2)
- (string-to-number (match-string 2 s))
- 0)))
- (pcase string
- (`nil (+ minutes (* hours 100)))
- ((and `overtime
- (guard (or (> hours 24)
- (and (= hours 24)
- (> minutes 0)))))
- (format "+%d:%02d" (- hours 24) minutes))
- ((guard org-agenda-time-leading-zero)
- (format "%02d:%02d" hours minutes))
- (_
- (format "%d:%02d" hours minutes))))))))
- (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))))
- (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
- (lambda (e) (or e (if org-agenda-sort-noeffort-is-high
- 32767 -1))))))
- (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)))
- (when (and org-agenda-dim-blocked-tasks org-blocker-hook)
- (setq list (mapcar #'org-agenda--mark-blocked-entry list)))
- (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) (when p 1))))
- (lim 0))
- (delq nil
- (mapcar
- (lambda (e)
- (let ((pval (funcall
- fun (get-text-property (1- (length e))
- prop e))))
- (when pval (setq lim (+ lim pval)))
- (cond ((and pval (<= lim (abs limit))) e)
- ((and include (not pval)) e))))
- list)))
- list)))
- (defun org-agenda-limit-interactively (remove)
- "In agenda, interactively limit entries to various maximums."
- (interactive "P")
- (if remove
- (progn (setq org-agenda-max-entries nil
- org-agenda-max-todos nil
- org-agenda-max-tags nil
- org-agenda-max-effort nil)
- (org-agenda-redo))
- (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? "))
- (msg (cond ((= max ?E) "How many minutes? ")
- ((= max ?e) "How many entries? ")
- ((= max ?t) "How many TODO entries? ")
- ((= max ?T) "How many tagged entries? ")
- (t (user-error "Wrong input"))))
- (num (string-to-number (read-from-minibuffer msg))))
- (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 (line-beginning-position)
- (line-end-position)
- '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))
- (unless (string= org-agenda-todo-keyword-format "")
- (format org-agenda-todo-keyword-format
- (match-string 2 x)))
- (unless (string= org-agenda-todo-keyword-format "")
- ;; Remove `display' property as the icon could leak
- ;; on the white space.
- (org-add-props " " (org-plist-delete (text-properties-at 0 x)
- 'display)))
- (substring x (match-end 3)))))))
- x)))
- (defsubst org-cmp-values (a b property)
- "Compare the numeric value of text PROPERTY for string A and B."
- (let ((pa (or (get-text-property (1- (length a)) property a) 0))
- (pb (or (get-text-property (1- (length b)) property 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-agenda-sort-noeffort-is-high 32767 -1))
- ;; `effort-minutes' property is not directly accessible from
- ;; the strings, but is stored as a property in `txt'.
- (ea (or (get-text-property
- 0 'effort-minutes (get-text-property 0 'txt a))
- def))
- (eb (or (get-text-property
- 0 'effort-minutes (get-text-property 0 'txt 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- (length a)) 'org-category a) ""))
- (cb (or (get-text-property (1- (length b)) '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)))
- (case-fold-search nil))
- (when pla
- (when (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
- (when (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 (or ta tb)) nil)
- ((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 (or ta tb)) nil)
- ((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-agenda-sort-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 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-agenda-sort-notime-is-late 99999999 -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 ((if ta (and tb (< ta tb)) tb) -1)
- ((if tb (and ta (< tb ta)) 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))
- (org-dlet
- ((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 "timestamp_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))
- (stats-up (and (org-em 'stats-up 'stats-down ss)
- (org-cmp-values a b 'org-stats)))
- (stats-down (if stats-up (- stats-up) nil))
- (priority-up (and (org-em 'priority-up 'priority-down ss)
- (org-cmp-values a b 'priority)))
- (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)
- (when (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) t)
- '((-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.")
- (delete-overlay org-agenda-restriction-lock-overlay)
- (defun org-agenda-set-restriction-lock-from-agenda (arg)
- "Set the restriction lock to the agenda item at point from within the agenda.
- When called with a `\\[universal-argument]' prefix, restrict to
- the file which contains the item.
- Argument ARG is the prefix argument."
- (interactive "P")
- (unless (derived-mode-p 'org-agenda-mode)
- (user-error "Not in an Org agenda buffer"))
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- (with-current-buffer buffer
- (goto-char pos)
- (org-agenda-set-restriction-lock arg))))
- ;;;###autoload
- (defun org-agenda-set-restriction-lock (&optional type)
- "Set restriction lock for agenda to current subtree or file.
- When in a restricted subtree, remove it.
- The restriction will span over the entire file if TYPE is `file',
- or if type is \\='(4), or if the cursor is before the first headline
- in the file. Otherwise, only apply the restriction to the current
- subtree."
- (interactive "P")
- (if (and org-agenda-overriding-restriction
- (member org-agenda-restriction-lock-overlay
- (overlays-at (point)))
- (equal (overlay-start org-agenda-restriction-lock-overlay)
- (point)))
- (org-agenda-remove-restriction-lock 'noupdate)
- (org-agenda-remove-restriction-lock 'noupdate)
- (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))
- (line-end-position)))
- (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 agenda restriction lock."
- (interactive "P")
- (if (not org-agenda-restrict)
- (message "No agenda restriction to remove.")
- (delete-overlay org-agenda-restriction-lock-overlay)
- (delete-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 (or org-agenda-this-buffer-name
- 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 or component is of allowed type.
- If ERROR is non-nil, throw an error, otherwise just return nil.
- Allowed types are `agenda' `todo' `tags' `search'."
- (cond ((not org-agenda-type)
- (error "No Org agenda currently displayed"))
- ((memq org-agenda-type types) t)
- (error
- (error "Not allowed in '%s'-type agenda buffer or component" org-agenda-type))
- (t nil)))
- (defun org-agenda-Quit ()
- "Exit the agenda, killing the agenda buffer.
- Like `org-agenda-quit', but kill the buffer even when
- `org-agenda-sticky' is non-nil."
- (interactive)
- (org-agenda--quit))
- (defun org-agenda-quit ()
- "Exit the agenda.
- When `org-agenda-sticky' is non-nil, bury the agenda buffer
- instead of killing it.
- When `org-agenda-restore-windows-after-quit' is non-nil, restore
- the pre-agenda window configuration.
- When column view is active, exit column view instead of the
- agenda."
- (interactive)
- (org-agenda--quit org-agenda-sticky))
- (defun org-agenda--quit (&optional bury)
- (if org-agenda-columns-active
- (org-columns-quit)
- (let ((wconf org-agenda-pre-window-conf)
- (buf (current-buffer))
- (org-agenda-last-indirect-window
- (and (eq org-indirect-buffer-display 'other-window)
- org-agenda-last-indirect-buffer
- (get-buffer-window org-agenda-last-indirect-buffer))))
- (cond
- ((eq org-agenda-window-setup 'other-frame)
- (delete-frame))
- ((eq org-agenda-window-setup 'other-tab)
- (if (fboundp 'tab-bar-close-tab)
- (tab-bar-close-tab)
- (user-error "Your version of Emacs does not have tab bar mode support")))
- ((and org-agenda-restore-windows-after-quit
- wconf)
- ;; Maybe restore the pre-agenda window configuration. Reset
- ;; `org-agenda-pre-window-conf' before running
- ;; `set-window-configuration', which loses the current buffer.
- (setq org-agenda-pre-window-conf nil)
- (set-window-configuration wconf))
- (t
- (when org-agenda-last-indirect-window
- (delete-window org-agenda-last-indirect-window))
- (and (not (eq org-agenda-window-setup 'current-window))
- (not (one-window-p))
- (delete-window))))
- (if bury
- ;; Set the agenda buffer as the current buffer instead of
- ;; passing it as an argument to `bury-buffer' so that
- ;; `bury-buffer' removes it from the window.
- (with-current-buffer buf
- (bury-buffer))
- (kill-buffer buf)
- (setq org-agenda-archives-mode nil
- org-agenda-buffer nil)))))
- (defun org-agenda-exit ()
- "Exit the agenda, killing Org buffers loaded by the agenda.
- Like `org-agenda-Quit', but kill any buffers that were created by
- the agenda. Org buffers visited directly by the user will not be
- touched. Also, exit the agenda even if it is in column view."
- (interactive)
- (when org-agenda-columns-active
- (org-columns-quit))
- (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."
- (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")
- (defvar org-agenda-tag-filter-while-redo) ;FIXME: Where is this var used?
- (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))
- (effort-filter org-agenda-effort-filter)
- (effort-preset (get 'org-agenda-effort-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)
- (put 'org-agenda-effort-filter :preset-filter nil)
- (and cols (org-columns-quit))
- (message "Rebuilding agenda buffer...")
- (if series-redo-cmd
- (eval series-redo-cmd t)
- (cl-progv
- (mapcar #'car lprops)
- (mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
- (eval redo-cmd t)))
- (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-effort-filter effort-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)
- (put 'org-agenda-effort-filter :preset-filter effort-preset)
- (let ((tag (or tag-filter tag-preset))
- (cat (or cat-filter cat-preset))
- (effort (or effort-filter effort-preset))
- (re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag t))
- (when cat (org-agenda-filter-apply cat 'category))
- (when effort (org-agenda-filter-apply effort 'effort))
- (when re (org-agenda-filter-apply re 'regexp)))
- (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter))
- (and cols (called-interactively-p 'any) (org-agenda-columns))
- (org-goto-line line)
- (when (called-interactively-p 'any) (recenter window-line))))
- (defun org-agenda-redo-all (&optional exhaustive)
- "Rebuild all agenda views in the current buffer.
- With a prefix argument, do so in all agenda buffers."
- (interactive "P")
- (if exhaustive
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (derived-mode-p 'org-agenda-mode)
- (org-agenda-redo t))))
- (org-agenda-redo t)))
- (defvar org-global-tags-completion-table nil)
- (defvar org-agenda-filter-form nil)
- (defvar org-agenda-filtered-by-category nil)
- (defsubst org-agenda-get-category ()
- "Return the category of the agenda line."
- (org-get-at-bol 'org-category))
- (defun org-agenda-filter-by-category (strip)
- "Filter lines in the agenda buffer that have a specific category.
- The category is that of the current line.
- With a `\\[universal-argument]' prefix argument, exclude the lines of that category.
- When there is already a category filter in place, this command removes the
- filter."
- (interactive "P")
- (if (and org-agenda-filtered-by-category
- org-agenda-category-filter)
- (org-agenda-filter-show-all-cat)
- (let ((cat (org-no-properties (org-get-at-eol 'org-category 1))))
- (cond
- ((and cat strip)
- (org-agenda-filter-apply
- (push (concat "-" cat) org-agenda-category-filter) 'category))
- (cat
- (org-agenda-filter-apply
- (setq org-agenda-category-filter
- (list (concat "+" cat)))
- 'category))
- (t (error "No category at point"))))))
- (defun org-find-top-headline (&optional pos)
- "Find the topmost parent headline and return it.
- POS when non-nil is the marker or buffer position to start the
- search from."
- (save-excursion
- (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer))
- (when pos (goto-char pos))
- ;; Skip up to the topmost parent.
- (while (org-up-heading-safe))
- (ignore-errors
- (replace-regexp-in-string
- "^\\[[0-9]+/[0-9]+\\] *\\|^\\[%[0-9]+\\] *" ""
- (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. With prefix arg STRIP, hide
- all lines of the category at point."
- (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-top-filter))
- (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker))))
- (if toph (org-agenda-filter-top-headline-apply toph strip)
- (error "No top-level headline at point")))))
- (defvar org-agenda-regexp-filter nil)
- (defun org-agenda-filter-by-regexp (strip-or-accumulate)
- "Filter agenda entries by a regular expressions.
- You will be prompted for the regular expression, and the agenda
- view will only show entries that are matched by that expression.
- With one `\\[universal-argument]' prefix argument, hide entries matching the regexp.
- When there is already a regexp filter active, this command removed the
- filter. However, with two `\\[universal-argument]' prefix arguments, add a new condition to
- an already existing regexp filter."
- (interactive "P")
- (let* ((strip (equal strip-or-accumulate '(4)))
- (accumulate (equal strip-or-accumulate '(16))))
- (cond
- ((and org-agenda-regexp-filter (not accumulate))
- (org-agenda-filter-show-all-re)
- (message "Regexp filter removed"))
- (t (let ((flt (concat (if strip "-" "+")
- (read-from-minibuffer
- (if strip
- "Hide entries matching regexp: "
- "Narrow to entries matching regexp: ")))))
- (push flt org-agenda-regexp-filter)
- (org-agenda-filter-apply org-agenda-regexp-filter 'regexp))))))
- (defvar org-agenda-effort-filter nil)
- (defun org-agenda-filter-by-effort (strip-or-accumulate)
- "Filter agenda entries by effort.
- With no `\\[universal-argument]' prefix argument, keep entries matching the effort condition.
- With one `\\[universal-argument]' prefix argument, filter out entries matching the condition.
- With two `\\[universal-argument]' prefix arguments, add a second condition to the existing filter.
- This last option is in practice not very useful, but it is available for
- consistency with the other filter commands."
- (interactive "P")
- (let* ((efforts (split-string
- (or (cdr (assoc-string (concat org-effort-property "_ALL")
- org-global-properties
- t))
- "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")))
- ;; XXX: the following handles only up to 10 different
- ;; effort values.
- (allowed-keys (if (null efforts) nil
- (mapcar (lambda (n) (mod n 10)) ;turn 10 into 0
- (number-sequence 1 (length efforts)))))
- (keep (equal strip-or-accumulate '(16)))
- (negative (equal strip-or-accumulate '(4)))
- (current org-agenda-effort-filter)
- (op nil))
- (while (not (memq op '(?< ?> ?= ?_)))
- (setq op (read-char-exclusive
- "Effort operator? (> = or <) or press `_' again to remove filter")))
- ;; Select appropriate duration. Ignore non-digit characters.
- (if (eq op ?_)
- (progn
- (org-agenda-filter-show-all-effort)
- (message "Effort filter removed"))
- (let ((prompt
- (apply #'format
- (concat "Effort %c "
- (mapconcat (lambda (s) (concat "[%d]" s))
- efforts
- " "))
- op allowed-keys))
- (eff -1))
- (while (not (memq eff allowed-keys))
- (message prompt)
- (setq eff (- (read-char-exclusive) 48)))
- (org-agenda-filter-show-all-effort)
- (setq org-agenda-effort-filter
- (append
- (list (concat (if negative "-" "+")
- (char-to-string op)
- ;; Numbering is 1 2 3 ... 9 0, but we want
- ;; 0 1 2 ... 8 9.
- (nth (mod (1- eff) 10) efforts)))
- (if keep current nil)))
- (org-agenda-filter-apply org-agenda-effort-filter 'effort)))))
- (defun org-agenda-filter (&optional strip-or-accumulate)
- "Prompt for a general filter string and apply it to the agenda.
- The string may contain filter elements like
- +category
- +tag
- +<effort > and = are also allowed as effort operators
- +/regexp/
- Instead of `+', `-' is allowed to strip the agenda of matching entries.
- `+' is optional if it is not required to separate two string parts.
- Multiple filter elements can be concatenated without spaces, for example
- +work-John<0:10-/plot/
- selects entries with category `work' and effort estimates below 10 minutes,
- and deselects entries with tag `John' or matching the regexp `plot'.
- During entry of the filter, completion for tags, categories and effort
- values is offered. Since the syntax for categories and tags is identical
- there should be no overlap between categories and tags. If there is, tags
- get priority.
- A single `\\[universal-argument]' prefix arg STRIP-OR-ACCUMULATE will negate the
- entire filter, which can be useful in connection with the prompt history.
- A double `\\[universal-argument] \\[universal-argument]' prefix arg will add the new filter elements to the
- existing ones. A shortcut for this is to add an additional `+' at the
- beginning of the string, like `+-John'.
- With a triple prefix argument, execute the computed filtering defined in
- the variable `org-agenda-auto-exclude-function'."
- (interactive "P")
- (if (equal strip-or-accumulate '(64))
- ;; Execute the auto-exclude action
- (if (not org-agenda-auto-exclude-function)
- (user-error "`org-agenda-auto-exclude-function' is undefined")
- (org-agenda-filter-show-all-tag)
- (setq org-agenda-tag-filter nil)
- (dolist (tag (org-agenda-get-represented-tags))
- (let ((modifier (funcall org-agenda-auto-exclude-function tag)))
- (when modifier
- (push modifier org-agenda-tag-filter))))
- (unless (null org-agenda-tag-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand)))
- ;; Prompt for a filter and act
- (let* ((tag-list (org-agenda-get-represented-tags))
- (category-list (org-agenda-get-represented-categories))
- (negate (equal strip-or-accumulate '(4)))
- (cf (mapconcat #'identity org-agenda-category-filter ""))
- (tf (mapconcat #'identity org-agenda-tag-filter ""))
- ;; (rpl-fn (lambda (c) (replace-regexp-in-string "^\\+" "" (or (car c) ""))))
- (ef (replace-regexp-in-string "^\\+" "" (or (car org-agenda-effort-filter) "")))
- (rf (replace-regexp-in-string "^\\+" "" (or (car org-agenda-regexp-filter) "")))
- (ff (concat cf tf ef (when (not (equal rf "")) (concat "/" rf "/"))))
- (f-string (completing-read
- (concat
- (if negate "Negative filter" "Filter")
- " [+cat-tag<0:10-/regexp/]: ")
- #'org-agenda-filter-completion-function
- nil nil ff))
- (keep (or (if (string-match "^\\+[+-]" f-string)
- (progn (setq f-string (substring f-string 1)) t))
- (equal strip-or-accumulate '(16))))
- (fc (if keep org-agenda-category-filter))
- (ft (if keep org-agenda-tag-filter))
- (fe (if keep org-agenda-effort-filter))
- (fr (if keep org-agenda-regexp-filter))
- pm s)
- ;; If the filter contains a double-quoted string, replace a
- ;; single hyphen by the arbitrary and temporary string "~~~"
- ;; to disambiguate such hyphens from syntactic ones.
- (setq f-string (replace-regexp-in-string
- "\"\\([^\"]*\\)-\\([^\"]*\\)\"" "\"\\1~~~\\2\"" f-string))
- (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string)
- (setq pm (if (match-beginning 1) (match-string 1 f-string) "+"))
- (when negate
- (setq pm (if (equal pm "+") "-" "+")))
- (cond
- ((match-beginning 3)
- ;; category or tag
- (setq s (replace-regexp-in-string ; Remove the temporary special string.
- "~~~" "-" (match-string 3 f-string)))
- (cond
- ((member s tag-list)
- (org-pushnew-to-end (concat pm s) ft))
- ((member s category-list)
- (org-pushnew-to-end (concat pm ; Remove temporary double quotes.
- (replace-regexp-in-string "\"\\(.*\\)\"" "\\1" s))
- fc))
- (t (message
- "`%s%s' filter ignored because tag/category is not represented"
- pm s))))
- ((match-beginning 4)
- ;; effort
- (org-pushnew-to-end (concat pm (match-string 4 f-string)) fe))
- ((match-beginning 5)
- ;; regexp
- (org-pushnew-to-end (concat pm (match-string 6 f-string)) fr)))
- (setq f-string (substring f-string (match-end 0))))
- (org-agenda-filter-remove-all)
- (and fc (org-agenda-filter-apply
- (setq org-agenda-category-filter fc) 'category))
- (and ft (org-agenda-filter-apply
- (setq org-agenda-tag-filter ft) 'tag 'expand))
- (and fe (org-agenda-filter-apply
- (setq org-agenda-effort-filter fe) 'effort))
- (and fr (org-agenda-filter-apply
- (setq org-agenda-regexp-filter fr) 'regexp))
- (run-hooks 'org-agenda-filter-hook))))
- (defun org-agenda-filter-completion-function (string _predicate &optional flag)
- "Complete a complex filter string.
- FLAG specifies the type of completion operation to perform. This
- function is passed as a collection function to `completing-read',
- which see."
- (let ((completion-ignore-case t) ;tags are case-sensitive
- (confirm (lambda (x) (stringp x)))
- (prefix "")
- (operator "")
- table)
- (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string)
- (setq prefix (match-string 1 string)
- operator (match-string 2 string)
- string (match-string 3 string)))
- (cond
- ((member operator '("+" "-" "" nil))
- (setq table (append (org-agenda-get-represented-categories)
- (org-agenda-get-represented-tags))))
- ((member operator '("<" ">" "="))
- (setq table (split-string
- (or (cdr (assoc-string (concat org-effort-property "_ALL")
- org-global-properties
- t))
- "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")
- " +")))
- (t (setq table nil)))
- (pcase flag
- (`t (all-completions string table confirm))
- (`lambda (assoc string table)) ;exact match?
- (`nil
- (pcase (try-completion string table confirm)
- ((and completion (pred stringp))
- (concat prefix completion))
- (completion completion)))
- (_ nil))))
- (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))
- (when org-agenda-top-headline-filter
- (org-agenda-filter-show-all-top-filter))
- (when org-agenda-effort-filter
- (org-agenda-filter-show-all-effort))
- (org-agenda-finalize)
- (when (called-interactively-p 'interactive)
- (message "All agenda filters removed")))
- (defun org-agenda-filter-by-tag (strip-or-accumulate &optional char exclude)
- "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 a `\\[universal-argument]' prefix, apply the filter negatively, stripping all matches.
- With a `\\[universal-argument] \\[universal-argument]' prefix, add the new tag to the existing filter
- instead of replacing it.
- With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' prefix, filter the literal tag, \
- i.e. don't
- filter on all its group members.
- A Lisp caller can specify CHAR. EXCLUDE means that the new tag
- should be used to exclude the search - the interactive user can
- also press `-' or `+' to switch between filtering and excluding."
- (interactive "P")
- (let* ((alist org-tag-alist-for-agenda)
- (seen-chars nil)
- (tag-chars (mapconcat
- (lambda (x) (if (and (not (symbolp (car x)))
- (cdr x)
- (not (member (cdr x) seen-chars)))
- (progn
- (push (cdr x) seen-chars)
- (char-to-string (cdr x)))
- ""))
- org-tag-alist-for-agenda ""))
- (valid-char-list (append '(?\t ?\r ?\\ ?. ?\s ?q)
- (string-to-list tag-chars)))
- (exclude (or exclude (equal strip-or-accumulate '(4))))
- (accumulate (equal strip-or-accumulate '(16)))
- (expand (not (equal strip-or-accumulate '(64))))
- (inhibit-read-only t)
- (current org-agenda-tag-filter)
- a tag) ;; n
- (unless char
- (while (not (memq char valid-char-list))
- (org-unlogged-message
- "%s by tag%s: [%s ]tag-char [TAB]tag %s[\\]off [q]uit"
- (if exclude "Exclude[+]" "Filter[-]")
- (if expand "" " (no grouptag expand)")
- tag-chars
- (if org-agenda-auto-exclude-function "[RET] " ""))
- (setq char (read-char-exclusive))
- ;; Excluding or filtering down
- (cond ((eq char ?-) (setq exclude t))
- ((eq char ?+) (setq exclude nil)))))
- (when (eq char ?\t)
- (unless (local-variable-p 'org-global-tags-completion-table)
- (setq-local org-global-tags-completion-table
- (org-global-tags-completion-table)))
- (let ((completion-ignore-case t))
- (setq tag (completing-read
- "Tag: " org-global-tags-completion-table nil t))))
- (cond
- ((eq 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)))
- (when modifier
- (push modifier org-agenda-tag-filter))))
- (unless (null org-agenda-tag-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
- ((eq char ?\\)
- (org-agenda-filter-show-all-tag)
- (when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
- ((eq 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 expand))
- ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
- ((or (eq char ?\s)
- (setq a (rassoc char alist))
- (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 exclude "-" "+") tag)
- (if accumulate current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
- (t (error "Invalid tag selection character %c" char)))))
- (defun org-agenda-get-represented-categories ()
- "Return a list of all categories used in this agenda buffer."
- (or org-agenda-represented-categories
- (when (derived-mode-p 'org-agenda-mode)
- (let ((pos (point-min)) categories)
- (while (and (< pos (point-max))
- (setq pos (next-single-property-change
- pos 'org-category nil (point-max))))
- (push (get-text-property pos 'org-category) categories))
- (setq org-agenda-represented-categories
- ;; Enclose category names with a hyphen in double
- ;; quotes to process them specially in `org-agenda-filter'.
- (mapcar (lambda (s) (if (string-match-p "-" s) (format "\"%s\"" s) s))
- (nreverse (org-uniquify (delq nil categories)))))))))
- (defvar org-tag-groups-alist-for-agenda)
- (defun org-agenda-get-represented-tags ()
- "Return a list of all tags used in this agenda buffer.
- These will be lower-case, for filtering."
- (or org-agenda-represented-tags
- (when (derived-mode-p 'org-agenda-mode)
- (let ((pos (point-min)) tags-lists tt)
- (while (and (< pos (point-max))
- (setq pos (next-single-property-change
- pos 'tags nil (point-max))))
- (setq tt (get-text-property pos 'tags))
- (if tt (push tt tags-lists)))
- (setq tags-lists
- (nreverse (org-uniquify
- (delq nil (apply #'append tags-lists)))))
- (dolist (tag tags-lists)
- (mapc
- (lambda (group)
- (when (member tag group)
- (push (car group) tags-lists)))
- org-tag-groups-alist-for-agenda))
- (setq org-agenda-represented-tags tags-lists)))))
- (defun org-agenda-filter-make-matcher (filter type &optional expand)
- "Create the form that tests a line for agenda filter.
- Optional argument EXPAND can be used for the TYPE tag and will
- expand the tags in the FILTER if any of the tags in FILTER are
- grouptags."
- (let ((multi-pos-cats
- (and (eq type 'category)
- (string-match-p "\\+.*\\+"
- (mapconcat (lambda (cat) (substring cat 0 1))
- filter ""))))
- 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 ((op (string-to-char x)))
- (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
- (setq x (list x)))
- (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
- (push f1 f))))
- ;; 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)))
- ;; Effort filter
- ((eq type 'effort)
- (setq filter
- (delete-dups
- (append (get 'org-agenda-effort-filter :preset-filter)
- filter)))
- (dolist (x filter)
- (push (org-agenda-filter-effort-form x) f))))
- (cons (if multi-pos-cats 'or 'and) (nreverse f))))
- (defun org-agenda-filter-make-matcher-tag-exp (tags op)
- "Return a form associated to tag-expression TAGS.
- Build a form testing a line for agenda filter for
- tag-expressions. OP is an operator of type CHAR that allows the
- function to set the right switches in the returned form."
- (let (form)
- ;; Any of the expressions can match if OP is +, all must match if
- ;; the operator is -.
- (dolist (x tags (cons (if (eq op ?-) 'and 'or) form))
- (let* ((tag (substring x 1))
- (f (cond
- ((string= "" tag) 'tags)
- ((and (string-match-p "\\`{" tag) (string-match-p "}\\'" tag))
- ;; TAG is a regexp.
- (list 'org-match-any-p (substring tag 1 -1) 'tags))
- (t (list 'member tag 'tags)))))
- (push (if (eq op ?-) (list 'not f) f) form)))))
- (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-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."
- ;; `effort-minutes' property cannot be extracted directly from
- ;; current line but is stored as a property in `txt'.
- (let ((effort (get-text-property 0 'effort-minutes (org-get-at-bol 'txt))))
- (funcall op
- (or effort (if org-agenda-sort-noeffort-is-high 32767 -1))
- 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 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))
- rtn))))
- filter)
- (reverse rtn))
- filter))
- (defun org-agenda-filter-apply (filter type &optional expand)
- "Set FILTER as the new agenda filter and apply it.
- Optional argument EXPAND can be used for the TYPE tag and will
- expand the tags in the FILTER if any of the tags in FILTER are
- grouptags."
- ;; Deactivate `org-agenda-entry-text-mode' when filtering
- (when org-agenda-entry-text-mode (org-agenda-entry-text-mode))
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher
- filter type expand))
- ;; Only set `org-agenda-filtered-by-category' to t when a unique
- ;; category is used as the filter:
- (setq org-agenda-filtered-by-category
- (and (eq type 'category)
- (not (equal (substring (car filter) 0 1) "-"))))
- (org-agenda-set-mode-name)
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (when (or (org-get-at-bol 'org-hd-marker)
- (org-get-at-bol 'org-marker))
- (org-dlet
- ((tags (org-get-at-bol 'tags))
- (cat (org-agenda-get-category))
- (txt (or (org-get-at-bol 'txt) "")))
- (unless (eval org-agenda-filter-form t)
- (org-agenda-filter-hide-line type))))
- (beginning-of-line 2)))
- (when (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))))
- (when (and tophl (funcall (if negative 'identity 'not)
- (string= hl tophl)))
- (org-agenda-filter-hide-line 'top-headline)))
- (beginning-of-line 2)))
- (when (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)
- "If current line is TYPE, hide it in the agenda buffer."
- (let* (buffer-invisibility-spec
- (beg (max (point-min) (1- (line-beginning-position))))
- (end (line-end-position)))
- (let ((inhibit-read-only t))
- (add-text-properties
- beg end `(invisible org-filtered org-filter-type ,type)))))
- (defun org-agenda-remove-filter (type)
- "Remove filter of type TYPE from the agenda buffer."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (let ((inhibit-read-only t) pos)
- (while (setq pos (text-property-any (point) (point-max)
- 'org-filter-type type))
- (goto-char pos)
- (remove-text-properties
- (point) (next-single-property-change (point) 'org-filter-type)
- `(invisible org-filtered org-filter-type ,type))))
- (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil)
- (setq org-agenda-filter-form nil)
- (org-agenda-set-mode-name)
- (org-agenda-finalize)))
- (defun org-agenda-filter-show-all-tag nil
- (org-agenda-remove-filter 'tag))
- (defun org-agenda-filter-show-all-re nil
- (org-agenda-remove-filter 'regexp))
- (defun org-agenda-filter-show-all-effort nil
- (org-agenda-remove-filter 'effort))
- (defun org-agenda-filter-show-all-cat nil
- (org-agenda-remove-filter 'category))
- (defun org-agenda-filter-show-all-top-filter nil
- (org-agenda-remove-filter 'top-headline))
- (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
- ((eq org-agenda-type '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 (date)
- "Jump to DATE in agenda."
- (interactive
- (list
- (let ((org-read-date-prefer-future org-agenda-jump-prefer-future))
- (org-read-date))))
- (let* ((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 '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-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-backward-block))
- (point-min))))
- (defun org-agenda-backward-block ()
- "Move backward by one agenda block."
- (interactive)
- (org-agenda-forward-block 'backward))
- (defun org-agenda-forward-block (&optional backward)
- "Move forward by one agenda block.
- When optional argument BACKWARD is set, go backward."
- (interactive)
- (cond ((not (derived-mode-p 'org-agenda-mode))
- (user-error
- "Cannot execute this command outside of org-agenda-mode buffers"))
- ((looking-at (if backward "\\`" "\\'"))
- (message "Already at the %s block" (if backward "first" "last")))
- (t (let ((_pos (prog1 (point)
- (ignore-errors (if backward (backward-char 1)
- (move-end-of-line 1)))))
- (f (if backward
- #'previous-single-property-change
- #'next-single-property-change))
- moved dest)
- (while (and (setq dest (funcall
- f (point) 'org-agenda-structural-header))
- (not (get-text-property
- (point) 'org-agenda-structural-header)))
- (setq moved t)
- (goto-char dest))
- (if moved (move-beginning-of-line 1)
- (goto-char (if backward (point-min) (point-max)))
- (move-beginning-of-line 1)
- (message "No %s block" (if backward "previous" "further")))))))
- (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* ((wstart (window-start))
- (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))
- (set-window-start nil wstart)))
- (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)
- (org-unlogged-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")
- (pcase (read-char-exclusive)
- (?\ (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))
- ((or ?F ?f) (call-interactively 'org-agenda-follow-mode))
- (?a (call-interactively 'org-agenda-archives-mode))
- (?A (org-agenda-archives-mode 'files))
- ((or ?R ?r) (call-interactively 'org-agenda-clockreport-mode))
- ((or ?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 'agenda)
- (org-agenda-redo))
- (message "Display now includes inactive timestamps as well"))
- (?q (message "Abort"))
- (key (user-error "Invalid key: %s" key))))
- (defun org-agenda-reset-view ()
- "Switch to default view for agenda."
- (interactive)
- (org-agenda-change-time-span 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 weekly 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 ranging from 70 years ago
- to 30 years in the future 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 fortnightly 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 ranging from 70 years ago
- to 30 years in the future 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. 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 ranging from 70 years ago to 30 years in the future can
- also be written as 2-digit years."
- (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. Years ranging from 70
- years ago to 30 years in the future 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)))
- (when (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-iso-to-absolute
- (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)
- (beginning-of-line 1)
- ;; This does not work if user makes date format that starts with a blank
- (when (looking-at-p "^\\S-") (forward-char 1))
- (unless (re-search-forward "^\\S-" nil t arg)
- (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)
- (beginning-of-line 1)
- (unless (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."
- (delete-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 ()
- "Toggle clocktable mode in an agenda buffer."
- (interactive)
- (org-agenda-check-type t 'agenda)
- (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 `\\[universal-argument] \\[universal-argument]' prefix, show *only* \
- log items, nothing else."
- (interactive "P")
- (org-agenda-check-type t 'agenda)
- (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
- (cond ((and with-files (eq org-agenda-archives-mode t)) nil)
- (with-files t)
- (org-agenda-archives-mode nil)
- (t '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 (org-agenda-filter-any) " " "")
- (if (or org-agenda-category-filter
- (get 'org-agenda-category-filter :preset-filter))
- '(:eval (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 (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-effort-filter
- (get 'org-agenda-effort-filter :preset-filter))
- '(:eval (propertize
- (concat (mapconcat
- #'identity
- (append
- (get 'org-agenda-effort-filter :preset-filter)
- org-agenda-effort-filter)
- ""))
- 'face 'org-agenda-filter-effort
- 'help-echo "Effort conditions used in filtering"))
- "")
- (if (or org-agenda-regexp-filter
- (get 'org-agenda-regexp-filter :preset-filter))
- '(:eval (propertize
- (concat (mapconcat
- (lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/"))
- (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 " Clock" "")))
- (force-mode-line-update))
- (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 (_ n)
- (when (next-single-property-change (line-end-position) '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 (_ n)
- (let ((col (current-column))
- (goto (save-excursion
- (move-end-of-line 0)
- (previous-single-property-change (point) 'org-marker))))
- (when 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 entry at point in the corresponding Org file."
- (interactive)
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker)))
- ;; FIXME: use `org-switch-to-buffer-other-window'?
- (switch-to-buffer-other-window buffer)
- (widen)
- (push-mark)
- (goto-char pos)
- (when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
- (recenter (/ (window-height) 2))
- (org-back-to-heading t)
- (let ((case-fold-search nil))
- (when (re-search-forward org-complex-heading-regexp nil t)
- (goto-char (match-beginning 4)))))
- (run-hooks 'org-agenda-after-show-hook)
- (and highlight (org-highlight (line-beginning-position)
- (line-end-position)))))
- (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.")
- ;; Defined later in org-agenda.el
- (defvar org-agenda-loop-over-headlines-in-active-region nil)
- (defun org-agenda-do-in-region (beg end cmd &optional arg force-arg delete)
- "Between region BEG and END, call agenda command CMD.
- When optional argument ARG is non-nil or FORCE-ARG is t, pass
- ARG to CMD. When optional argument DELETE is non-nil, assume CMD
- deletes the agenda entry and don't move to the next entry."
- (save-excursion
- (goto-char beg)
- (let ((mend (move-marker (make-marker) end))
- (all (eq org-agenda-loop-over-headlines-in-active-region t))
- (match (and (stringp org-agenda-loop-over-headlines-in-active-region)
- org-agenda-loop-over-headlines-in-active-region))
- (level (and (eq org-agenda-loop-over-headlines-in-active-region 'start-level)
- (org-get-at-bol 'level))))
- (while (< (point) mend)
- (let ((ov (make-overlay (point) (line-end-position))))
- (if (not (or all
- (and match (looking-at-p match))
- (eq level (org-get-at-bol 'level))))
- (org-agenda-next-item 1)
- (overlay-put ov 'face 'region)
- (if (or arg force-arg) (funcall cmd arg) (funcall cmd))
- (when (not delete) (org-agenda-next-item 1))
- (delete-overlay ov)))))))
- ;; org-agenda-[schedule,deadline,date-prompt,todo,[toggle]archive*,
- ;; kill,set-property,set-effort] commands may loop over agenda
- ;; entries. Commands `org-agenda-set-tags' and `org-agenda-bulk-mark'
- ;; use their own mechanisms on active regions.
- (defmacro org-agenda-maybe-loop (cmd arg force-arg delete &rest body)
- "Maybe loop over agenda entries and perform CMD.
- Pass ARG, FORCE-ARG, DELETE and BODY to `org-agenda-do-in-region'."
- (declare (debug t))
- `(if (and (called-interactively-p 'any)
- org-agenda-loop-over-headlines-in-active-region
- (org-region-active-p))
- (org-agenda-do-in-region
- (region-beginning) (region-end) ,cmd ,arg ,force-arg ,delete)
- ,@body))
- (defun org-agenda-kill ()
- "Kill the entry or subtree belonging to the current agenda entry."
- (interactive)
- (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
- (org-agenda-maybe-loop
- #'org-agenda-kill nil nil t
- (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))
- (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 (line-beginning-position)
- dend (min (point-max) (1+ (line-end-position)))))
- (goto-char dbeg)
- (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n)))))
- (when (or (eq t org-agenda-confirm-kill)
- (and (numberp org-agenda-confirm-kill)
- (> n org-agenda-confirm-kill)))
- (let ((win-conf (current-window-configuration)))
- (unwind-protect
- (and
- (prog2
- (org-agenda-tree-to-indirect-buffer nil)
- (not (y-or-n-p
- (format "Delete entry with %d lines in buffer \"%s\"? "
- n (buffer-name buffer))))
- (kill-buffer org-last-indirect-buffer))
- (error "Abort"))
- (set-window-configuration win-conf))))
- (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)
- (funcall-interactively
- #'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)
- (funcall-interactively
- #'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)
- (funcall-interactively
- #'org-agenda-archive-with 'org-archive-subtree))
- (defun org-agenda-archive-to-archive-sibling ()
- "Move the entry to the archive sibling."
- (interactive)
- (funcall-interactively
- #'org-agenda-archive-with 'org-archive-to-archive-sibling))
- (defvar org-archive-from-agenda)
- (defun org-agenda-archive-with (cmd &optional confirm)
- "Move the entry to the archive sibling."
- (interactive)
- (or (eq major-mode 'org-agenda-mode) (user-error "Not in agenda"))
- (org-agenda-maybe-loop
- #'org-agenda-archive-with cmd nil t
- (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)
- (let ((org-archive-from-agenda t))
- (funcall cmd))))
- (error "Archiving works only in Org 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 (line-beginning-position)
- (1+ (line-end-position)))))
- (beginning-of-line 0))))))
- (defun org-agenda-refile (&optional goto rfloc no-update)
- "Refile the item at point.
- When called with `\\[universal-argument] \\[universal-argument]', \
- go to the location of the last
- refiled item.
- When called with `\\[universal-argument] \\[universal-argument] \
- \\[universal-argument]' prefix or when GOTO is 0, clear
- the refile cache.
- 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
- (org-with-wide-buffer
- (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 (line-beginning-position)
- (line-end-position)))
- (lkall (and buffer (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-link-bracket-re l)
- (match-string 1 l)))
- (if (or (not trg) (string-match org-link-any-re trg))
- ;; Don't use `org-with-wide-buffer' here as
- ;; opening the link may result in moving the point
- (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
- ;; FIXME: use `org-switch-to-buffer-other-window'?
- (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-link-bracket-re "\\)"))
- (save-excursion
- (beginning-of-line 1)
- (looking-at (concat ".*?\\(" org-link-bracket-re "\\)"))))
- (org-link-open-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)))
- (set (make-local-variable 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.
- When optional argument DELETE-OTHER-WINDOWS is non-nil, the
- displayed Org file fills the frame."
- (interactive)
- (if (and org-return-follows-link
- (not (org-get-at-bol 'org-marker))
- (org-in-regexp org-link-bracket-re))
- (org-link-open-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)))
- (unless buffer (user-error "Trying to switch to non-existent buffer"))
- (pop-to-buffer-same-window buffer)
- (when delete-other-windows (delete-other-windows))
- (widen)
- (goto-char pos)
- (when (derived-mode-p 'org-mode)
- (org-show-context 'agenda)
- (run-hooks 'org-agenda-after-show-hook)))))
- (defun org-agenda-goto-mouse (ev)
- "Go to the Org 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 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)))
- (org-agenda-goto t)
- (when full-entry (org-show-entry))
- (select-window win)))
- (defvar org-agenda-show-window nil)
- (defun org-agenda-show-and-scroll-up (&optional arg)
- "Display the Org file which contains the item at point.
- When called repeatedly, scroll the window that is displaying the buffer.
- With a `\\[universal-argument]' prefix argument, display the item, but \
- fold drawers."
- (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)
- (org-show-entry)
- (if arg (org-cycle-hide-drawers 'children)
- (org-with-wide-buffer
- (narrow-to-region (org-entry-beginning-position)
- (org-entry-end-position))
- (org-show-all '(drawers))))
- (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 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 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-back-to-heading)
- (set-window-start (selected-window) (line-beginning-position))
- (cond
- ((= more 0)
- (org-flag-subtree t)
- (save-excursion
- (org-back-to-heading)
- (run-hook-with-args 'org-cycle-hook 'folded))
- (message "Remote: FOLDED"))
- ((and (called-interactively-p 'any) (= more 1))
- (message "Remote: show with default settings"))
- ((= more 2)
- (outline-show-entry)
- (org-show-children)
- (save-excursion
- (org-back-to-heading)
- (run-hook-with-args 'org-cycle-hook 'children))
- (message "Remote: CHILDREN"))
- ((= more 3)
- (outline-show-subtree)
- (save-excursion
- (org-back-to-heading)
- (run-hook-with-args 'org-cycle-hook 'subtree))
- (message "Remote: SUBTREE"))
- ((> more 3)
- (outline-show-subtree)
- (message "Remote: SUBTREE AND ALL DRAWERS")))
- (select-window win)))
- (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-context-detail'. 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))
- (when (> 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 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 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."
- (when (org-get-at-bol 'org-agenda-diary-link)
- (org-agenda-error)))
- (defun org-agenda-error ()
- "Throw an error when a command is not allowed in the agenda."
- (user-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))
- (setq org-agenda-last-indirect-buffer org-last-indirect-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)
- (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))
- (defvar org-agenda-headline-snapshot-before-repeat)
- (defun org-agenda-todo (&optional arg)
- "Cycle TODO state of line at point, also in Org 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 file."
- (interactive "P")
- (org-agenda-check-no-diary)
- (org-agenda-maybe-loop
- #'org-agenda-todo arg nil nil
- (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-today-p (org-get-at-bol 'day)))
- (inhibit-read-only t)
- org-loop-over-headlines-in-active-region
- 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)
- (let ((current-prefix-arg arg))
- (call-interactively 'org-todo)
- ;; Make sure that log is recorded in current undo.
- (when (and org-log-setup
- (not (eq org-log-note-how 'note)))
- (org-add-log-note)))
- (and (bolp) (forward-char 1))
- (setq newhead (org-get-heading))
- (when (and 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-window-excursion
- (org-agenda-change-all-lines newhead hdmarker 'fixface just-one))
- (when (bound-and-true-p org-clock-out-when-done)
- (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda))
- newhead)
- (org-agenda-unmark-clocking-task))
- (org-move-to-column col)
- (org-agenda-mark-clocking-task)))))
- (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)
- (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)
- (org-get-tags hdmarker)))
- props m undone-face done-face finish new dotime level cat tags) ;; pl
- (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-agenda-get-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)
- (org-with-wide-buffer
- (org-agenda-format-item extra newhead level cat tags dotime))))
- ;; pl (text-property-any (line-beginning-position)
- ;; (line-end-position) '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 "") (delete-region (point) (line-beginning-position 2)))
- ((looking-at ".*")
- ;; When replacing the whole line, preserve bulk mark
- ;; overlay, if any.
- (let ((mark (catch :overlay
- (dolist (o (overlays-in (point) (+ 2 (point))))
- (when (eq (overlay-get o 'type)
- 'org-marked-entry-overlay)
- (throw :overlay o))))))
- (replace-match new t t)
- (beginning-of-line)
- (when mark (move-overlay mark (point) (+ 2 (point)))))
- (add-text-properties (line-beginning-position)
- (line-end-position) props)
- (when fixface
- (add-text-properties
- (line-beginning-position) (line-end-position)
- (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 (line-beginning-position) (line-end-position))
- (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'.
- When optional argument LINE is non-nil, align tags only on the
- current line."
- (let ((inhibit-read-only t)
- (org-agenda-tags-column (if (eq 'auto org-agenda-tags-column)
- (- (window-text-width))
- org-agenda-tags-column))
- (end (and line (line-end-position)))
- l c)
- (save-excursion
- (goto-char (if line (line-beginning-position) (point-min)))
- (while (re-search-forward org-tag-group-re end t)
- (add-text-properties
- (match-beginning 1) (match-end 1)
- (list 'face (delq nil (let ((prop (get-text-property
- (match-beginning 1) 'face)))
- (or (listp prop) (setq prop (list prop)))
- (if (memq 'org-tag prop)
- prop
- (cons 'org-tag prop))))))
- (setq l (string-width (match-string 1))
- c (if (< org-agenda-tags-column 0)
- (- (abs org-agenda-tags-column) l)
- org-agenda-tags-column))
- (goto-char (match-beginning 1))
- (delete-region (save-excursion (skip-chars-backward " \t") (point))
- (point))
- (insert (org-add-props
- (make-string (max 1 (- c (current-column))) ?\s)
- (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 file."
- (interactive)
- (org-agenda-priority 'up))
- (defun org-agenda-priority-down ()
- "Decrease the priority of line at point, also in Org file."
- (interactive)
- (org-agenda-priority 'down))
- (defun org-agenda-priority (&optional force-direction)
- "Set the priority of line at point, also in Org 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 file.
- Called with one universal prefix arg, show the priority instead
- of setting it.
- When called programmatically, FORCE-DIRECTION can be `set', `up',
- `down', or a character."
- (interactive "P")
- (unless org-priority-enable-commands
- (user-error "Priority commands are disabled"))
- (org-agenda-check-no-diary)
- (let* ((col (current-column))
- (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)
- (org-priority force-direction)
- (end-of-line 1)
- (setq newhead (org-get-heading)))
- (org-agenda-change-all-lines newhead hdmarker)
- (org-move-to-column col))))
- ;; 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) (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)
- (org-show-context 'agenda)
- (if tag
- (org-toggle-tag tag onoff)
- (call-interactively #'org-set-tags-command))
- (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)
- (org-agenda-maybe-loop
- #'org-agenda-set-property nil nil nil
- (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)
- (call-interactively 'org-set-property))))))
- (defun org-agenda-set-effort ()
- "Set the effort property for the current headline."
- (interactive)
- (org-agenda-check-no-diary)
- (org-agenda-maybe-loop
- #'org-agenda-set-effort nil nil nil
- (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)
- (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)
- (org-agenda-maybe-loop
- #'org-agenda-toggle-archive-tag nil nil nil
- (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)
- (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)
- (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)
- (unless (org-at-timestamp-p 'lax) (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))
- (when (> 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
- (line-beginning-position)))
- (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))
- (remove-text-properties (line-beginning-position)
- (line-end-position)
- '(display nil))
- (org-move-to-column
- (- (if (fboundp 'window-font-width)
- (/ (window-width nil t) (window-font-width))
- ;; Fall back to pre-9.3.3 behavior on Emacs <25.
- (window-width))
- (length stamp))
- t)
- (add-text-properties
- (1- (point)) (line-end-position)
- (list 'display (org-add-props stamp nil
- 'face '(secondary-selection default))))
- (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)
- (org-agenda-check-no-diary)
- (org-agenda-maybe-loop
- #'org-agenda-date-prompt arg t nil
- (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)
- (unless (org-at-timestamp-p 'lax) (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 'todo 'tags 'search)
- (org-agenda-check-no-diary)
- (org-agenda-maybe-loop
- #'org-agenda-schedule arg t nil
- (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))
- 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 'todo 'tags 'search)
- (org-agenda-check-no-diary)
- (org-agenda-maybe-loop
- #'org-agenda-deadline arg t nil
- (let* ((marker (or (org-get-at-bol 'org-marker)
- (org-agenda-error)))
- (buffer (marker-buffer marker))
- (pos (marker-position marker))
- 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-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)
- (user-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)
- (org-with-wide-buffer
- (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)
- (when (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:
- ((bound-and-true-p 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 (line-beginning-position) '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 (line-beginning-position) '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 first child of the date
- date-tree-last in the date tree, as last child of the date
- top-level as top-level entries at the end of the file."
- :group 'org-agenda
- :type '(choice
- (const :tag "first in a date tree" date-tree)
- (const :tag "last in a date tree" date-tree-last)
- (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))
- (cl-case 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)))
- (day
- (let ((org-prefix-has-time t)
- (org-agenda-time-leading-zero t)
- fmt time time2)
- (when 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))
- ((block) ;; Wrap this in (strictly unnecessary) parens because
- ;; otherwise the indentation gets confused by the
- ;; special meaning of 'block
- (when (> (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))
- (unless (bolp) (insert "\n"))
- (org-insert-heading nil t t)
- (insert text)
- (org-end-of-meta-data)
- (unless (bolp) (insert "\n"))
- (when org-adapt-indentation (indent-to-column 2)))
- (defun org-agenda-insert-diary-make-new-entry (text)
- "Make a new entry with TEXT as a child of the current subtree.
- Position the point in the heading's first body line so that
- a timestamp can be added there."
- (cond
- ((eq org-agenda-insert-diary-strategy 'date-tree-last)
- (end-of-line)
- (org-insert-heading '(4) t)
- (org-do-demote))
- (t
- (outline-next-heading)
- (org-back-over-empty-lines)
- (unless (looking-at "[ \t]*$") (save-excursion (insert "\n")))
- (org-insert-heading nil t)
- (org-do-demote)))
- (let ((col (current-column)))
- (insert text)
- (org-end-of-meta-data)
- ;; Ensure point is left on a blank line, at proper indentation.
- (unless (bolp) (insert "\n"))
- (unless (looking-at-p "^[ \t]*$") (save-excursion (insert "\n")))
- (when org-adapt-indentation (indent-to-column col)))
- (org-show-set-visibility 'lineage))
- (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 file."
- (interactive)
- (if (not (eq org-agenda-diary-file 'diary-file))
- (org-agenda-diary-entry-in-org-file)
- (require 'diary-lib)
- (let* ((char (read-char-exclusive
- "Diary entry: [d]ay [w]eekly [m]onthly [y]early\
- [a]nniversary [b]lock [c]yclic"))
- (cmd (cdr (assoc char
- '((?d . diary-insert-entry)
- (?w . diary-insert-weekly-entry)
- (?m . diary-insert-monthly-entry)
- (?y . diary-insert-yearly-entry)
- (?a . diary-insert-anniversary-entry)
- (?b . diary-insert-block-entry)
- (?c . diary-insert-cyclic-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)
- (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
- (org-dlet
- ((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-lunar-phases))
- (defun org-agenda-holidays ()
- "Display the holidays for the 3 months around the cursor date."
- (interactive)
- (org-agenda-execute-calendar-command 'calendar-list-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)
- (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 agenda for the calendar date displayed at the cursor.
- This is a command that has to be installed in `calendar-mode-map'."
- (interactive)
- ;; Temporarily disable sticky agenda since user clearly wants to
- ;; refresh view anyway.
- (let ((org-agenda-buffer-tmp-name "*Org Agenda(a)*")
- (org-agenda-sticky nil))
- (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)
- (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"
- "Bahá’í: " (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 ()
- "Non-nil when current entry is marked for bulk action."
- (eq (get-char-property (line-beginning-position) 'type)
- 'org-marked-entry-overlay))
- (defun org-agenda-bulk-mark (&optional arg)
- "Mark entries for future bulk action.
- When ARG is nil or one and region is not active then mark the
- entry at point.
- When ARG is nil or one and region is active then mark the entries
- in the region.
- When ARG is greater than one mark ARG lines."
- (interactive "p")
- (when (and (or (not arg) (= arg 1)) (use-region-p))
- (setq arg (count-lines (region-beginning) (region-end)))
- (goto-char (region-beginning))
- (deactivate-mark))
- (dotimes (_ (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 (line-beginning-position)
- (+ 2 (line-beginning-position))))
- (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) 'org-hd-marker)))
- (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) 'org-hd-marker))
- (while (and (re-search-forward regexp nil t)
- (setq txt-at-point
- (get-text-property (match-beginning 0) 'txt)))
- (if (get-char-property (point) 'invisible)
- (beginning-of-line 2)
- (when (string-match-p regexp txt-at-point)
- (setq entries-marked (1+ entries-marked))
- (call-interactively 'org-agenda-bulk-mark)))))
- (unless 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
- (line-beginning-position) (+ 2 (line-beginning-position)))
- (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) 'org-hd-marker)))
- (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")
- (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)
- (defcustom org-agenda-loop-over-headlines-in-active-region t
- "Shall some commands act upon headlines in the active region?
- When set to t, some commands will be performed in all headlines
- within the active region.
- When set to `start-level', some commands will be performed in all
- headlines within the active region, provided that these headlines
- are of the same level than the first one.
- When set to a regular expression, those commands will be
- performed on the matching headlines within the active region.
- The list of commands is: `org-agenda-schedule',
- `org-agenda-deadline', `org-agenda-date-prompt',
- `org-agenda-todo', `org-agenda-archive*', `org-agenda-kill'.
- See `org-loop-over-headlines-in-active-region' for the equivalent
- option for Org buffers."
- :type '(choice (const :tag "Don't loop" nil)
- (const :tag "All headlines in active region" t)
- (const :tag "In active region, headlines at the same level than the first one" start-level)
- (regexp :tag "Regular expression matcher"))
- :version "27.1"
- :package-version '(Org . "9.4")
- :group 'org-agenda)
- (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")
- ;; When there is no mark, act on the agenda entry at point.
- (if (not org-agenda-bulk-marked-entries)
- (save-excursion (org-agenda-bulk-mark)))
- (dolist (m org-agenda-bulk-marked-entries)
- (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)))
- ;; Prompt for the bulk command.
- (org-unlogged-message
- (concat "Bulk (" (if org-agenda-persistent-marks "" "don't ") "[p]ersist marks): "
- "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile "
- "[S]catter [f]unction "
- (and org-agenda-bulk-custom-functions
- (format " Custom: [%s]"
- (mapconcat (lambda (f) (char-to-string (car f)))
- org-agenda-bulk-custom-functions
- "")))))
- (catch 'exit
- (let* ((org-log-refile (if org-log-refile 'time nil))
- (entries (reverse org-agenda-bulk-marked-entries))
- (org-overriding-default-time
- (and (get-text-property (point) 'org-agenda-date-header)
- (org-get-cursor-date)))
- redo-at-end
- cmd)
- (pcase (read-char-exclusive)
- (?p
- (let ((org-agenda-persistent-marks
- (not org-agenda-persistent-marks)))
- (org-agenda-bulk-action)
- (throw 'exit nil)))
- (?$
- (setq cmd #'org-agenda-archive))
- (?A
- (setq cmd #'org-agenda-archive-to-archive-sibling))
- ((or ?r ?w)
- (let ((refile-location
- (org-refile-get-location
- "Refile to"
- (marker-buffer (car entries))
- org-refile-allow-creating-parent-nodes)))
- (when (nth 3 refile-location)
- (setcar (nthcdr 3 refile-location)
- (move-marker
- (make-marker)
- (nth 3 refile-location)
- (or (get-file-buffer (nth 1 refile-location))
- (find-buffer-visiting (nth 1 refile-location))
- (error "This should not happen")))))
- (setq cmd (lambda () (org-agenda-refile nil refile-location t)))
- (setq redo-at-end t)))
- (?t
- (let ((state (completing-read
- "Todo state: "
- (with-current-buffer (marker-buffer (car entries))
- (mapcar #'list org-todo-keywords-1)))))
- (setq cmd (lambda ()
- (let ((org-inhibit-blocking t)
- (org-inhibit-logging 'note))
- (org-agenda-todo state))))))
- ((and (or ?- ?+) action)
- (let ((tag (completing-read
- (format "Tag to %s: " (if (eq action ?+) "add" "remove"))
- (with-current-buffer (marker-buffer (car entries))
- (delq nil
- (mapcar (lambda (x) (and (stringp (car x)) x))
- org-current-tag-alist))))))
- (setq cmd
- (lambda ()
- (org-agenda-set-tags tag
- (if (eq action ?+) 'on 'off))))))
- ((and (or ?s ?d) c)
- (let* ((schedule? (eq c ?s))
- (prompt (if schedule? "(Re)Schedule to" "(Re)Set Deadline to"))
- (time
- (and (not arg)
- (let ((new (org-read-date
- nil nil nil prompt org-overriding-default-time)))
- ;; A "double plus" answer applies to every
- ;; scheduled time. Do not turn it into
- ;; a fixed date yet.
- (if (string-match-p "\\`[ \t]*\\+\\+"
- org-read-date-final-answer)
- org-read-date-final-answer
- new)))))
- ;; Make sure to not prompt for a note when bulk
- ;; rescheduling/resetting deadline as Org cannot cope with
- ;; simultaneous notes. Besides, it could be annoying
- ;; depending on the number of marked items.
- (setq cmd
- (if schedule?
- (lambda ()
- (let ((org-log-reschedule
- (and org-log-reschedule 'time)))
- (org-agenda-schedule arg time)))
- (lambda ()
- (let ((org-log-redeadline (and org-log-redeadline 'time)))
- (org-agenda-deadline arg time)))))))
- (?S
- (unless (org-agenda-check-type nil 'agenda '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
- (lambda ()
- (let ((distance (1+ (random days))))
- (when arg
- (let ((dist distance)
- (day-of-week
- (calendar-day-of-week
- (calendar-gregorian-from-absolute (org-today)))))
- (dotimes (_ (1+ dist))
- (while (member day-of-week org-agenda-weekend-days)
- (cl-incf distance)
- (cl-incf day-of-week)
- (when (= day-of-week 7)
- (setq day-of-week 0)))
- (cl-incf day-of-week)
- (when (= day-of-week 7)
- (setq day-of-week 0)))))
- ;; Silently fail when try to replan a sexp entry.
- (ignore-errors
- (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))))))))
- (?f
- (setq cmd
- (intern
- (completing-read "Function: " obarray #'fboundp t nil nil))))
- (action
- (setq cmd
- (pcase (assoc action org-agenda-bulk-custom-functions)
- (`(,_ ,fn)
- fn)
- (`(,_ ,fn ,arg-fn)
- (apply #'apply-partially fn (funcall arg-fn)))
- (_
- (user-error "Invalid bulk action: %c" action))))
- (setq redo-at-end t)))
- ;; Sort the markers, to make sure that parents are handled
- ;; before children.
- (setq entries (sort entries
- (lambda (a b)
- (cond
- ((eq (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.
- (let ((processed 0)
- (skipped 0))
- (dolist (e entries)
- (let ((pos (text-property-any (point-min) (point-max) 'org-hd-marker e)))
- (if (not pos)
- (progn (message "Skipping removed entry at %s" e)
- (cl-incf skipped))
- (goto-char pos)
- (let (org-loop-over-headlines-in-active-region) (funcall cmd))
- ;; `post-command-hook' is not run yet. We make sure any
- ;; pending log note is processed.
- (when org-log-setup (org-add-log-note))
- (cl-incf processed))))
- (when redo-at-end (org-agenda-redo))
- (unless org-agenda-persistent-marks (org-agenda-bulk-unmark-all))
- (message "Acted on %d entries%s%s"
- processed
- (if (= skipped 0)
- ""
- (format ", skipped %d (disappeared before their turn)"
- skipped))
- (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-reapply-filters ()
- "Re-apply all agenda filters."
- (mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
- `((,org-agenda-tag-filter tag)
- (,org-agenda-category-filter category)
- (,org-agenda-regexp-filter regexp)
- (,org-agenda-effort-filter effort)
- (,(get 'org-agenda-tag-filter :preset-filter) tag)
- (,(get 'org-agenda-category-filter :preset-filter) category)
- (,(get 'org-agenda-effort-filter :preset-filter) effort)
- (,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
- (defun org-agenda-drag-line-forward (arg &optional backward)
- "Drag an agenda line forward by ARG lines.
- When the optional argument `backward' is non-nil, move backward."
- (interactive "p")
- (let ((inhibit-read-only t) lst line)
- (if (or (not (get-text-property (point) 'txt))
- (save-excursion
- (dotimes (_ arg)
- (move-beginning-of-line (if backward 0 2))
- (push (not (get-text-property (point) 'txt)) lst))
- (delq nil lst)))
- (message "Cannot move line forward")
- (let ((end (save-excursion (move-beginning-of-line 2) (point))))
- (move-beginning-of-line 1)
- (setq line (buffer-substring (point) end))
- (delete-region (point) end)
- (move-beginning-of-line (funcall (if backward '1- '1+) arg))
- (insert line)
- (org-agenda-reapply-filters)
- (org-agenda-mark-clocking-task)
- (move-beginning-of-line 0)))))
- (defun org-agenda-drag-line-backward (arg)
- "Drag an agenda line backward by ARG lines."
- (interactive "p")
- (org-agenda-drag-line-forward arg t))
- ;;; 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 "%s" (substitute-command-keys "Flagging note pushed to \
- kill ring. Press `\\[org-agenda-show-the-flagging-note]' 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")
- (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 (line-beginning-position)) 'org-hd-marker)
- (get-text-property (or pos (line-beginning-position)) '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")
- (when refresh (setq appt-time-msg-list nil))
- (when (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 nil)))
- (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 through entries and find if we should filter them out
- (mapc
- (lambda (x)
- (let* ((evt (org-trim
- (replace-regexp-in-string
- org-link-bracket-re "\\2"
- (or (get-text-property 1 'txt x) ""))))
- (cat (get-text-property (1- (length x)) '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 (assq 'category filter)))
- (evt-filter (cadr (assq '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 (not (string-match "\\`DONE\\|CANCELLED" evt)))
- (setq tod (concat "00" (number-to-string tod)))
- (setq tod (when (string-match
- "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod)
- (concat (match-string 1 tod) ":"
- (match-string 2 tod))))
- (when (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-today-p (date)
- "Non-nil when DATE means today.
- DATE is either a list of the form (month day year) or a number of
- days as returned by `calendar-absolute-from-gregorian' or
- `org-today'. This function considers `org-extend-today-until'
- when defining today."
- (eq (org-today)
- (if (consp date) (calendar-absolute-from-gregorian date) date)))
- (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* ((org-use-effective-time t)
- (hour (nth 2 (decode-time (org-current-time))))
- (org-extend-today-until (1+ hour)))
- (org-agenda-todo arg)))
- (defun org-agenda-ctrl-c-ctrl-c ()
- "Set tags in agenda buffer."
- (interactive)
- (org-agenda-set-tags))
- (provide 'org-agenda)
- ;;; org-agenda.el ends here
|