erc.el 217 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884388538863887388838893890389138923893389438953896389738983899390039013902390339043905390639073908390939103911391239133914391539163917391839193920392139223923392439253926392739283929393039313932393339343935393639373938393939403941394239433944394539463947394839493950395139523953395439553956395739583959396039613962396339643965396639673968396939703971397239733974397539763977397839793980398139823983398439853986398739883989399039913992399339943995399639973998399940004001400240034004400540064007400840094010401140124013401440154016401740184019402040214022402340244025402640274028402940304031403240334034403540364037403840394040404140424043404440454046404740484049405040514052405340544055405640574058405940604061406240634064406540664067406840694070407140724073407440754076407740784079408040814082408340844085408640874088408940904091409240934094409540964097409840994100410141024103410441054106410741084109411041114112411341144115411641174118411941204121412241234124412541264127412841294130413141324133413441354136413741384139414041414142414341444145414641474148414941504151415241534154415541564157415841594160416141624163416441654166416741684169417041714172417341744175417641774178417941804181418241834184418541864187418841894190419141924193419441954196419741984199420042014202420342044205420642074208420942104211421242134214421542164217421842194220422142224223422442254226422742284229423042314232423342344235423642374238423942404241424242434244424542464247424842494250425142524253425442554256425742584259426042614262426342644265426642674268426942704271427242734274427542764277427842794280428142824283428442854286428742884289429042914292429342944295429642974298429943004301430243034304430543064307430843094310431143124313431443154316431743184319432043214322432343244325432643274328432943304331433243334334433543364337433843394340434143424343434443454346434743484349435043514352435343544355435643574358435943604361436243634364436543664367436843694370437143724373437443754376437743784379438043814382438343844385438643874388438943904391439243934394439543964397439843994400440144024403440444054406440744084409441044114412441344144415441644174418441944204421442244234424442544264427442844294430443144324433443444354436443744384439444044414442444344444445444644474448444944504451445244534454445544564457445844594460446144624463446444654466446744684469447044714472447344744475447644774478447944804481448244834484448544864487448844894490449144924493449444954496449744984499450045014502450345044505450645074508450945104511451245134514451545164517451845194520452145224523452445254526452745284529453045314532453345344535453645374538453945404541454245434544454545464547454845494550455145524553455445554556455745584559456045614562456345644565456645674568456945704571457245734574457545764577457845794580458145824583458445854586458745884589459045914592459345944595459645974598459946004601460246034604460546064607460846094610461146124613461446154616461746184619462046214622462346244625462646274628462946304631463246334634463546364637463846394640464146424643464446454646464746484649465046514652465346544655465646574658465946604661466246634664466546664667466846694670467146724673467446754676467746784679468046814682468346844685468646874688468946904691469246934694469546964697469846994700470147024703470447054706470747084709471047114712471347144715471647174718471947204721472247234724472547264727472847294730473147324733473447354736473747384739474047414742474347444745474647474748474947504751475247534754475547564757475847594760476147624763476447654766476747684769477047714772477347744775477647774778477947804781478247834784478547864787478847894790479147924793479447954796479747984799480048014802480348044805480648074808480948104811481248134814481548164817481848194820482148224823482448254826482748284829483048314832483348344835483648374838483948404841484248434844484548464847484848494850485148524853485448554856485748584859486048614862486348644865486648674868486948704871487248734874487548764877487848794880488148824883488448854886488748884889489048914892489348944895489648974898489949004901490249034904490549064907490849094910491149124913491449154916491749184919492049214922492349244925492649274928492949304931493249334934493549364937493849394940494149424943494449454946494749484949495049514952495349544955495649574958495949604961496249634964496549664967496849694970497149724973497449754976497749784979498049814982498349844985498649874988498949904991499249934994499549964997499849995000500150025003500450055006500750085009501050115012501350145015501650175018501950205021502250235024502550265027502850295030503150325033503450355036503750385039504050415042504350445045504650475048504950505051505250535054505550565057505850595060506150625063506450655066506750685069507050715072507350745075507650775078507950805081508250835084508550865087508850895090509150925093509450955096509750985099510051015102510351045105510651075108510951105111511251135114511551165117511851195120512151225123512451255126512751285129513051315132513351345135513651375138513951405141514251435144514551465147514851495150515151525153515451555156515751585159516051615162516351645165516651675168516951705171517251735174517551765177517851795180518151825183518451855186518751885189519051915192519351945195519651975198519952005201520252035204520552065207520852095210521152125213521452155216521752185219522052215222522352245225522652275228522952305231523252335234523552365237523852395240524152425243524452455246524752485249525052515252525352545255525652575258525952605261526252635264526552665267526852695270527152725273527452755276527752785279528052815282528352845285528652875288528952905291529252935294529552965297529852995300530153025303530453055306530753085309531053115312531353145315531653175318531953205321532253235324532553265327532853295330533153325333533453355336533753385339534053415342534353445345534653475348534953505351535253535354535553565357535853595360536153625363536453655366536753685369537053715372537353745375537653775378537953805381538253835384538553865387538853895390539153925393539453955396539753985399540054015402540354045405540654075408540954105411541254135414541554165417541854195420542154225423542454255426542754285429543054315432543354345435543654375438543954405441544254435444544554465447544854495450545154525453545454555456545754585459546054615462546354645465546654675468546954705471547254735474547554765477547854795480548154825483548454855486548754885489549054915492549354945495549654975498549955005501550255035504550555065507550855095510551155125513551455155516551755185519552055215522552355245525552655275528552955305531553255335534553555365537553855395540554155425543554455455546554755485549555055515552555355545555555655575558555955605561556255635564556555665567556855695570557155725573557455755576557755785579558055815582558355845585558655875588558955905591559255935594559555965597559855995600560156025603560456055606560756085609561056115612561356145615561656175618561956205621562256235624562556265627562856295630563156325633563456355636563756385639564056415642564356445645564656475648564956505651565256535654565556565657565856595660566156625663566456655666566756685669567056715672567356745675567656775678567956805681568256835684568556865687568856895690569156925693569456955696569756985699570057015702570357045705570657075708570957105711571257135714571557165717571857195720572157225723572457255726572757285729573057315732573357345735573657375738573957405741574257435744574557465747574857495750575157525753575457555756575757585759576057615762576357645765576657675768576957705771577257735774577557765777577857795780578157825783578457855786578757885789579057915792579357945795579657975798579958005801580258035804580558065807580858095810581158125813581458155816581758185819582058215822582358245825582658275828582958305831583258335834583558365837583858395840584158425843584458455846584758485849585058515852585358545855585658575858585958605861586258635864586558665867586858695870587158725873587458755876587758785879588058815882588358845885588658875888588958905891589258935894589558965897589858995900590159025903590459055906590759085909591059115912591359145915591659175918591959205921592259235924592559265927592859295930593159325933593459355936593759385939594059415942594359445945594659475948594959505951595259535954595559565957595859595960596159625963596459655966596759685969597059715972597359745975597659775978597959805981598259835984598559865987598859895990599159925993599459955996599759985999600060016002600360046005600660076008600960106011601260136014601560166017601860196020602160226023602460256026602760286029603060316032603360346035603660376038603960406041604260436044604560466047604860496050605160526053605460556056605760586059606060616062606360646065606660676068606960706071607260736074607560766077607860796080608160826083608460856086608760886089609060916092609360946095609660976098609961006101610261036104610561066107610861096110611161126113611461156116611761186119612061216122612361246125612661276128612961306131613261336134613561366137613861396140614161426143614461456146614761486149615061516152615361546155615661576158615961606161616261636164616561666167616861696170617161726173617461756176617761786179618061816182618361846185618661876188618961906191619261936194619561966197619861996200620162026203620462056206620762086209621062116212621362146215621662176218621962206221622262236224622562266227622862296230623162326233623462356236623762386239624062416242624362446245624662476248624962506251625262536254625562566257625862596260626162626263626462656266626762686269627062716272627362746275627662776278627962806281628262836284628562866287628862896290629162926293629462956296629762986299630063016302630363046305630663076308630963106311631263136314631563166317631863196320632163226323632463256326632763286329633063316332633363346335633663376338633963406341634263436344634563466347634863496350635163526353635463556356635763586359636063616362636363646365636663676368636963706371637263736374637563766377637863796380638163826383638463856386638763886389639063916392639363946395639663976398639964006401640264036404640564066407640864096410641164126413641464156416641764186419642064216422642364246425642664276428642964306431643264336434643564366437643864396440644164426443644464456446644764486449645064516452645364546455645664576458645964606461646264636464646564666467646864696470647164726473647464756476647764786479648064816482648364846485648664876488648964906491649264936494649564966497649864996500650165026503650465056506
  1. ;; erc.el --- An Emacs Internet Relay Chat client
  2. ;; Copyright (C) 1997-2012 Free Software Foundation, Inc.
  3. ;; Author: Alexander L. Belikoff (alexander@belikoff.net)
  4. ;; Contributors: Sergey Berezin (sergey.berezin@cs.cmu.edu),
  5. ;; Mario Lang (mlang@delysid.org),
  6. ;; Alex Schroeder (alex@gnu.org)
  7. ;; Andreas Fuchs (afs@void.at)
  8. ;; Gergely Nagy (algernon@midgard.debian.net)
  9. ;; David Edmondson (dme@dme.org)
  10. ;; Maintainer: Michael Olson (mwolson@gnu.org)
  11. ;; Keywords: IRC, chat, client, Internet
  12. ;; Version: 5.3
  13. ;; This file is part of GNU Emacs.
  14. ;; GNU Emacs is free software: you can redistribute it and/or modify
  15. ;; it under the terms of the GNU General Public License as published by
  16. ;; the Free Software Foundation, either version 3 of the License, or
  17. ;; (at your option) any later version.
  18. ;; GNU Emacs is distributed in the hope that it will be useful,
  19. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. ;; GNU General Public License for more details.
  22. ;; You should have received a copy of the GNU General Public License
  23. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  24. ;;; Commentary:
  25. ;; ERC is a powerful, modular, and extensible IRC client for Emacs.
  26. ;; For more information, see the following URLs:
  27. ;; * http://sv.gnu.org/projects/erc/
  28. ;; * http://www.emacswiki.org/cgi-bin/wiki/ERC
  29. ;; As of 2006-06-13, ERC development is now hosted on Savannah
  30. ;; (http://sv.gnu.org/projects/erc). I invite everyone who wants to
  31. ;; hack on it to contact me <mwolson@gnu.org> in order to get write
  32. ;; access to the shared Arch archive.
  33. ;; Installation:
  34. ;; Put erc.el in your load-path, and put (require 'erc) in your .emacs.
  35. ;; Configuration:
  36. ;; Use M-x customize-group RET erc RET to get an overview
  37. ;; of all the variables you can tweak.
  38. ;; Usage:
  39. ;; To connect to an IRC server, do
  40. ;;
  41. ;; M-x erc RET
  42. ;;
  43. ;; After you are connected to a server, you can use C-h m or have a look at
  44. ;; the ERC menu.
  45. ;;; History:
  46. ;;
  47. ;;; Code:
  48. (defconst erc-version-string "Version 5.3"
  49. "ERC version. This is used by function `erc-version'.")
  50. (eval-when-compile (require 'cl))
  51. (require 'font-lock)
  52. (require 'pp)
  53. (require 'thingatpt)
  54. (require 'erc-compat)
  55. (defvar erc-official-location
  56. "http://emacswiki.org/cgi-bin/wiki/ERC (mailing list: erc-discuss@gnu.org)"
  57. "Location of the ERC client on the Internet.")
  58. (defgroup erc nil
  59. "Emacs Internet Relay Chat client."
  60. :link '(url-link "http://www.emacswiki.org/cgi-bin/wiki/ERC")
  61. :prefix "erc-"
  62. :group 'applications)
  63. (defgroup erc-buffers nil
  64. "Creating new ERC buffers"
  65. :group 'erc)
  66. (defgroup erc-display nil
  67. "Settings for how various things are displayed"
  68. :group 'erc)
  69. (defgroup erc-mode-line-and-header nil
  70. "Displaying information in the mode-line and header"
  71. :group 'erc-display)
  72. (defgroup erc-ignore nil
  73. "Ignoring certain messages"
  74. :group 'erc)
  75. (defgroup erc-query nil
  76. "Using separate buffers for private discussions"
  77. :group 'erc)
  78. (defgroup erc-quit-and-part nil
  79. "Quitting and parting channels"
  80. :group 'erc)
  81. (defgroup erc-paranoia nil
  82. "Know what is sent and received; control the display of sensitive data."
  83. :group 'erc)
  84. (defgroup erc-scripts nil
  85. "Running scripts at startup and with /LOAD"
  86. :group 'erc)
  87. (require 'erc-backend)
  88. ;; compatibility with older ERC releases
  89. (if (fboundp 'defvaralias)
  90. (progn
  91. (defvaralias 'erc-announced-server-name 'erc-server-announced-name)
  92. (erc-make-obsolete-variable 'erc-announced-server-name
  93. 'erc-server-announced-name
  94. "ERC 5.1")
  95. (defvaralias 'erc-process 'erc-server-process)
  96. (erc-make-obsolete-variable 'erc-process 'erc-server-process "ERC 5.1")
  97. (defvaralias 'erc-default-coding-system 'erc-server-coding-system)
  98. (erc-make-obsolete-variable 'erc-default-coding-system
  99. 'erc-server-coding-system
  100. "ERC 5.1"))
  101. (message (concat "ERC: The function `defvaralias' is not bound. See the "
  102. "NEWS file for variable name changes since ERC 5.0.4.")))
  103. (defalias 'erc-send-command 'erc-server-send)
  104. (erc-make-obsolete 'erc-send-command 'erc-server-send "ERC 5.1")
  105. ;; tunable connection and authentication parameters
  106. (defcustom erc-server nil
  107. "IRC server to use if one is not provided.
  108. See function `erc-compute-server' for more details on connection
  109. parameters and authentication."
  110. :group 'erc
  111. :type '(choice (const :tag "None" nil)
  112. (string :tag "Server")))
  113. (defcustom erc-port nil
  114. "IRC port to use if not specified.
  115. This can be either a string or a number."
  116. :group 'erc
  117. :type '(choice (const :tag "None" nil)
  118. (integer :tag "Port number")
  119. (string :tag "Port string")))
  120. (defcustom erc-nick nil
  121. "Nickname to use if one is not provided.
  122. This can be either a string, or a list of strings.
  123. In the latter case, if the first nick in the list is already in use,
  124. other nicks are tried in the list order.
  125. See function `erc-compute-nick' for more details on connection
  126. parameters and authentication."
  127. :group 'erc
  128. :type '(choice (const :tag "None" nil)
  129. (string :tag "Nickname")
  130. (repeat (string :tag "Nickname"))))
  131. (defcustom erc-nick-uniquifier "`"
  132. "The string to append to the nick if it is already in use."
  133. :group 'erc
  134. :type 'string)
  135. (defcustom erc-try-new-nick-p t
  136. "If the nickname you chose isn't available, and this option is non-nil,
  137. ERC should automatically attempt to connect with another nickname.
  138. You can manually set another nickname with the /NICK command."
  139. :group 'erc
  140. :type 'boolean)
  141. (defcustom erc-user-full-name nil
  142. "User full name.
  143. This can be either a string or a function to call.
  144. See function `erc-compute-full-name' for more details on connection
  145. parameters and authentication."
  146. :group 'erc
  147. :type '(choice (const :tag "No name" nil)
  148. (string :tag "Name")
  149. (function :tag "Get from function"))
  150. :set (lambda (sym val)
  151. (if (functionp val)
  152. (set sym (funcall val))
  153. (set sym val))))
  154. (defvar erc-password nil
  155. "Password to use when authenticating to an IRC server.
  156. It is not strictly necessary to provide this, since ERC will
  157. prompt you for it.")
  158. (defcustom erc-user-mode nil
  159. "Initial user modes to be set after a connection is established."
  160. :group 'erc
  161. :type '(choice (const nil) string function))
  162. (defcustom erc-prompt-for-password t
  163. "Asks before using the default password, or whether to enter a new one."
  164. :group 'erc
  165. :type 'boolean)
  166. (defcustom erc-warn-about-blank-lines t
  167. "Warn the user if they attempt to send a blank line."
  168. :group 'erc
  169. :type 'boolean)
  170. (defcustom erc-send-whitespace-lines nil
  171. "If set to non-nil, send lines consisting of only whitespace."
  172. :group 'erc
  173. :type 'boolean)
  174. (defcustom erc-hide-prompt nil
  175. "If non-nil, do not display the prompt for commands.
  176. \(A command is any input starting with a '/').
  177. See also the variables `erc-prompt' and `erc-command-indicator'."
  178. :group 'erc-display
  179. :type 'boolean)
  180. ;; tunable GUI stuff
  181. (defcustom erc-show-my-nick t
  182. "If non-nil, display one's own nickname when sending a message.
  183. If non-nil, \"<nickname>\" will be shown.
  184. If nil, only \"> \" will be shown."
  185. :group 'erc-display
  186. :type 'boolean)
  187. (define-widget 'erc-message-type 'set
  188. "A set of standard IRC Message types."
  189. :args '((const "JOIN")
  190. (const "KICK")
  191. (const "NICK")
  192. (const "PART")
  193. (const "QUIT")
  194. (const "MODE")
  195. (repeat :inline t :tag "Others" (string :tag "IRC Message Type"))))
  196. (defcustom erc-hide-list nil
  197. "*List of IRC type messages to hide.
  198. A typical value would be '(\"JOIN\" \"PART\" \"QUIT\")."
  199. :group 'erc-ignore
  200. :type 'erc-message-type)
  201. (defvar erc-session-password nil
  202. "The password used for the current session.")
  203. (make-variable-buffer-local 'erc-session-password)
  204. (defcustom erc-disconnected-hook nil
  205. "Run this hook with arguments (NICK IP REASON) when disconnected.
  206. This happens before automatic reconnection. Note, that
  207. `erc-server-QUIT-functions' might not be run when we disconnect,
  208. simply because we do not necessarily receive the QUIT event."
  209. :group 'erc-hooks
  210. :type 'hook)
  211. (defcustom erc-complete-functions nil
  212. "These functions get called when the user hits TAB in ERC.
  213. Each function in turn is called until one returns non-nil to
  214. indicate it has handled the input."
  215. :group 'erc-hooks
  216. :type 'hook)
  217. (defcustom erc-join-hook nil
  218. "Hook run when we join a channel. Hook functions are called
  219. without arguments, with the current buffer set to the buffer of
  220. the new channel.
  221. See also `erc-server-JOIN-functions', `erc-part-hook'."
  222. :group 'erc-hooks
  223. :type 'hook)
  224. (defcustom erc-quit-hook nil
  225. "Hook run when processing a quit command directed at our nick.
  226. The hook receives one argument, the current PROCESS.
  227. See also `erc-server-QUIT-functions' and `erc-disconnected-hook'."
  228. :group 'erc-hooks
  229. :type 'hook)
  230. (defcustom erc-part-hook nil
  231. "Hook run when processing a PART message directed at our nick.
  232. The hook receives one argument, the current BUFFER.
  233. See also `erc-server-QUIT-functions', `erc-quit-hook' and
  234. `erc-disconnected-hook'."
  235. :group 'erc-hooks
  236. :type 'hook)
  237. (defcustom erc-kick-hook nil
  238. "Hook run when processing a KICK message directed at our nick.
  239. The hook receives one argument, the current BUFFER.
  240. See also `erc-server-PART-functions' and `erc-part-hook'."
  241. :group 'erc-hooks
  242. :type 'hook)
  243. (defcustom erc-nick-changed-functions nil
  244. "List of functions run when your nick was successfully changed.
  245. Each function should accept two arguments, NEW-NICK and OLD-NICK."
  246. :group 'erc-hooks
  247. :type 'hook)
  248. (defcustom erc-connect-pre-hook '(erc-initialize-log-marker)
  249. "Hook called just before `erc' calls `erc-connect'.
  250. Functions are passed a buffer as the first argument."
  251. :group 'erc-hooks
  252. :type 'hook)
  253. (defvar erc-channel-users nil
  254. "A hash table of members in the current channel, which
  255. associates nicknames with cons cells of the form:
  256. \(USER . MEMBER-DATA) where USER is a pointer to an
  257. erc-server-user struct, and MEMBER-DATA is a pointer to an
  258. erc-channel-user struct.")
  259. (make-variable-buffer-local 'erc-channel-users)
  260. (defvar erc-server-users nil
  261. "A hash table of users on the current server, which associates
  262. nicknames with erc-server-user struct instances.")
  263. (make-variable-buffer-local 'erc-server-users)
  264. (defun erc-downcase (string)
  265. "Convert STRING to IRC standard conforming downcase."
  266. (let ((s (downcase string))
  267. (c '((?\[ . ?\{)
  268. (?\] . ?\})
  269. (?\\ . ?\|)
  270. (?~ . ?^))))
  271. (save-match-data
  272. (while (string-match "[]\\[~]" s)
  273. (aset s (match-beginning 0)
  274. (cdr (assq (aref s (match-beginning 0)) c)))))
  275. s))
  276. (defmacro erc-with-server-buffer (&rest body)
  277. "Execute BODY in the current ERC server buffer.
  278. If no server buffer exists, return nil."
  279. (let ((buffer (make-symbol "buffer")))
  280. `(let ((,buffer (erc-server-buffer)))
  281. (when (buffer-live-p ,buffer)
  282. (with-current-buffer ,buffer
  283. ,@body)))))
  284. (put 'erc-with-server-buffer 'lisp-indent-function 0)
  285. (put 'erc-with-server-buffer 'edebug-form-spec '(body))
  286. (defstruct (erc-server-user (:type vector) :named)
  287. ;; User data
  288. nickname host login full-name info
  289. ;; Buffers
  290. ;;
  291. ;; This is an alist of the form (BUFFER . CHANNEL-DATA), where
  292. ;; CHANNEL-DATA is either nil or an erc-channel-user struct.
  293. (buffers nil)
  294. )
  295. (defstruct (erc-channel-user (:type vector) :named)
  296. op voice
  297. ;; Last message time (in the form of the return value of
  298. ;; (current-time)
  299. ;;
  300. ;; This is useful for ordered name completion.
  301. (last-message-time nil))
  302. (defsubst erc-get-channel-user (nick)
  303. "Finds the (USER . CHANNEL-DATA) element corresponding to NICK
  304. in the current buffer's `erc-channel-users' hash table."
  305. (gethash (erc-downcase nick) erc-channel-users))
  306. (defsubst erc-get-server-user (nick)
  307. "Finds the USER corresponding to NICK in the current server's
  308. `erc-server-users' hash table."
  309. (erc-with-server-buffer
  310. (gethash (erc-downcase nick) erc-server-users)))
  311. (defsubst erc-add-server-user (nick user)
  312. "This function is for internal use only.
  313. Adds USER with nickname NICK to the `erc-server-users' hash table."
  314. (erc-with-server-buffer
  315. (puthash (erc-downcase nick) user erc-server-users)))
  316. (defsubst erc-remove-server-user (nick)
  317. "This function is for internal use only.
  318. Removes the user with nickname NICK from the `erc-server-users'
  319. hash table. This user is not removed from the
  320. `erc-channel-users' lists of other buffers.
  321. See also: `erc-remove-user'."
  322. (erc-with-server-buffer
  323. (remhash (erc-downcase nick) erc-server-users)))
  324. (defun erc-change-user-nickname (user new-nick)
  325. "This function is for internal use only.
  326. Changes the nickname of USER to NEW-NICK in the
  327. `erc-server-users' hash table. The `erc-channel-users' lists of
  328. other buffers are also changed."
  329. (let ((nick (erc-server-user-nickname user)))
  330. (setf (erc-server-user-nickname user) new-nick)
  331. (erc-with-server-buffer
  332. (remhash (erc-downcase nick) erc-server-users)
  333. (puthash (erc-downcase new-nick) user erc-server-users))
  334. (dolist (buf (erc-server-user-buffers user))
  335. (if (buffer-live-p buf)
  336. (with-current-buffer buf
  337. (let ((cdata (erc-get-channel-user nick)))
  338. (remhash (erc-downcase nick) erc-channel-users)
  339. (puthash (erc-downcase new-nick) cdata
  340. erc-channel-users)))))))
  341. (defun erc-remove-channel-user (nick)
  342. "This function is for internal use only.
  343. Removes the user with nickname NICK from the `erc-channel-users'
  344. list for this channel. If this user is not in the
  345. `erc-channel-users' list of any other buffers, the user is also
  346. removed from the server's `erc-server-users' list.
  347. See also: `erc-remove-server-user' and `erc-remove-user'."
  348. (let ((channel-data (erc-get-channel-user nick)))
  349. (when channel-data
  350. (let ((user (car channel-data)))
  351. (setf (erc-server-user-buffers user)
  352. (delq (current-buffer)
  353. (erc-server-user-buffers user)))
  354. (remhash (erc-downcase nick) erc-channel-users)
  355. (if (null (erc-server-user-buffers user))
  356. (erc-remove-server-user nick))))))
  357. (defun erc-remove-user (nick)
  358. "This function is for internal use only.
  359. Removes the user with nickname NICK from the `erc-server-users'
  360. list as well as from all `erc-channel-users' lists.
  361. See also: `erc-remove-server-user' and
  362. `erc-remove-channel-user'."
  363. (let ((user (erc-get-server-user nick)))
  364. (when user
  365. (let ((buffers (erc-server-user-buffers user)))
  366. (dolist (buf buffers)
  367. (if (buffer-live-p buf)
  368. (with-current-buffer buf
  369. (remhash (erc-downcase nick) erc-channel-users)
  370. (run-hooks 'erc-channel-members-changed-hook)))))
  371. (erc-remove-server-user nick))))
  372. (defun erc-remove-channel-users ()
  373. "This function is for internal use only.
  374. Removes all users in the current channel. This is called by
  375. `erc-server-PART' and `erc-server-QUIT'."
  376. (when (and erc-server-connected
  377. (erc-server-process-alive)
  378. (hash-table-p erc-channel-users))
  379. (maphash (lambda (nick cdata)
  380. (erc-remove-channel-user nick))
  381. erc-channel-users)
  382. (clrhash erc-channel-users)))
  383. (defsubst erc-channel-user-op-p (nick)
  384. "Return t if NICK is an operator in the current channel."
  385. (and nick
  386. (hash-table-p erc-channel-users)
  387. (let ((cdata (erc-get-channel-user nick)))
  388. (and cdata (cdr cdata)
  389. (erc-channel-user-op (cdr cdata))))))
  390. (defsubst erc-channel-user-voice-p (nick)
  391. "Return t if NICK has voice in the current channel."
  392. (and nick
  393. (hash-table-p erc-channel-users)
  394. (let ((cdata (erc-get-channel-user nick)))
  395. (and cdata (cdr cdata)
  396. (erc-channel-user-voice (cdr cdata))))))
  397. (defun erc-get-channel-user-list ()
  398. "Returns a list of users in the current channel. Each element
  399. of the list is of the form (USER . CHANNEL-DATA), where USER is
  400. an erc-server-user struct, and CHANNEL-DATA is either `nil' or an
  401. erc-channel-user struct.
  402. See also: `erc-sort-channel-users-by-activity'"
  403. (let (users)
  404. (if (hash-table-p erc-channel-users)
  405. (maphash (lambda (nick cdata)
  406. (setq users (cons cdata users)))
  407. erc-channel-users))
  408. users))
  409. (defun erc-get-server-nickname-list ()
  410. "Returns a list of known nicknames on the current server."
  411. (erc-with-server-buffer
  412. (let (nicks)
  413. (when (hash-table-p erc-server-users)
  414. (maphash (lambda (n user)
  415. (setq nicks
  416. (cons (erc-server-user-nickname user)
  417. nicks)))
  418. erc-server-users)
  419. nicks))))
  420. (defun erc-get-channel-nickname-list ()
  421. "Returns a list of known nicknames on the current channel."
  422. (let (nicks)
  423. (when (hash-table-p erc-channel-users)
  424. (maphash (lambda (n cdata)
  425. (setq nicks
  426. (cons (erc-server-user-nickname (car cdata))
  427. nicks)))
  428. erc-channel-users)
  429. nicks)))
  430. (defun erc-get-server-nickname-alist ()
  431. "Returns an alist of known nicknames on the current server."
  432. (erc-with-server-buffer
  433. (let (nicks)
  434. (when (hash-table-p erc-server-users)
  435. (maphash (lambda (n user)
  436. (setq nicks
  437. (cons (cons (erc-server-user-nickname user) nil)
  438. nicks)))
  439. erc-server-users)
  440. nicks))))
  441. (defun erc-get-channel-nickname-alist ()
  442. "Returns an alist of known nicknames on the current channel."
  443. (let (nicks)
  444. (when (hash-table-p erc-channel-users)
  445. (maphash (lambda (n cdata)
  446. (setq nicks
  447. (cons (cons (erc-server-user-nickname (car cdata)) nil)
  448. nicks)))
  449. erc-channel-users)
  450. nicks)))
  451. (defun erc-sort-channel-users-by-activity (list)
  452. "Sorts LIST such that users which have spoken most recently are
  453. listed first. LIST must be of the form (USER . CHANNEL-DATA).
  454. See also: `erc-get-channel-user-list'."
  455. (sort list
  456. (lambda (x y)
  457. (when (and
  458. (cdr x) (cdr y))
  459. (let ((tx (erc-channel-user-last-message-time (cdr x)))
  460. (ty (erc-channel-user-last-message-time (cdr y))))
  461. (if tx
  462. (if ty
  463. (time-less-p ty tx)
  464. t)
  465. nil))))))
  466. (defun erc-sort-channel-users-alphabetically (list)
  467. "Sort LIST so that users' nicknames are in alphabetical order.
  468. LIST must be of the form (USER . CHANNEL-DATA).
  469. See also: `erc-get-channel-user-list'."
  470. (sort list
  471. (lambda (x y)
  472. (when (and
  473. (cdr x) (cdr y))
  474. (let ((nickx (downcase (erc-server-user-nickname (car x))))
  475. (nicky (downcase (erc-server-user-nickname (car y)))))
  476. (if nickx
  477. (if nicky
  478. (string-lessp nickx nicky)
  479. t)
  480. nil))))))
  481. (defvar erc-channel-topic nil
  482. "A topic string for the channel. Should only be used in channel-buffers.")
  483. (make-variable-buffer-local 'erc-channel-topic)
  484. (defvar erc-channel-modes nil
  485. "List of strings representing channel modes.
  486. E.g. '(\"i\" \"m\" \"s\" \"b Quake!*@*\")
  487. \(not sure the ban list will be here, but why not)")
  488. (make-variable-buffer-local 'erc-channel-modes)
  489. (defvar erc-insert-marker nil
  490. "The place where insertion of new text in erc buffers should happen.")
  491. (make-variable-buffer-local 'erc-insert-marker)
  492. (defvar erc-input-marker nil
  493. "The marker where input should be inserted.")
  494. (make-variable-buffer-local 'erc-input-marker)
  495. (defun erc-string-no-properties (string)
  496. "Return a copy of STRING will all text-properties removed."
  497. (let ((newstring (copy-sequence string)))
  498. (set-text-properties 0 (length newstring) nil newstring)
  499. newstring))
  500. (defcustom erc-prompt "ERC>"
  501. "Prompt used by ERC. Trailing whitespace is not required."
  502. :group 'erc-display
  503. :type '(choice string function))
  504. (defun erc-prompt ()
  505. "Return the input prompt as a string.
  506. See also the variable `erc-prompt'."
  507. (let ((prompt (if (functionp erc-prompt)
  508. (funcall erc-prompt)
  509. erc-prompt)))
  510. (if (> (length prompt) 0)
  511. (concat prompt " ")
  512. prompt)))
  513. (defcustom erc-command-indicator nil
  514. "Indicator used by ERC for showing commands.
  515. If non-nil, this will be used in the ERC buffer to indicate
  516. commands (i.e., input starting with a '/').
  517. If nil, the prompt will be constructed from the variable `erc-prompt'."
  518. :group 'erc-display
  519. :type '(choice (const nil) string function))
  520. (defun erc-command-indicator ()
  521. "Return the command indicator prompt as a string.
  522. This only has any meaning if the variable `erc-command-indicator' is non-nil."
  523. (and erc-command-indicator
  524. (let ((prompt (if (functionp erc-command-indicator)
  525. (funcall erc-command-indicator)
  526. erc-command-indicator)))
  527. (if (> (length prompt) 0)
  528. (concat prompt " ")
  529. prompt))))
  530. (defcustom erc-notice-prefix "*** "
  531. "*Prefix for all notices."
  532. :group 'erc-display
  533. :type 'string)
  534. (defcustom erc-notice-highlight-type 'all
  535. "*Determines how to highlight notices.
  536. See `erc-notice-prefix'.
  537. The following values are allowed:
  538. 'prefix - highlight notice prefix only
  539. 'all - highlight the entire notice
  540. Any other value disables notice's highlighting altogether."
  541. :group 'erc-display
  542. :type '(choice (const :tag "highlight notice prefix only" prefix)
  543. (const :tag "highlight the entire notice" all)
  544. (const :tag "don't highlight notices at all" nil)))
  545. (defcustom erc-echo-notice-hook nil
  546. "*Specifies a list of functions to call to echo a private
  547. notice. Each function is called with four arguments, the string
  548. to display, the parsed server message, the target buffer (or
  549. nil), and the sender. The functions are called in order, until a
  550. function evaluates to non-nil. These hooks are called after
  551. those specified in `erc-echo-notice-always-hook'.
  552. See also: `erc-echo-notice-always-hook',
  553. `erc-echo-notice-in-default-buffer',
  554. `erc-echo-notice-in-target-buffer',
  555. `erc-echo-notice-in-minibuffer',
  556. `erc-echo-notice-in-server-buffer',
  557. `erc-echo-notice-in-active-non-server-buffer',
  558. `erc-echo-notice-in-active-buffer',
  559. `erc-echo-notice-in-user-buffers',
  560. `erc-echo-notice-in-user-and-target-buffers',
  561. `erc-echo-notice-in-first-user-buffer'"
  562. :group 'erc-hooks
  563. :type 'hook
  564. :options '(erc-echo-notice-in-default-buffer
  565. erc-echo-notice-in-target-buffer
  566. erc-echo-notice-in-minibuffer
  567. erc-echo-notice-in-server-buffer
  568. erc-echo-notice-in-active-non-server-buffer
  569. erc-echo-notice-in-active-buffer
  570. erc-echo-notice-in-user-buffers
  571. erc-echo-notice-in-user-and-target-buffers
  572. erc-echo-notice-in-first-user-buffer))
  573. (defcustom erc-echo-notice-always-hook
  574. '(erc-echo-notice-in-default-buffer)
  575. "*Specifies a list of functions to call to echo a private
  576. notice. Each function is called with four arguments, the string
  577. to display, the parsed server message, the target buffer (or
  578. nil), and the sender. The functions are called in order, and all
  579. functions are called. These hooks are called before those
  580. specified in `erc-echo-notice-hook'.
  581. See also: `erc-echo-notice-hook',
  582. `erc-echo-notice-in-default-buffer',
  583. `erc-echo-notice-in-target-buffer',
  584. `erc-echo-notice-in-minibuffer',
  585. `erc-echo-notice-in-server-buffer',
  586. `erc-echo-notice-in-active-non-server-buffer',
  587. `erc-echo-notice-in-active-buffer',
  588. `erc-echo-notice-in-user-buffers',
  589. `erc-echo-notice-in-user-and-target-buffers',
  590. `erc-echo-notice-in-first-user-buffer'"
  591. :group 'erc-hooks
  592. :type 'hook
  593. :options '(erc-echo-notice-in-default-buffer
  594. erc-echo-notice-in-target-buffer
  595. erc-echo-notice-in-minibuffer
  596. erc-echo-notice-in-server-buffer
  597. erc-echo-notice-in-active-non-server-buffer
  598. erc-echo-notice-in-active-buffer
  599. erc-echo-notice-in-user-buffers
  600. erc-echo-notice-in-user-and-target-buffers
  601. erc-echo-notice-in-first-user-buffer))
  602. ;; other tunable parameters
  603. (defcustom erc-whowas-on-nosuchnick nil
  604. "*If non-nil, do a whowas on a nick if no such nick."
  605. :group 'erc
  606. :type 'boolean)
  607. (defcustom erc-verbose-server-ping nil
  608. "*If non-nil, show every time you get a PING or PONG from the server."
  609. :group 'erc-paranoia
  610. :type 'boolean)
  611. (defcustom erc-public-away-p nil
  612. "*Let others know you are back when you are no longer marked away.
  613. This happens in this form:
  614. * <nick> is back (gone for <time>)
  615. Many consider it impolite to do so automatically."
  616. :group 'erc
  617. :type 'boolean)
  618. (defcustom erc-away-nickname nil
  619. "*The nickname to take when you are marked as being away."
  620. :group 'erc
  621. :type '(choice (const nil)
  622. string))
  623. (defcustom erc-paranoid nil
  624. "If non-nil, then all incoming CTCP requests will be shown."
  625. :group 'erc-paranoia
  626. :type 'boolean)
  627. (defcustom erc-disable-ctcp-replies nil
  628. "Disable replies to CTCP requests that require a reply.
  629. If non-nil, then all incoming CTCP requests that normally require
  630. an automatic reply (like VERSION or PING) will be ignored. Good to
  631. set if some hacker is trying to flood you away."
  632. :group 'erc-paranoia
  633. :type 'boolean)
  634. (defcustom erc-anonymous-login t
  635. "Be paranoid, don't give away your machine name."
  636. :group 'erc-paranoia
  637. :type 'boolean)
  638. (defcustom erc-prompt-for-channel-key nil
  639. "Prompt for channel key when using `erc-join-channel' interactively."
  640. :group 'erc
  641. :type 'boolean)
  642. (defcustom erc-email-userid "user"
  643. "Use this as your email user ID."
  644. :group 'erc
  645. :type 'string)
  646. (defcustom erc-system-name nil
  647. "Use this as the name of your system.
  648. If nil, ERC will call `system-name' to get this information."
  649. :group 'erc
  650. :type '(choice (const :tag "Default system name" nil)
  651. string))
  652. (defcustom erc-ignore-list nil
  653. "*List of regexps matching user identifiers to ignore.
  654. A user identifier has the form \"nick!login@host\". If an
  655. identifier matches, the message from the person will not be
  656. processed."
  657. :group 'erc-ignore
  658. :type '(repeat regexp))
  659. (make-variable-buffer-local 'erc-ignore-list)
  660. (defcustom erc-ignore-reply-list nil
  661. "*List of regexps matching user identifiers to ignore completely.
  662. This differs from `erc-ignore-list' in that it also ignores any
  663. messages directed at the user.
  664. A user identifier has the form \"nick!login@host\".
  665. If an identifier matches, or a message is addressed to a nick
  666. whose identifier matches, the message will not be processed.
  667. CAVEAT: ERC doesn't know about the user and host of anyone who
  668. was already in the channel when you joined, but never said
  669. anything, so it won't be able to match the user and host of those
  670. people. You can update the ERC internal info using /WHO *."
  671. :group 'erc-ignore
  672. :type '(repeat regexp))
  673. (defvar erc-flood-protect t
  674. "*If non-nil, flood protection is enabled.
  675. Flooding is sending too much information to the server in too
  676. short of an interval, which may cause the server to terminate the
  677. connection.
  678. See `erc-server-flood-margin' for other flood-related parameters.")
  679. ;; Script parameters
  680. (defcustom erc-startup-file-list
  681. (list (concat erc-user-emacs-directory ".ercrc.el")
  682. (concat erc-user-emacs-directory ".ercrc")
  683. "~/.ercrc.el" "~/.ercrc" ".ercrc.el" ".ercrc")
  684. "List of files to try for a startup script.
  685. The first existent and readable one will get executed.
  686. If the filename ends with `.el' it is presumed to be an Emacs Lisp
  687. script and it gets (load)ed. Otherwise it is treated as a bunch of
  688. regular IRC commands."
  689. :group 'erc-scripts
  690. :type '(repeat file))
  691. (defcustom erc-script-path nil
  692. "List of directories to look for a script in /load command.
  693. The script is first searched in the current directory, then in each
  694. directory in the list."
  695. :group 'erc-scripts
  696. :type '(repeat directory))
  697. (defcustom erc-script-echo t
  698. "*If non-nil, echo the IRC script commands locally."
  699. :group 'erc-scripts
  700. :type 'boolean)
  701. (defvar erc-last-saved-position nil
  702. "A marker containing the position the current buffer was last saved at.")
  703. (make-variable-buffer-local 'erc-last-saved-position)
  704. (defcustom erc-kill-buffer-on-part nil
  705. "Kill the channel buffer on PART.
  706. This variable should probably stay nil, as ERC can reuse buffers if
  707. you rejoin them later."
  708. :group 'erc-quit-and-part
  709. :type 'boolean)
  710. (defcustom erc-kill-queries-on-quit nil
  711. "Kill all query (also channel) buffers of this server on QUIT.
  712. See the variable `erc-kill-buffer-on-part' for details."
  713. :group 'erc-quit-and-part
  714. :type 'boolean)
  715. (defcustom erc-kill-server-buffer-on-quit nil
  716. "Kill the server buffer of the process on QUIT."
  717. :group 'erc-quit-and-part
  718. :type 'boolean)
  719. (defcustom erc-quit-reason-various-alist nil
  720. "Alist of possible arguments to the /quit command.
  721. Each element has the form:
  722. (REGEXP RESULT)
  723. If REGEXP matches the argument to /quit, then its relevant RESULT
  724. will be used. RESULT may be either a string, or a function. If
  725. a function, it should return the quit message as a string.
  726. If no elements match, then the empty string is used.
  727. As an example:
  728. (setq erc-quit-reason-various-alist
  729. '((\"zippy\" erc-quit-reason-zippy)
  730. (\"xmms\" dme:now-playing)
  731. (\"version\" erc-quit-reason-normal)
  732. (\"home\" \"Gone home !\")
  733. (\"^$\" \"Default Reason\")))
  734. If the user types \"/quit zippy\", then a Zippy the Pinhead quotation
  735. will be used as the quit message."
  736. :group 'erc-quit-and-part
  737. :type '(repeat (list regexp (choice (string) (function)))))
  738. (defcustom erc-part-reason-various-alist nil
  739. "Alist of possible arguments to the /part command.
  740. Each element has the form:
  741. (REGEXP RESULT)
  742. If REGEXP matches the argument to /part, then its relevant RESULT
  743. will be used. RESULT may be either a string, or a function. If
  744. a function, it should return the part message as a string.
  745. If no elements match, then the empty string is used.
  746. As an example:
  747. (setq erc-part-reason-various-alist
  748. '((\"zippy\" erc-part-reason-zippy)
  749. (\"xmms\" dme:now-playing)
  750. (\"version\" erc-part-reason-normal)
  751. (\"home\" \"Gone home !\")
  752. (\"^$\" \"Default Reason\")))
  753. If the user types \"/part zippy\", then a Zippy the Pinhead quotation
  754. will be used as the part message."
  755. :group 'erc-quit-and-part
  756. :type '(repeat (list regexp (choice (string) (function)))))
  757. (defcustom erc-quit-reason 'erc-quit-reason-normal
  758. "*A function which returns the reason for quitting.
  759. The function is passed a single argument, the string typed by the
  760. user after \"/quit\"."
  761. :group 'erc-quit-and-part
  762. :type '(choice (const erc-quit-reason-normal)
  763. (const erc-quit-reason-zippy)
  764. (const erc-quit-reason-various)
  765. (symbol)))
  766. (defcustom erc-part-reason 'erc-part-reason-normal
  767. "A function which returns the reason for parting a channel.
  768. The function is passed a single argument, the string typed by the
  769. user after \"/PART\"."
  770. :group 'erc-quit-and-part
  771. :type '(choice (const erc-part-reason-normal)
  772. (const erc-part-reason-zippy)
  773. (const erc-part-reason-various)
  774. (symbol)))
  775. (defvar erc-grab-buffer-name "*erc-grab*"
  776. "The name of the buffer created by `erc-grab-region'.")
  777. ;; variables available for IRC scripts
  778. (defvar erc-user-information "ERC User"
  779. "USER_INFORMATION IRC variable.")
  780. ;; Hooks
  781. (defgroup erc-hooks nil
  782. "Hook variables for fancy customizations of ERC."
  783. :group 'erc)
  784. (defcustom erc-mode-hook nil
  785. "Hook run after `erc-mode' setup is finished."
  786. :group 'erc-hooks
  787. :type 'hook
  788. :options '(erc-add-scroll-to-bottom))
  789. (defcustom erc-timer-hook nil
  790. "Put functions which should get called more or less periodically here.
  791. The idea is that servers always play ping pong with the client, and so there
  792. is no need for any idle-timer games with Emacs."
  793. :group 'erc-hooks
  794. :type 'hook)
  795. (defcustom erc-insert-pre-hook nil
  796. "Hook called first when some text is inserted through `erc-display-line'.
  797. It gets called with one argument, STRING.
  798. To be able to modify the inserted text, use `erc-insert-modify-hook' instead.
  799. Filtering functions can set `erc-insert-this' to nil to avoid
  800. display of that particular string at all."
  801. :group 'erc-hooks
  802. :type 'hook)
  803. (defcustom erc-send-pre-hook nil
  804. "Hook called first when some text is sent through `erc-send-current-line'.
  805. It gets called with one argument, STRING.
  806. To change the text that will be sent, set the variable STR which is
  807. used in `erc-send-current-line'.
  808. To change the text inserted into the buffer without changing the text
  809. that will be sent, use `erc-send-modify-hook' instead.
  810. Filtering functions can set `erc-send-this' to nil to avoid sending of
  811. that particular string at all and `erc-insert-this' to prevent
  812. inserting that particular string into the buffer.
  813. Note that it's useless to set `erc-send-this' to nil and
  814. `erc-insert-this' to t. ERC is sane enough to not insert the text
  815. anyway."
  816. :group 'erc-hooks
  817. :type 'hook)
  818. (defvar erc-insert-this t
  819. "Insert the text into the target buffer or not.
  820. Functions on `erc-insert-pre-hook' can set this variable to nil
  821. if they wish to avoid insertion of a particular string.")
  822. (defvar erc-send-this t
  823. "Send the text to the target or not.
  824. Functions on `erc-send-pre-hook' can set this variable to nil
  825. if they wish to avoid sending of a particular string.")
  826. (defcustom erc-insert-modify-hook ()
  827. "Insertion hook for functions that will change the text's appearance.
  828. This hook is called just after `erc-insert-pre-hook' when the value
  829. of `erc-insert-this' is t.
  830. While this hook is run, narrowing is in effect and `current-buffer' is
  831. the buffer where the text got inserted. One possible value to add here
  832. is `erc-fill'."
  833. :group 'erc-hooks
  834. :type 'hook)
  835. (defcustom erc-insert-post-hook nil
  836. "This hook is called just after `erc-insert-modify-hook'.
  837. At this point, all modifications from prior hook functions are done."
  838. :group 'erc-hooks
  839. :type 'hook
  840. :options '(erc-truncate-buffer
  841. erc-make-read-only
  842. erc-save-buffer-in-logs))
  843. (defcustom erc-send-modify-hook nil
  844. "Sending hook for functions that will change the text's appearance.
  845. This hook is called just after `erc-send-pre-hook' when the values
  846. of `erc-send-this' and `erc-insert-this' are both t.
  847. While this hook is run, narrowing is in effect and `current-buffer' is
  848. the buffer where the text got inserted.
  849. Note that no function in this hook can change the appearance of the
  850. text that is sent. Only changing the sent text's appearance on the
  851. sending user's screen is possible. One possible value to add here
  852. is `erc-fill'."
  853. :group 'erc-hooks
  854. :type 'hook)
  855. (defcustom erc-send-post-hook nil
  856. "This hook is called just after `erc-send-modify-hook'.
  857. At this point, all modifications from prior hook functions are done.
  858. NOTE: The functions on this hook are called _before_ sending a command
  859. to the server.
  860. This function is called with narrowing, ala `erc-send-modify-hook'."
  861. :group 'erc-hooks
  862. :type 'hook
  863. :options '(erc-make-read-only))
  864. (defcustom erc-send-completed-hook
  865. (when (featurep 'emacspeak)
  866. (list (byte-compile
  867. (lambda (str)
  868. (emacspeak-auditory-icon 'select-object)))))
  869. "Hook called after a message has been parsed by ERC.
  870. The single argument to the functions is the unmodified string
  871. which the local user typed."
  872. :group 'erc-hooks
  873. :type 'hook)
  874. ;; mode-specific tables
  875. (defvar erc-mode-syntax-table
  876. (let ((syntax-table (make-syntax-table)))
  877. (modify-syntax-entry ?\" ". " syntax-table)
  878. (modify-syntax-entry ?\\ ". " syntax-table)
  879. (modify-syntax-entry ?' "w " syntax-table)
  880. ;; Make dabbrev-expand useful for nick names
  881. (modify-syntax-entry ?< "." syntax-table)
  882. (modify-syntax-entry ?> "." syntax-table)
  883. syntax-table)
  884. "Syntax table used while in ERC mode.")
  885. (defvar erc-mode-abbrev-table nil
  886. "Abbrev table used while in ERC mode.")
  887. (define-abbrev-table 'erc-mode-abbrev-table ())
  888. (defvar erc-mode-map
  889. (let ((map (make-sparse-keymap)))
  890. (define-key map "\C-m" 'erc-send-current-line)
  891. (define-key map "\C-a" 'erc-bol)
  892. (define-key map [home] 'erc-bol)
  893. (define-key map "\C-c\C-a" 'erc-bol)
  894. (define-key map "\C-c\C-b" 'erc-iswitchb)
  895. (define-key map "\C-c\C-c" 'erc-toggle-interpret-controls)
  896. (define-key map "\C-c\C-d" 'erc-input-action)
  897. (define-key map "\C-c\C-e" 'erc-toggle-ctcp-autoresponse)
  898. (define-key map "\C-c\C-f" 'erc-toggle-flood-control)
  899. (define-key map "\C-c\C-i" 'erc-invite-only-mode)
  900. (define-key map "\C-c\C-j" 'erc-join-channel)
  901. (define-key map "\C-c\C-n" 'erc-channel-names)
  902. (define-key map "\C-c\C-o" 'erc-get-channel-mode-from-keypress)
  903. (define-key map "\C-c\C-p" 'erc-part-from-channel)
  904. (define-key map "\C-c\C-q" 'erc-quit-server)
  905. (define-key map "\C-c\C-r" 'erc-remove-text-properties-region)
  906. (define-key map "\C-c\C-t" 'erc-set-topic)
  907. (define-key map "\C-c\C-u" 'erc-kill-input)
  908. (define-key map "\C-c\C-x" 'erc-quit-server)
  909. (define-key map "\M-\t" 'ispell-complete-word)
  910. (define-key map "\t" 'completion-at-point)
  911. ;; Suppress `font-lock-fontify-block' key binding since it
  912. ;; destroys face properties.
  913. (if (fboundp 'command-remapping)
  914. (define-key map [remap font-lock-fontify-block] 'undefined)
  915. (substitute-key-definition
  916. 'font-lock-fontify-block 'undefined map global-map))
  917. map)
  918. "ERC keymap.")
  919. ;; Faces
  920. ; Honestly, I have a horrible sense of color and the "defaults" below
  921. ; are supposed to be really bad. But colors ARE required in IRC to
  922. ; convey different parts of conversation. If you think you know better
  923. ; defaults - send them to me.
  924. ;; Now colors are a bit nicer, at least to my eyes.
  925. ;; You may still want to change them to better fit your background.-- S.B.
  926. (defgroup erc-faces nil
  927. "Faces for ERC."
  928. :group 'erc)
  929. (defface erc-default-face '((t))
  930. "ERC default face."
  931. :group 'erc-faces)
  932. (defface erc-direct-msg-face '((t (:foreground "IndianRed")))
  933. "ERC face used for messages you receive in the main erc buffer."
  934. :group 'erc-faces)
  935. (defface erc-header-line
  936. '((t (:foreground "grey20" :background "grey90")))
  937. "ERC face used for the header line.
  938. This will only be used if `erc-header-line-face-method' is non-nil."
  939. :group 'erc-faces)
  940. (defface erc-input-face '((t (:foreground "brown")))
  941. "ERC face used for your input."
  942. :group 'erc-faces)
  943. (defface erc-prompt-face
  944. '((t (:bold t :foreground "Black" :background "lightBlue2")))
  945. "ERC face for the prompt."
  946. :group 'erc-faces)
  947. (defface erc-command-indicator-face
  948. '((t (:bold t)))
  949. "ERC face for the command indicator.
  950. See the variable `erc-command-indicator'."
  951. :group 'erc-faces)
  952. (defface erc-notice-face
  953. (if (or (featurep 'xemacs)
  954. (< emacs-major-version 22))
  955. '((t (:bold t :foreground "blue")))
  956. '((((class color) (min-colors 88))
  957. (:bold t :foreground "SlateBlue"))
  958. (t (:bold t :foreground "blue"))))
  959. "ERC face for notices."
  960. :group 'erc-faces)
  961. (defface erc-action-face '((t (:bold t)))
  962. "ERC face for actions generated by /ME."
  963. :group 'erc-faces)
  964. (defface erc-error-face '((t (:foreground "red")))
  965. "ERC face for errors."
  966. :group 'erc-faces)
  967. ;; same default color as `erc-input-face'
  968. (defface erc-my-nick-face '((t (:bold t :foreground "brown")))
  969. "ERC face for your current nickname in messages sent by you.
  970. See also `erc-show-my-nick'."
  971. :group 'erc-faces)
  972. (defface erc-nick-default-face '((t (:bold t)))
  973. "ERC nickname default face."
  974. :group 'erc-faces)
  975. (defface erc-nick-msg-face '((t (:bold t :foreground "IndianRed")))
  976. "ERC nickname face for private messages."
  977. :group 'erc-faces)
  978. ;; Debugging support
  979. (defvar erc-log-p nil
  980. "When set to t, generate debug messages in a separate debug buffer.")
  981. (defvar erc-debug-log-file (expand-file-name "ERC.debug")
  982. "Debug log file name.")
  983. (defvar erc-dbuf nil)
  984. (make-variable-buffer-local 'erc-dbuf)
  985. (defmacro define-erc-module (name alias doc enable-body disable-body
  986. &optional local-p)
  987. "Define a new minor mode using ERC conventions.
  988. Symbol NAME is the name of the module.
  989. Symbol ALIAS is the alias to use, or nil.
  990. DOC is the documentation string to use for the minor mode.
  991. ENABLE-BODY is a list of expressions used to enable the mode.
  992. DISABLE-BODY is a list of expressions used to disable the mode.
  993. If LOCAL-P is non-nil, the mode will be created as a buffer-local
  994. mode, rather than a global one.
  995. This will define a minor mode called erc-NAME-mode, possibly
  996. an alias erc-ALIAS-mode, as well as the helper functions
  997. erc-NAME-enable, and erc-NAME-disable.
  998. Example:
  999. ;;;###autoload (autoload 'erc-replace-mode \"erc-replace\")
  1000. (define-erc-module replace nil
  1001. \"This mode replaces incoming text according to `erc-replace-alist'.\"
  1002. ((add-hook 'erc-insert-modify-hook
  1003. 'erc-replace-insert))
  1004. ((remove-hook 'erc-insert-modify-hook
  1005. 'erc-replace-insert)))"
  1006. (let* ((sn (symbol-name name))
  1007. (mode (intern (format "erc-%s-mode" (downcase sn))))
  1008. (group (intern (format "erc-%s" (downcase sn))))
  1009. (enable (intern (format "erc-%s-enable" (downcase sn))))
  1010. (disable (intern (format "erc-%s-disable" (downcase sn)))))
  1011. `(progn
  1012. (erc-define-minor-mode
  1013. ,mode
  1014. ,(format "Toggle ERC %S mode.
  1015. With a prefix argument ARG, enable %s if ARG is positive,
  1016. and disable it otherwise. If called from Lisp, enable the mode
  1017. if ARG is omitted or nil.
  1018. %s" name name doc)
  1019. nil nil nil
  1020. :global ,(not local-p) :group (quote ,group)
  1021. (if ,mode
  1022. (,enable)
  1023. (,disable)))
  1024. (defun ,enable ()
  1025. ,(format "Enable ERC %S mode."
  1026. name)
  1027. (interactive)
  1028. (add-to-list 'erc-modules (quote ,name))
  1029. (setq ,mode t)
  1030. ,@enable-body)
  1031. (defun ,disable ()
  1032. ,(format "Disable ERC %S mode."
  1033. name)
  1034. (interactive)
  1035. (setq erc-modules (delq (quote ,name) erc-modules))
  1036. (setq ,mode nil)
  1037. ,@disable-body)
  1038. ,(when (and alias (not (eq name alias)))
  1039. `(defalias
  1040. (quote
  1041. ,(intern
  1042. (format "erc-%s-mode"
  1043. (downcase (symbol-name alias)))))
  1044. (quote
  1045. ,mode)))
  1046. ;; For find-function and find-variable.
  1047. (put ',mode 'definition-name ',name)
  1048. (put ',enable 'definition-name ',name)
  1049. (put ',disable 'definition-name ',name))))
  1050. (put 'define-erc-module 'doc-string-elt 3)
  1051. (defun erc-once-with-server-event (event &rest forms)
  1052. "Execute FORMS the next time EVENT occurs in the `current-buffer'.
  1053. You should make sure that `current-buffer' is a server buffer.
  1054. This function temporarily adds a function to EVENT's hook to
  1055. execute FORMS. After FORMS are run, the function is removed from
  1056. EVENT's hook. The last expression of FORMS should be either nil
  1057. or t, where nil indicates that the other functions on EVENT's hook
  1058. should be run too, and t indicates that other functions should
  1059. not be run.
  1060. Please be sure to use this function in server-buffers. In
  1061. channel-buffers it may not work at all, as it uses the LOCAL
  1062. argument of `add-hook' and `remove-hook' to ensure multiserver
  1063. capabilities."
  1064. (unless (erc-server-buffer-p)
  1065. (error
  1066. "You should only run `erc-once-with-server-event' in a server buffer"))
  1067. (let ((fun (make-symbol "fun"))
  1068. (hook (erc-get-hook event)))
  1069. (put fun 'erc-original-buffer (current-buffer))
  1070. (fset fun `(lambda (proc parsed)
  1071. (with-current-buffer (get ',fun 'erc-original-buffer)
  1072. (remove-hook ',hook ',fun t))
  1073. (fmakunbound ',fun)
  1074. ,@forms))
  1075. (add-hook hook fun nil t)
  1076. fun))
  1077. (defun erc-once-with-server-event-global (event &rest forms)
  1078. "Execute FORMS the next time EVENT occurs in any server buffer.
  1079. This function temporarily prepends a function to EVENT's hook to
  1080. execute FORMS. After FORMS are run, the function is removed from
  1081. EVENT's hook. The last expression of FORMS should be either nil
  1082. or t, where nil indicates that the other functions on EVENT's hook
  1083. should be run too, and t indicates that other functions should
  1084. not be run.
  1085. When FORMS execute, the current buffer is the server buffer associated with the
  1086. connection over which the data was received that triggered EVENT."
  1087. (let ((fun (make-symbol "fun"))
  1088. (hook (erc-get-hook event)))
  1089. (fset fun `(lambda (proc parsed)
  1090. (remove-hook ',hook ',fun)
  1091. (fmakunbound ',fun)
  1092. ,@forms))
  1093. (add-hook hook fun nil nil)
  1094. fun))
  1095. (defmacro erc-log (string)
  1096. "Logs STRING if logging is on (see `erc-log-p')."
  1097. `(when erc-log-p
  1098. (erc-log-aux ,string)))
  1099. (defun erc-server-buffer ()
  1100. "Return the server buffer for the current buffer's process.
  1101. The buffer-local variable `erc-server-process' is used to find
  1102. the process buffer."
  1103. (and (erc-server-buffer-live-p)
  1104. (process-buffer erc-server-process)))
  1105. (defun erc-server-buffer-live-p ()
  1106. "Return t if the server buffer has not been killed."
  1107. (and (processp erc-server-process)
  1108. (buffer-live-p (process-buffer erc-server-process))))
  1109. (defun erc-server-buffer-p (&optional buffer)
  1110. "Return non-nil if argument BUFFER is an ERC server buffer.
  1111. If BUFFER is nil, the current buffer is used."
  1112. (with-current-buffer (or buffer (current-buffer))
  1113. (and (eq major-mode 'erc-mode)
  1114. (null (erc-default-target)))))
  1115. (defun erc-open-server-buffer-p (&optional buffer)
  1116. "Return non-nil if argument BUFFER is an ERC server buffer that
  1117. has an open IRC process.
  1118. If BUFFER is nil, the current buffer is used."
  1119. (and (erc-server-buffer-p)
  1120. (erc-server-process-alive)))
  1121. (defun erc-query-buffer-p (&optional buffer)
  1122. "Return non-nil if BUFFER is an ERC query buffer.
  1123. If BUFFER is nil, the current buffer is used."
  1124. (with-current-buffer (or buffer (current-buffer))
  1125. (let ((target (erc-default-target)))
  1126. (and (eq major-mode 'erc-mode)
  1127. target
  1128. (not (memq (aref target 0) '(?# ?& ?+ ?!)))))))
  1129. (defun erc-ison-p (nick)
  1130. "Return non-nil if NICK is online."
  1131. (interactive "sNick: ")
  1132. (erc-with-server-buffer
  1133. (let ((erc-online-p 'unknown))
  1134. (erc-once-with-server-event
  1135. 303
  1136. `(let ((ison (split-string (aref parsed 3))))
  1137. (setq erc-online-p (car (erc-member-ignore-case ,nick ison)))
  1138. t))
  1139. (erc-server-send (format "ISON %s" nick))
  1140. (while (eq erc-online-p 'unknown) (accept-process-output))
  1141. (if (interactive-p)
  1142. (message "%s is %sonline"
  1143. (or erc-online-p nick)
  1144. (if erc-online-p "" "not "))
  1145. erc-online-p))))
  1146. (defun erc-log-aux (string)
  1147. "Do the debug logging of STRING."
  1148. (let ((cb (current-buffer))
  1149. (point 1)
  1150. (was-eob nil)
  1151. (session-buffer (erc-server-buffer)))
  1152. (if session-buffer
  1153. (progn
  1154. (set-buffer session-buffer)
  1155. (if (not (and erc-dbuf (bufferp erc-dbuf) (buffer-live-p erc-dbuf)))
  1156. (progn
  1157. (setq erc-dbuf (get-buffer-create
  1158. (concat "*ERC-DEBUG: "
  1159. erc-session-server "*")))))
  1160. (set-buffer erc-dbuf)
  1161. (setq point (point))
  1162. (setq was-eob (eobp))
  1163. (goto-char (point-max))
  1164. (insert (concat "** " string "\n"))
  1165. (if was-eob (goto-char (point-max))
  1166. (goto-char point))
  1167. (set-buffer cb))
  1168. (message "ERC: ** %s" string))))
  1169. ;; Last active buffer, to print server messages in the right place
  1170. (defvar erc-active-buffer nil
  1171. "The current active buffer, the one where the user typed the last command.
  1172. Defaults to the server buffer, and should only be set in the
  1173. server buffer.")
  1174. (make-variable-buffer-local 'erc-active-buffer)
  1175. (defun erc-active-buffer ()
  1176. "Return the value of `erc-active-buffer' for the current server.
  1177. Defaults to the server buffer."
  1178. (erc-with-server-buffer
  1179. (if (buffer-live-p erc-active-buffer)
  1180. erc-active-buffer
  1181. (setq erc-active-buffer (current-buffer)))))
  1182. (defun erc-set-active-buffer (buffer)
  1183. "Set the value of `erc-active-buffer' to BUFFER."
  1184. (cond ((erc-server-buffer)
  1185. (with-current-buffer (erc-server-buffer)
  1186. (setq erc-active-buffer buffer)))
  1187. (t (setq erc-active-buffer buffer))))
  1188. ;; Mode activation routines
  1189. (define-derived-mode erc-mode fundamental-mode "ERC"
  1190. "Major mode for Emacs IRC."
  1191. (setq local-abbrev-table erc-mode-abbrev-table)
  1192. (when (boundp 'next-line-add-newlines)
  1193. (set (make-local-variable 'next-line-add-newlines) nil))
  1194. (setq line-move-ignore-invisible t)
  1195. (set (make-local-variable 'paragraph-separate)
  1196. (concat "\C-l\\|\\(^" (regexp-quote (erc-prompt)) "\\)"))
  1197. (set (make-local-variable 'paragraph-start)
  1198. (concat "\\(" (regexp-quote (erc-prompt)) "\\)"))
  1199. (add-hook 'completion-at-point-functions 'erc-complete-word-at-point nil t))
  1200. ;; activation
  1201. (defconst erc-default-server "irc.freenode.net"
  1202. "IRC server to use if it cannot be detected otherwise.")
  1203. (defconst erc-default-port 6667
  1204. "IRC port to use if it cannot be detected otherwise.")
  1205. (defcustom erc-join-buffer 'buffer
  1206. "Determines how to display a newly created IRC buffer.
  1207. The available choices are:
  1208. 'window - in another window,
  1209. 'window-noselect - in another window, but don't select that one,
  1210. 'frame - in another frame,
  1211. 'bury - bury it in a new buffer,
  1212. 'buffer - in place of the current buffer,
  1213. any other value - in place of the current buffer."
  1214. :group 'erc-buffers
  1215. :type '(choice (const :tag "Split window and select" window)
  1216. (const :tag "Split window, don't select" window-noselect)
  1217. (const :tag "New frame" frame)
  1218. (const :tag "Bury in new buffer" bury)
  1219. (const :tag "Use current buffer" buffer)
  1220. (const :tag "Use current buffer" t)))
  1221. (defcustom erc-frame-alist nil
  1222. "*Alist of frame parameters for creating erc frames.
  1223. A value of nil means to use `default-frame-alist'."
  1224. :group 'erc-buffers
  1225. :type '(repeat (cons :format "%v"
  1226. (symbol :tag "Parameter")
  1227. (sexp :tag "Value"))))
  1228. (defcustom erc-frame-dedicated-flag nil
  1229. "*Non-nil means the erc frames are dedicated to that buffer.
  1230. This only has effect when `erc-join-buffer' is set to `frame'."
  1231. :group 'erc-buffers
  1232. :type 'boolean)
  1233. (defcustom erc-reuse-frames t
  1234. "*Determines whether new frames are always created.
  1235. Non-nil means that a new frame is not created to display an ERC
  1236. buffer if there is already a window displaying it. This only has
  1237. effect when `erc-join-buffer' is set to `frame'."
  1238. :group 'erc-buffers
  1239. :type 'boolean)
  1240. (defun erc-channel-p (channel)
  1241. "Return non-nil if CHANNEL seems to be an IRC channel name."
  1242. (cond ((stringp channel)
  1243. (memq (aref channel 0) '(?# ?& ?+ ?!)))
  1244. ((and (bufferp channel) (buffer-live-p channel))
  1245. (with-current-buffer channel
  1246. (erc-channel-p (erc-default-target))))
  1247. (t nil)))
  1248. (defcustom erc-reuse-buffers t
  1249. "*If nil, create new buffers on joining a channel/query.
  1250. If non-nil, a new buffer will only be created when you join
  1251. channels with same names on different servers, or have query buffers
  1252. open with nicks of the same name on different servers. Otherwise,
  1253. the existing buffers will be reused."
  1254. :group 'erc-buffers
  1255. :type 'boolean)
  1256. (defun erc-normalize-port (port)
  1257. "Normalize the port specification PORT to integer form.
  1258. PORT may be an integer, a string or a symbol. If it is a string or a
  1259. symbol, it may have these values:
  1260. * irc -> 194
  1261. * ircs -> 994
  1262. * ircd -> 6667
  1263. * ircd-dalnet -> 7000"
  1264. (cond
  1265. ((symbolp port)
  1266. (erc-normalize-port (symbol-name port)))
  1267. ((stringp port)
  1268. (let ((port-nr (string-to-number port)))
  1269. (cond
  1270. ((> port-nr 0)
  1271. port-nr)
  1272. ((string-equal port "irc")
  1273. 194)
  1274. ((string-equal port "ircs")
  1275. 994)
  1276. ((string-equal port "ircd")
  1277. 6667)
  1278. ((string-equal port "ircd-dalnet")
  1279. 7000)
  1280. (t
  1281. nil))))
  1282. ((numberp port)
  1283. port)
  1284. (t
  1285. nil)))
  1286. (defun erc-port-equal (a b)
  1287. "Check whether ports A and B are equal."
  1288. (= (erc-normalize-port a) (erc-normalize-port b)))
  1289. (defun erc-generate-new-buffer-name (server port target &optional proc)
  1290. "Create a new buffer name based on the arguments."
  1291. (when (numberp port) (setq port (number-to-string port)))
  1292. (let ((buf-name (or target
  1293. (or (let ((name (concat server ":" port)))
  1294. (when (> (length name) 1)
  1295. name))
  1296. ;; This fallback should in fact never happen
  1297. "*erc-server-buffer*")))
  1298. buffer-name)
  1299. ;; Reuse existing buffers, but not if the buffer is a connected server
  1300. ;; buffer and not if its associated with a different server than the
  1301. ;; current ERC buffer.
  1302. ;; if buf-name is taken by a different connection (or by something !erc)
  1303. ;; then see if "buf-name/server" meets the same criteria
  1304. (dolist (candidate (list buf-name (concat buf-name "/" server)))
  1305. (if (and (not buffer-name)
  1306. erc-reuse-buffers
  1307. (get-buffer candidate)
  1308. (or target
  1309. (with-current-buffer (get-buffer candidate)
  1310. (and (erc-server-buffer-p)
  1311. (not (erc-server-process-alive)))))
  1312. (with-current-buffer (get-buffer candidate)
  1313. (and (string= erc-session-server server)
  1314. (erc-port-equal erc-session-port port))))
  1315. (setq buffer-name candidate)))
  1316. ;; if buffer-name is unset, neither candidate worked out for us,
  1317. ;; fallback to the old <N> uniquification method:
  1318. (or buffer-name (generate-new-buffer-name buf-name)) ))
  1319. (defun erc-get-buffer-create (server port target &optional proc)
  1320. "Create a new buffer based on the arguments."
  1321. (get-buffer-create (erc-generate-new-buffer-name server port target proc)))
  1322. (defun erc-member-ignore-case (string list)
  1323. "Return non-nil if STRING is a member of LIST.
  1324. All strings are compared according to IRC protocol case rules, see
  1325. `erc-downcase'."
  1326. (setq string (erc-downcase string))
  1327. (catch 'result
  1328. (while list
  1329. (if (string= string (erc-downcase (car list)))
  1330. (throw 'result list)
  1331. (setq list (cdr list))))))
  1332. (defmacro erc-with-buffer (spec &rest body)
  1333. "Execute BODY in the buffer associated with SPEC.
  1334. SPEC should have the form
  1335. (TARGET [PROCESS])
  1336. If TARGET is a buffer, use it. Otherwise, use the buffer
  1337. matching TARGET in the process specified by PROCESS.
  1338. If PROCESS is nil, use the current `erc-server-process'.
  1339. See `erc-get-buffer' for details.
  1340. See also `with-current-buffer'.
  1341. \(fn (TARGET [PROCESS]) BODY...)"
  1342. (let ((buf (make-symbol "buf"))
  1343. (proc (make-symbol "proc"))
  1344. (target (make-symbol "target"))
  1345. (process (make-symbol "process")))
  1346. `(let* ((,target ,(car spec))
  1347. (,process ,(cadr spec))
  1348. (,buf (if (bufferp ,target)
  1349. ,target
  1350. (let ((,proc (or ,process
  1351. (and (processp erc-server-process)
  1352. erc-server-process))))
  1353. (if (and ,target ,proc)
  1354. (erc-get-buffer ,target ,proc))))))
  1355. (when (buffer-live-p ,buf)
  1356. (with-current-buffer ,buf
  1357. ,@body)))))
  1358. (put 'erc-with-buffer 'lisp-indent-function 1)
  1359. (put 'erc-with-buffer 'edebug-form-spec '((form &optional form) body))
  1360. (defun erc-get-buffer (target &optional proc)
  1361. "Return the buffer matching TARGET in the process PROC.
  1362. If PROC is not supplied, all processes are searched."
  1363. (let ((downcased-target (erc-downcase target)))
  1364. (catch 'buffer
  1365. (erc-buffer-filter
  1366. (lambda ()
  1367. (let ((current (erc-default-target)))
  1368. (and (stringp current)
  1369. (string-equal downcased-target (erc-downcase current))
  1370. (throw 'buffer (current-buffer)))))
  1371. proc))))
  1372. (defun erc-buffer-filter (predicate &optional proc)
  1373. "Return a list of `erc-mode' buffers matching certain criteria.
  1374. PREDICATE is a function executed with each buffer, if it returns t, that buffer
  1375. is considered a valid match.
  1376. PROC is either an `erc-server-process', identifying a certain
  1377. server connection, or nil which means all open connections."
  1378. (save-excursion
  1379. (delq
  1380. nil
  1381. (mapcar (lambda (buf)
  1382. (when (buffer-live-p buf)
  1383. (with-current-buffer buf
  1384. (and (eq major-mode 'erc-mode)
  1385. (or (not proc)
  1386. (eq proc erc-server-process))
  1387. (funcall predicate)
  1388. buf))))
  1389. (buffer-list)))))
  1390. (defun erc-buffer-list (&optional predicate proc)
  1391. "Return a list of ERC buffers.
  1392. PREDICATE is a function which executes with every buffer satisfying
  1393. the predicate. If PREDICATE is passed as nil, return a list of all ERC
  1394. buffers. If PROC is given, the buffers local variable `erc-server-process'
  1395. needs to match PROC."
  1396. (unless predicate
  1397. (setq predicate (lambda () t)))
  1398. (erc-buffer-filter predicate proc))
  1399. (defmacro erc-with-all-buffers-of-server (process pred &rest forms)
  1400. "Execute FORMS in all buffers which have same process as this server.
  1401. FORMS will be evaluated in all buffers having the process PROCESS and
  1402. where PRED matches or in all buffers of the server process if PRED is
  1403. nil."
  1404. ;; Make the evaluation have the correct order
  1405. (let ((pre (make-symbol "pre"))
  1406. (pro (make-symbol "pro")))
  1407. `(let* ((,pro ,process)
  1408. (,pre ,pred)
  1409. (res (mapcar (lambda (buffer)
  1410. (with-current-buffer buffer
  1411. ,@forms))
  1412. (erc-buffer-list ,pre
  1413. ,pro))))
  1414. ;; Silence the byte-compiler by binding the result of mapcar to
  1415. ;; a variable.
  1416. res)))
  1417. (put 'erc-with-all-buffers-of-server 'lisp-indent-function 1)
  1418. (put 'erc-with-all-buffers-of-server 'edebug-form-spec '(form form body))
  1419. ;; (iswitchb-mode) will autoload iswitchb.el
  1420. (defvar iswitchb-temp-buflist)
  1421. (declare-function iswitchb-read-buffer "iswitchb"
  1422. (prompt &optional default require-match start matches-set))
  1423. (defun erc-iswitchb (&optional arg)
  1424. "Use `iswitchb-read-buffer' to prompt for a ERC buffer to switch to.
  1425. When invoked with prefix argument, use all erc buffers. Without prefix
  1426. ARG, allow only buffers related to same session server.
  1427. If `erc-track-mode' is in enabled, put the last element of
  1428. `erc-modified-channels-alist' in front of the buffer list.
  1429. Due to some yet unresolved reason, global function `iswitchb-mode'
  1430. needs to be active for this function to work."
  1431. (interactive "P")
  1432. (let ((enabled (bound-and-true-p iswitchb-mode)))
  1433. (or enabled (iswitchb-mode 1))
  1434. (unwind-protect
  1435. (let ((iswitchb-make-buflist-hook
  1436. (lambda ()
  1437. (setq iswitchb-temp-buflist
  1438. (mapcar 'buffer-name
  1439. (erc-buffer-list
  1440. nil
  1441. (when arg erc-server-process)))))))
  1442. (switch-to-buffer
  1443. (iswitchb-read-buffer
  1444. "Switch-to: "
  1445. (if (boundp 'erc-modified-channels-alist)
  1446. (buffer-name (caar (last erc-modified-channels-alist)))
  1447. nil)
  1448. t)))
  1449. (or enabled (iswitchb-mode -1)))))
  1450. (defun erc-channel-list (proc)
  1451. "Return a list of channel buffers.
  1452. PROC is the process for the server connection. If PROC is nil, return
  1453. all channel buffers on all servers."
  1454. (erc-buffer-filter
  1455. (lambda ()
  1456. (and (erc-default-target)
  1457. (erc-channel-p (erc-default-target))))
  1458. proc))
  1459. (defun erc-buffer-list-with-nick (nick proc)
  1460. "Return buffers containing NICK in the `erc-channel-users' list."
  1461. (with-current-buffer (process-buffer proc)
  1462. (let ((user (gethash (erc-downcase nick) erc-server-users)))
  1463. (if user
  1464. (erc-server-user-buffers user)
  1465. nil))))
  1466. ;; Some local variables
  1467. (defvar erc-default-recipients nil
  1468. "List of default recipients of the current buffer.")
  1469. (make-variable-buffer-local 'erc-default-recipients)
  1470. (defvar erc-session-user-full-name nil
  1471. "Full name of the user on the current server.")
  1472. (make-variable-buffer-local 'erc-session-user-full-name)
  1473. (defvar erc-channel-user-limit nil
  1474. "Limit of users per channel.")
  1475. (make-variable-buffer-local 'erc-channel-user-limit)
  1476. (defvar erc-channel-key nil
  1477. "Key needed to join channel.")
  1478. (make-variable-buffer-local 'erc-channel-key)
  1479. (defvar erc-invitation nil
  1480. "Last invitation channel.")
  1481. (make-variable-buffer-local 'erc-invitation)
  1482. (defvar erc-away nil
  1483. "Non-nil indicates that we are away.
  1484. Use `erc-away-time' to access this if you might be in a channel
  1485. buffer rather than a server buffer.")
  1486. (make-variable-buffer-local 'erc-away)
  1487. (defvar erc-channel-list nil
  1488. "Server channel list.")
  1489. (make-variable-buffer-local 'erc-channel-list)
  1490. (defvar erc-bad-nick nil
  1491. "Non-nil indicates that we got a `nick in use' error while connecting.")
  1492. (make-variable-buffer-local 'erc-bad-nick)
  1493. (defvar erc-logged-in nil
  1494. "Non-nil indicates that we are logged in.")
  1495. (make-variable-buffer-local 'erc-logged-in)
  1496. (defvar erc-default-nicks nil
  1497. "The local copy of `erc-nick' - the list of nicks to choose from.")
  1498. (make-variable-buffer-local 'erc-default-nicks)
  1499. (defvar erc-nick-change-attempt-count 0
  1500. "Used to keep track of how many times an attempt at changing nick is made.")
  1501. (make-variable-buffer-local 'erc-nick-change-attempt-count)
  1502. (defun erc-migrate-modules (mods)
  1503. "Migrate old names of ERC modules to new ones."
  1504. ;; modify `transforms' to specify what needs to be changed
  1505. ;; each item is in the format '(old . new)
  1506. (let ((transforms '((pcomplete . completion))))
  1507. (erc-delete-dups
  1508. (mapcar (lambda (m) (or (cdr (assoc m transforms)) m))
  1509. mods))))
  1510. (defcustom erc-modules '(netsplit fill button match track completion readonly
  1511. networks ring autojoin noncommands irccontrols
  1512. move-to-prompt stamp menu list)
  1513. "A list of modules which ERC should enable.
  1514. If you set the value of this without using `customize' remember to call
  1515. \(erc-update-modules) after you change it. When using `customize', modules
  1516. removed from the list will be disabled."
  1517. :get (lambda (sym)
  1518. ;; replace outdated names with their newer equivalents
  1519. (erc-migrate-modules (symbol-value sym)))
  1520. :set (lambda (sym val)
  1521. ;; disable modules which have just been removed
  1522. (when (and (boundp 'erc-modules) erc-modules val)
  1523. (dolist (module erc-modules)
  1524. (unless (member module val)
  1525. (let ((f (intern-soft (format "erc-%s-mode" module))))
  1526. (when (and (fboundp f) (boundp f) (symbol-value f))
  1527. (message "Disabling `erc-%s'" module)
  1528. (funcall f 0))))))
  1529. (set sym val)
  1530. ;; this test is for the case where erc hasn't been loaded yet
  1531. (when (fboundp 'erc-update-modules)
  1532. (erc-update-modules)))
  1533. :type
  1534. '(set
  1535. :greedy t
  1536. (const :tag "autoaway: Set away status automatically" autoaway)
  1537. (const :tag "autojoin: Join channels automatically" autojoin)
  1538. (const :tag "button: Buttonize URLs, nicknames, and other text" button)
  1539. (const :tag "capab: Mark unidentified users on servers supporting CAPAB"
  1540. capab-identify)
  1541. (const :tag "completion: Complete nicknames and commands (programmable)"
  1542. completion)
  1543. (const :tag "hecomplete: Complete nicknames and commands (old)" hecomplete)
  1544. (const :tag "dcc: Provide Direct Client-to-Client support" dcc)
  1545. (const :tag "fill: Wrap long lines" fill)
  1546. (const :tag "identd: Launch an identd server on port 8113" identd)
  1547. (const :tag "irccontrols: Highlight or remove IRC control characters"
  1548. irccontrols)
  1549. (const :tag "keep-place: Leave point above un-viewed text" keep-place)
  1550. (const :tag "list: List channels in a separate buffer" list)
  1551. (const :tag "log: Save buffers in logs" log)
  1552. (const :tag "match: Highlight pals, fools, and other keywords" match)
  1553. (const :tag "menu: Display a menu in ERC buffers" menu)
  1554. (const :tag "move-to-prompt: Move to the prompt when typing text"
  1555. move-to-prompt)
  1556. (const :tag "netsplit: Detect netsplits" netsplit)
  1557. (const :tag "networks: Provide data about IRC networks" networks)
  1558. (const :tag "noncommands: Don't display non-IRC commands after evaluation"
  1559. noncommands)
  1560. (const :tag
  1561. "notify: Notify when the online status of certain users changes"
  1562. notify)
  1563. (const :tag "page: Process CTCP PAGE requests from IRC" page)
  1564. (const :tag "readonly: Make displayed lines read-only" readonly)
  1565. (const :tag "replace: Replace text in messages" replace)
  1566. (const :tag "ring: Enable an input history" ring)
  1567. (const :tag "scrolltobottom: Scroll to the bottom of the buffer"
  1568. scrolltobottom)
  1569. (const :tag "services: Identify to Nickserv (IRC Services) automatically"
  1570. services)
  1571. (const :tag "smiley: Convert smileys to pretty icons" smiley)
  1572. (const :tag "sound: Play sounds when you receive CTCP SOUND requests"
  1573. sound)
  1574. (const :tag "stamp: Add timestamps to messages" stamp)
  1575. (const :tag "spelling: Check spelling" spelling)
  1576. (const :tag "track: Track channel activity in the mode-line" track)
  1577. (const :tag "truncate: Truncate buffers to a certain size" truncate)
  1578. (const :tag "unmorse: Translate morse code in messages" unmorse)
  1579. (const :tag "xdcc: Act as an XDCC file-server" xdcc)
  1580. (repeat :tag "Others" :inline t symbol))
  1581. :group 'erc)
  1582. (defun erc-update-modules ()
  1583. "Run this to enable erc-foo-mode for all modules in `erc-modules'."
  1584. (let (req)
  1585. (dolist (mod erc-modules)
  1586. (setq req (concat "erc-" (symbol-name mod)))
  1587. (cond
  1588. ;; yuck. perhaps we should bring the filenames into sync?
  1589. ((string= req "erc-capab-identify")
  1590. (setq req "erc-capab"))
  1591. ((string= req "erc-completion")
  1592. (setq req "erc-pcomplete"))
  1593. ((string= req "erc-pcomplete")
  1594. (setq mod 'completion))
  1595. ((string= req "erc-autojoin")
  1596. (setq req "erc-join")))
  1597. (condition-case nil
  1598. (require (intern req))
  1599. (error nil))
  1600. (let ((sym (intern-soft (concat "erc-" (symbol-name mod) "-mode"))))
  1601. (if (fboundp sym)
  1602. (funcall sym 1)
  1603. (error "`%s' is not a known ERC module" mod))))))
  1604. (defun erc-setup-buffer (buffer)
  1605. "Consults `erc-join-buffer' to find out how to display `BUFFER'."
  1606. (cond ((eq erc-join-buffer 'window)
  1607. (if (active-minibuffer-window)
  1608. (display-buffer buffer)
  1609. (switch-to-buffer-other-window buffer)))
  1610. ((eq erc-join-buffer 'window-noselect)
  1611. (display-buffer buffer))
  1612. ((eq erc-join-buffer 'bury)
  1613. nil)
  1614. ((eq erc-join-buffer 'frame)
  1615. (when (or (not erc-reuse-frames)
  1616. (not (get-buffer-window buffer t)))
  1617. ((lambda (frame)
  1618. (raise-frame frame)
  1619. (select-frame frame))
  1620. (make-frame (or erc-frame-alist
  1621. default-frame-alist)))
  1622. (switch-to-buffer buffer)
  1623. (when erc-frame-dedicated-flag
  1624. (set-window-dedicated-p (selected-window) t))))
  1625. (t
  1626. (if (active-minibuffer-window)
  1627. (display-buffer buffer)
  1628. (switch-to-buffer buffer)))))
  1629. (defun erc-open (&optional server port nick full-name
  1630. connect passwd tgt-list channel process)
  1631. "Connect to SERVER on PORT as NICK with FULL-NAME.
  1632. If CONNECT is non-nil, connect to the server. Otherwise assume
  1633. already connected and just create a separate buffer for the new
  1634. target CHANNEL.
  1635. Use PASSWD as user password on the server. If TGT-LIST is
  1636. non-nil, use it to initialize `erc-default-recipients'.
  1637. Returns the buffer for the given server or channel."
  1638. (let ((server-announced-name (when (and (boundp 'erc-session-server)
  1639. (string= server erc-session-server))
  1640. erc-server-announced-name))
  1641. (connected-p (unless connect erc-server-connected))
  1642. (buffer (erc-get-buffer-create server port channel))
  1643. (old-buffer (current-buffer))
  1644. old-point
  1645. continued-session)
  1646. (when connect (run-hook-with-args 'erc-before-connect server port nick))
  1647. (erc-update-modules)
  1648. (set-buffer buffer)
  1649. (setq old-point (point))
  1650. (erc-mode)
  1651. (setq erc-server-announced-name server-announced-name)
  1652. (setq erc-server-connected connected-p)
  1653. ;; connection parameters
  1654. (setq erc-server-process process)
  1655. (setq erc-insert-marker (make-marker))
  1656. (setq erc-input-marker (make-marker))
  1657. ;; go to the end of the buffer and open a new line
  1658. ;; (the buffer may have existed)
  1659. (goto-char (point-max))
  1660. (forward-line 0)
  1661. (when (get-text-property (point) 'erc-prompt)
  1662. (setq continued-session t)
  1663. (set-marker erc-input-marker
  1664. (or (next-single-property-change (point) 'erc-prompt)
  1665. (point-max))))
  1666. (unless continued-session
  1667. (goto-char (point-max))
  1668. (insert "\n"))
  1669. (set-marker erc-insert-marker (point))
  1670. ;; stack of default recipients
  1671. (setq erc-default-recipients tgt-list)
  1672. (setq erc-server-current-nick nil)
  1673. ;; Initialize erc-server-users and erc-channel-users
  1674. (if connect
  1675. (progn ;; server buffer
  1676. (setq erc-server-users
  1677. (make-hash-table :test 'equal))
  1678. (setq erc-channel-users nil))
  1679. (progn ;; target buffer
  1680. (setq erc-server-users nil)
  1681. (setq erc-channel-users
  1682. (make-hash-table :test 'equal))))
  1683. ;; clear last incomplete line read
  1684. (setq erc-server-filter-data nil)
  1685. (setq erc-channel-topic "")
  1686. ;; limit on the number of users on the channel (mode +l)
  1687. (setq erc-channel-user-limit nil)
  1688. (setq erc-channel-key nil)
  1689. ;; last active buffer, defaults to this one
  1690. (erc-set-active-buffer buffer)
  1691. ;; last invitation channel
  1692. (setq erc-invitation nil)
  1693. ;; Server channel list
  1694. (setq erc-channel-list ())
  1695. ;; login-time 'nick in use' error
  1696. (setq erc-bad-nick nil)
  1697. ;; whether we have logged in
  1698. (setq erc-logged-in nil)
  1699. ;; The local copy of `erc-nick' - the list of nicks to choose
  1700. (setq erc-default-nicks (if (consp erc-nick) erc-nick (list erc-nick)))
  1701. ;; password stuff
  1702. (setq erc-session-password passwd)
  1703. ;; debug output buffer
  1704. (setq erc-dbuf
  1705. (when erc-log-p
  1706. (get-buffer-create (concat "*ERC-DEBUG: " server "*"))))
  1707. ;; set up prompt
  1708. (unless continued-session
  1709. (goto-char (point-max))
  1710. (insert "\n"))
  1711. (if continued-session
  1712. (goto-char old-point)
  1713. (set-marker erc-insert-marker (point))
  1714. (erc-display-prompt)
  1715. (goto-char (point-max)))
  1716. (erc-determine-parameters server port nick full-name)
  1717. ;; Saving log file on exit
  1718. (run-hook-with-args 'erc-connect-pre-hook buffer)
  1719. (when connect
  1720. (erc-server-connect erc-session-server erc-session-port buffer))
  1721. (erc-update-mode-line)
  1722. ;; Now display the buffer in a window as per user wishes.
  1723. (unless (eq buffer old-buffer)
  1724. (when erc-log-p
  1725. ;; we can't log to debug buffer, it may not exist yet
  1726. (message "erc: old buffer %s, switching to %s"
  1727. old-buffer buffer))
  1728. (erc-setup-buffer buffer))
  1729. buffer))
  1730. (defun erc-initialize-log-marker (buffer)
  1731. "Initialize the `erc-last-saved-position' marker to a sensible position.
  1732. BUFFER is the current buffer."
  1733. (with-current-buffer buffer
  1734. (setq erc-last-saved-position (make-marker))
  1735. (move-marker erc-last-saved-position
  1736. (1- (marker-position erc-insert-marker)))))
  1737. ;; interactive startup
  1738. (defvar erc-server-history-list nil
  1739. "IRC server interactive selection history list.")
  1740. (defvar erc-nick-history-list nil
  1741. "Nickname interactive selection history list.")
  1742. (defun erc-already-logged-in (server port nick)
  1743. "Return the buffers corresponding to a NICK on PORT of a session SERVER.
  1744. This is determined by looking for the appropriate buffer and checking
  1745. whether the connection is still alive.
  1746. If no buffer matches, return nil."
  1747. (erc-buffer-list
  1748. (lambda ()
  1749. (and (erc-server-process-alive)
  1750. (string= erc-session-server server)
  1751. (erc-port-equal erc-session-port port)
  1752. (erc-current-nick-p nick)))))
  1753. (if (not (fboundp 'read-passwd))
  1754. (defun read-passwd (prompt)
  1755. "Substitute for `read-passwd' in early emacsen."
  1756. (read-from-minibuffer prompt)))
  1757. (defcustom erc-before-connect nil
  1758. "Hook called before connecting to a server.
  1759. This hook gets executed before `erc' actually invokes `erc-mode'
  1760. with your input data. The functions in here get called with three
  1761. parameters, SERVER, PORT and NICK."
  1762. :group 'erc-hooks
  1763. :type 'hook)
  1764. (defcustom erc-after-connect nil
  1765. "Hook called after connecting to a server.
  1766. This hook gets executed when an end of MOTD has been received. All
  1767. functions in here get called with the parameters SERVER and NICK."
  1768. :group 'erc-hooks
  1769. :type 'hook)
  1770. ;;;###autoload
  1771. (defun erc-select-read-args ()
  1772. "Prompt the user for values of nick, server, port, and password."
  1773. (let (user-input server port nick passwd)
  1774. (setq user-input (read-from-minibuffer
  1775. "IRC server: "
  1776. (erc-compute-server) nil nil 'erc-server-history-list))
  1777. (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input)
  1778. (setq port (erc-string-to-port (match-string 2 user-input))
  1779. user-input (match-string 1 user-input))
  1780. (setq port
  1781. (erc-string-to-port (read-from-minibuffer
  1782. "IRC port: " (erc-port-to-string
  1783. (erc-compute-port))))))
  1784. (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input)
  1785. (setq nick (match-string 1 user-input)
  1786. user-input (match-string 2 user-input))
  1787. (setq nick
  1788. (if (erc-already-logged-in server port nick)
  1789. (read-from-minibuffer
  1790. (erc-format-message 'nick-in-use ?n nick)
  1791. nick
  1792. nil nil 'erc-nick-history-list)
  1793. (read-from-minibuffer
  1794. "Nickname: " (erc-compute-nick nick)
  1795. nil nil 'erc-nick-history-list))))
  1796. (setq server user-input)
  1797. (setq passwd (if erc-prompt-for-password
  1798. (if (and erc-password
  1799. (y-or-n-p "Use the default password? "))
  1800. erc-password
  1801. (read-passwd "Password: "))
  1802. erc-password))
  1803. (when (and passwd (string= "" passwd))
  1804. (setq passwd nil))
  1805. (while (erc-already-logged-in server port nick)
  1806. ;; hmm, this is a problem when using multiple connections to a bnc
  1807. ;; with the same nick. Currently this code prevents using more than one
  1808. ;; bnc with the same nick. actually it would be nice to have
  1809. ;; bncs transparent, so that erc-compute-buffer-name displays
  1810. ;; the server one is connected to.
  1811. (setq nick (read-from-minibuffer
  1812. (erc-format-message 'nick-in-use ?n nick)
  1813. nick
  1814. nil nil 'erc-nick-history-list)))
  1815. (list :server server :port port :nick nick :password passwd)))
  1816. ;;;###autoload
  1817. (defun* erc (&key (server (erc-compute-server))
  1818. (port (erc-compute-port))
  1819. (nick (erc-compute-nick))
  1820. password
  1821. (full-name (erc-compute-full-name)))
  1822. "ERC is a powerful, modular, and extensible IRC client.
  1823. This function is the main entry point for ERC.
  1824. It permits you to select connection parameters, and then starts ERC.
  1825. Non-interactively, it takes the keyword arguments
  1826. (server (erc-compute-server))
  1827. (port (erc-compute-port))
  1828. (nick (erc-compute-nick))
  1829. password
  1830. (full-name (erc-compute-full-name)))
  1831. That is, if called with
  1832. (erc :server \"irc.freenode.net\" :full-name \"Harry S Truman\")
  1833. then the server and full-name will be set to those values, whereas
  1834. `erc-compute-port', `erc-compute-nick' and `erc-compute-full-name' will
  1835. be invoked for the values of the other parameters."
  1836. (interactive (erc-select-read-args))
  1837. (erc-open server port nick full-name t password))
  1838. ;;;###autoload
  1839. (defalias 'erc-select 'erc)
  1840. (defalias 'erc-ssl 'erc-tls)
  1841. ;;;###autoload
  1842. (defun erc-tls (&rest r)
  1843. "Interactively select TLS connection parameters and run ERC.
  1844. Arguments are the same as for `erc'."
  1845. (interactive (erc-select-read-args))
  1846. (let ((erc-server-connect-function 'erc-open-tls-stream))
  1847. (apply 'erc r)))
  1848. (defun erc-open-tls-stream (name buffer host port)
  1849. "Open an TLS stream to an IRC server.
  1850. The process will be given the name NAME, its target buffer will be
  1851. BUFFER. HOST and PORT specify the connection target."
  1852. (open-network-stream name buffer host port
  1853. :type 'tls))
  1854. ;;; Displaying error messages
  1855. (defun erc-error (&rest args)
  1856. "Pass ARGS to `format', and display the result as an error message.
  1857. If `debug-on-error' is set to non-nil, then throw a real error with this
  1858. message instead, to make debugging easier."
  1859. (if debug-on-error
  1860. (apply #'error args)
  1861. (apply #'message args)
  1862. (beep)))
  1863. ;;; Debugging the protocol
  1864. (defvar erc-debug-irc-protocol nil
  1865. "If non-nil, log all IRC protocol traffic to the buffer \"*erc-protocol*\".
  1866. The buffer is created if it doesn't exist.
  1867. NOTE: If this variable is non-nil, and you kill the only
  1868. visible \"*erc-protocol*\" buffer, it will be recreated shortly,
  1869. but you won't see it.
  1870. WARNING: Do not set this variable directly! Instead, use the
  1871. function `erc-toggle-debug-irc-protocol' to toggle its value.")
  1872. (declare-function erc-network-name "erc-networks" ())
  1873. (defun erc-log-irc-protocol (string &optional outbound)
  1874. "Append STRING to the buffer *erc-protocol*.
  1875. This only has any effect if `erc-debug-irc-protocol' is non-nil.
  1876. The buffer is created if it doesn't exist.
  1877. If OUTBOUND is non-nil, STRING is being sent to the IRC server
  1878. and appears in face `erc-input-face' in the buffer."
  1879. (when erc-debug-irc-protocol
  1880. (let ((network-name (or (ignore-errors (erc-network-name))
  1881. "???")))
  1882. (with-current-buffer (get-buffer-create "*erc-protocol*")
  1883. (save-excursion
  1884. (goto-char (point-max))
  1885. (let ((inhibit-read-only t))
  1886. (insert (if (not outbound)
  1887. ;; Cope with the fact that string might
  1888. ;; contain multiple lines of text.
  1889. (let ((lines (delete "" (split-string string
  1890. "\n\\|\r\n")))
  1891. (result ""))
  1892. (dolist (line lines)
  1893. (setq result (concat result network-name
  1894. " << " line "\n")))
  1895. result)
  1896. (erc-propertize
  1897. (concat network-name " >> " string
  1898. (if (/= ?\n
  1899. (aref string
  1900. (1- (length string))))
  1901. "\n"))
  1902. 'face 'erc-input-face)))))
  1903. (let ((orig-win (selected-window))
  1904. (debug-buffer-window (get-buffer-window (current-buffer) t)))
  1905. (when debug-buffer-window
  1906. (select-window debug-buffer-window)
  1907. (when (= 1 (count-lines (point) (point-max)))
  1908. (goto-char (point-max))
  1909. (recenter -1))
  1910. (select-window orig-win)))))))
  1911. (defun erc-toggle-debug-irc-protocol (&optional arg)
  1912. "Toggle the value of `erc-debug-irc-protocol'.
  1913. If ARG is non-nil, show the *erc-protocol* buffer."
  1914. (interactive "P")
  1915. (let* ((buf (get-buffer-create "*erc-protocol*")))
  1916. (with-current-buffer buf
  1917. (erc-view-mode-enter)
  1918. (when (null (current-local-map))
  1919. (let ((inhibit-read-only t))
  1920. (insert (erc-make-notice "This buffer displays all IRC protocol traffic exchanged with each server.\n"))
  1921. (insert (erc-make-notice "Kill this buffer to terminate protocol logging.\n\n")))
  1922. (use-local-map (make-sparse-keymap))
  1923. (local-set-key (kbd "t") 'erc-toggle-debug-irc-protocol))
  1924. (add-hook 'kill-buffer-hook
  1925. #'(lambda () (setq erc-debug-irc-protocol nil))
  1926. nil 'local)
  1927. (goto-char (point-max))
  1928. (let ((inhibit-read-only t))
  1929. (insert (erc-make-notice
  1930. (format "IRC protocol logging %s at %s -- Press `t' to toggle logging.\n"
  1931. (if erc-debug-irc-protocol "disabled" "enabled")
  1932. (current-time-string))))))
  1933. (setq erc-debug-irc-protocol (not erc-debug-irc-protocol))
  1934. (if (and arg
  1935. (not (get-buffer-window "*erc-protocol*" t)))
  1936. (display-buffer buf t))
  1937. (message "IRC protocol traffic logging %s (see buffer *erc-protocol*)."
  1938. (if erc-debug-irc-protocol "enabled" "disabled"))))
  1939. ;;; I/O interface
  1940. ;; send interface
  1941. (defun erc-send-action (tgt str &optional force)
  1942. "Send CTCP ACTION information described by STR to TGT."
  1943. (erc-send-ctcp-message tgt (format "ACTION %s" str) force)
  1944. (erc-display-message
  1945. nil 'input (current-buffer)
  1946. 'ACTION ?n (erc-current-nick) ?a str ?u "" ?h ""))
  1947. ;; Display interface
  1948. (defun erc-string-invisible-p (string)
  1949. "Check whether STRING is invisible or not.
  1950. I.e. any char in it has the `invisible' property set."
  1951. (text-property-any 0 (length string) 'invisible t string))
  1952. (defcustom erc-remove-parsed-property t
  1953. "Whether to remove the erc-parsed text property after displaying a message.
  1954. The default is to remove it, since it causes ERC to take up extra
  1955. memory. If you have code that relies on this property, then set
  1956. this option to nil."
  1957. :type 'boolean
  1958. :group 'erc)
  1959. (defun erc-display-line-1 (string buffer)
  1960. "Display STRING in `erc-mode' BUFFER.
  1961. Auxiliary function used in `erc-display-line'. The line gets filtered to
  1962. interpret the control characters. Then, `erc-insert-pre-hook' gets called.
  1963. If `erc-insert-this' is still t, STRING gets inserted into the buffer.
  1964. Afterwards, `erc-insert-modify' and `erc-insert-post-hook' get called.
  1965. If STRING is nil, the function does nothing."
  1966. (when string
  1967. (with-current-buffer (or buffer (process-buffer erc-server-process))
  1968. (let ((insert-position (or (marker-position erc-insert-marker)
  1969. (point-max))))
  1970. (let ((string string) ;; FIXME! Can this be removed?
  1971. (buffer-undo-list t)
  1972. (inhibit-read-only t))
  1973. (unless (string-match "\n$" string)
  1974. (setq string (concat string "\n"))
  1975. (when (erc-string-invisible-p string)
  1976. (erc-put-text-properties 0 (length string)
  1977. '(invisible intangible) string)))
  1978. (erc-log (concat "erc-display-line: " string
  1979. (format "(%S)" string) " in buffer "
  1980. (format "%s" buffer)))
  1981. (setq erc-insert-this t)
  1982. (run-hook-with-args 'erc-insert-pre-hook string)
  1983. (if (null erc-insert-this)
  1984. ;; Leave erc-insert-this set to t as much as possible. Fran
  1985. ;; Litterio <franl> has seen erc-insert-this set to nil while
  1986. ;; erc-send-pre-hook is running, which should never happen. This
  1987. ;; may cure it.
  1988. (setq erc-insert-this t)
  1989. (save-excursion ;; to restore point in the new buffer
  1990. (save-restriction
  1991. (widen)
  1992. (goto-char insert-position)
  1993. (insert-before-markers string)
  1994. ;; run insertion hook, with point at restored location
  1995. (save-restriction
  1996. (narrow-to-region insert-position (point))
  1997. (run-hooks 'erc-insert-modify-hook)
  1998. (run-hooks 'erc-insert-post-hook)
  1999. (when erc-remove-parsed-property
  2000. (remove-text-properties (point-min) (point-max)
  2001. '(erc-parsed nil))))))))
  2002. (erc-update-undo-list (- (or (marker-position erc-insert-marker)
  2003. (point-max))
  2004. insert-position))))))
  2005. (defun erc-update-undo-list (shift)
  2006. ;; Translate buffer positions in buffer-undo-list by SHIFT.
  2007. (unless (or (zerop shift) (atom buffer-undo-list))
  2008. (let ((list buffer-undo-list) elt)
  2009. (while list
  2010. (setq elt (car list))
  2011. (cond ((integerp elt) ; POSITION
  2012. (incf (car list) shift))
  2013. ((or (atom elt) ; nil, EXTENT
  2014. ;; (eq t (car elt)) ; (t . TIME)
  2015. (markerp (car elt))) ; (MARKER . DISTANCE)
  2016. nil)
  2017. ((integerp (car elt)) ; (BEGIN . END)
  2018. (incf (car elt) shift)
  2019. (incf (cdr elt) shift))
  2020. ((stringp (car elt)) ; (TEXT . POSITION)
  2021. (incf (cdr elt) (* (if (natnump (cdr elt)) 1 -1) shift)))
  2022. ((null (car elt)) ; (nil PROPERTY VALUE BEG . END)
  2023. (let ((cons (nthcdr 3 elt)))
  2024. (incf (car cons) shift)
  2025. (incf (cdr cons) shift)))
  2026. ((and (featurep 'xemacs)
  2027. (extentp (car elt))) ; (EXTENT START END)
  2028. (incf (nth 1 elt) shift)
  2029. (incf (nth 2 elt) shift)))
  2030. (setq list (cdr list))))))
  2031. (defvar erc-valid-nick-regexp "[]a-zA-Z^[;\\`_{}|][]^[;\\`_{}|a-zA-Z0-9-]*"
  2032. "Regexp which matches all valid characters in a IRC nickname.")
  2033. (defun erc-is-valid-nick-p (nick)
  2034. "Check if NICK is a valid IRC nickname."
  2035. (string-match (concat "^" erc-valid-nick-regexp "$") nick))
  2036. (defun erc-display-line (string &optional buffer)
  2037. "Display STRING in the ERC BUFFER.
  2038. All screen output must be done through this function. If BUFFER is nil
  2039. or omitted, the default ERC buffer for the `erc-session-server' is used.
  2040. The BUFFER can be an actual buffer, a list of buffers, 'all or 'active.
  2041. If BUFFER = 'all, the string is displayed in all the ERC buffers for the
  2042. current session. 'active means the current active buffer
  2043. \(`erc-active-buffer'). If the buffer can't be resolved, the current
  2044. buffer is used. `erc-display-line-1' is used to display STRING.
  2045. If STRING is nil, the function does nothing."
  2046. (let ((inhibit-point-motion-hooks t)
  2047. new-bufs)
  2048. (dolist (buf (cond
  2049. ((bufferp buffer) (list buffer))
  2050. ((listp buffer) buffer)
  2051. ((processp buffer) (list (process-buffer buffer)))
  2052. ((eq 'all buffer)
  2053. ;; Hmm, or all of the same session server?
  2054. (erc-buffer-list nil erc-server-process))
  2055. ((and (eq 'active buffer) (erc-active-buffer))
  2056. (list (erc-active-buffer)))
  2057. ((erc-server-buffer-live-p)
  2058. (list (process-buffer erc-server-process)))
  2059. (t (list (current-buffer)))))
  2060. (when (buffer-live-p buf)
  2061. (erc-display-line-1 string buf)
  2062. (add-to-list 'new-bufs buf)))
  2063. (when (null new-bufs)
  2064. (if (erc-server-buffer-live-p)
  2065. (erc-display-line-1 string (process-buffer erc-server-process))
  2066. (erc-display-line-1 string (current-buffer))))))
  2067. (defun erc-display-message-highlight (type string)
  2068. "Highlight STRING according to TYPE, where erc-TYPE-face is an ERC face.
  2069. See also `erc-make-notice'."
  2070. (cond ((eq type 'notice)
  2071. (erc-make-notice string))
  2072. (t
  2073. (erc-put-text-property
  2074. 0 (length string)
  2075. 'face (or (intern-soft
  2076. (concat "erc-" (symbol-name type) "-face"))
  2077. "erc-default-face")
  2078. string)
  2079. string)))
  2080. (defun erc-display-message (parsed type buffer msg &rest args)
  2081. "Display MSG in BUFFER.
  2082. ARGS, PARSED, and TYPE are used to format MSG sensibly.
  2083. See also `erc-format-message' and `erc-display-line'."
  2084. (let ((string (if (symbolp msg)
  2085. (apply 'erc-format-message msg args)
  2086. msg)))
  2087. (setq string
  2088. (cond
  2089. ((null type)
  2090. string)
  2091. ((listp type)
  2092. (mapc (lambda (type)
  2093. (setq string
  2094. (erc-display-message-highlight type string)))
  2095. type)
  2096. string)
  2097. ((symbolp type)
  2098. (erc-display-message-highlight type string))))
  2099. (if (not (erc-response-p parsed))
  2100. (erc-display-line string buffer)
  2101. (unless (member (erc-response.command parsed) erc-hide-list)
  2102. (erc-put-text-property 0 (length string) 'erc-parsed parsed string)
  2103. (erc-put-text-property 0 (length string) 'rear-sticky t string)
  2104. (erc-display-line string buffer)))))
  2105. (defun erc-message-type-member (position list)
  2106. "Return non-nil if the erc-parsed text-property at POSITION is in LIST.
  2107. This function relies on the erc-parsed text-property being
  2108. present."
  2109. (let ((prop-val (erc-get-parsed-vector position)))
  2110. (and prop-val (member (erc-response.command prop-val) list))))
  2111. (defvar erc-send-input-line-function 'erc-send-input-line)
  2112. (make-variable-buffer-local 'erc-send-input-line-function)
  2113. (defun erc-send-input-line (target line &optional force)
  2114. "Send LINE to TARGET.
  2115. See also `erc-server-send'."
  2116. (setq line (format "PRIVMSG %s :%s"
  2117. target
  2118. ;; If the line is empty, we still want to
  2119. ;; send it - i.e. an empty pasted line.
  2120. (if (string= line "\n")
  2121. " \n"
  2122. line)))
  2123. (erc-server-send line force target))
  2124. (defun erc-get-arglist (fun)
  2125. "Return the argument list of a function without the parens."
  2126. (let ((arglist (format "%S" (erc-function-arglist fun))))
  2127. (if (string-match "^(\\(.*\\))$" arglist)
  2128. (match-string 1 arglist)
  2129. arglist)))
  2130. (defun erc-command-no-process-p (str)
  2131. "Return non-nil if STR is an ERC command that can be run when the process
  2132. is not alive, nil otherwise."
  2133. (let ((fun (erc-extract-command-from-line str)))
  2134. (and fun
  2135. (symbolp (car fun))
  2136. (get (car fun) 'process-not-needed))))
  2137. (defun erc-command-name (cmd)
  2138. "For CMD being the function name of a ERC command, something like
  2139. erc-cmd-FOO, this returns a string /FOO."
  2140. (let ((command-name (symbol-name cmd)))
  2141. (if (string-match "^erc-cmd-\\(.*\\)$" command-name)
  2142. (concat "/" (match-string 1 command-name))
  2143. command-name)))
  2144. (defun erc-process-input-line (line &optional force no-command)
  2145. "Translate LINE to an RFC1459 command and send it based.
  2146. Returns non-nil if the command is actually sent to the server, and nil
  2147. otherwise.
  2148. If the command in the LINE is not bound as a function `erc-cmd-<COMMAND>',
  2149. it is passed to `erc-cmd-default'. If LINE is not a command (i.e. doesn't
  2150. start with /<COMMAND>) then it is sent as a message.
  2151. An optional FORCE argument forces sending the line when flood
  2152. protection is in effect. The optional NO-COMMAND argument prohibits
  2153. this function from interpreting the line as a command."
  2154. (let ((command-list (erc-extract-command-from-line line)))
  2155. (if (and command-list
  2156. (not no-command))
  2157. (let* ((cmd (nth 0 command-list))
  2158. (args (nth 1 command-list)))
  2159. (condition-case nil
  2160. (if (listp args)
  2161. (apply cmd args)
  2162. (funcall cmd args))
  2163. (wrong-number-of-arguments
  2164. (erc-display-message nil 'error (current-buffer) 'incorrect-args
  2165. ?c (erc-command-name cmd)
  2166. ?u (or (erc-get-arglist cmd)
  2167. "")
  2168. ?d (format "%s\n"
  2169. (or (documentation cmd) "")))
  2170. nil)))
  2171. (let ((r (erc-default-target)))
  2172. (if r
  2173. (funcall erc-send-input-line-function r line force)
  2174. (erc-display-message nil 'error (current-buffer) 'no-target)
  2175. nil)))))
  2176. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2177. ;; Input commands handlers
  2178. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2179. (defun erc-cmd-AMSG (line)
  2180. "Send LINE to all channels of the current server that you are on."
  2181. (interactive "sSend to all channels you're on: ")
  2182. (setq line (erc-trim-string line))
  2183. (erc-with-all-buffers-of-server nil
  2184. (lambda ()
  2185. (erc-channel-p (erc-default-target)))
  2186. (erc-send-message line)))
  2187. (put 'erc-cmd-AMSG 'do-not-parse-args t)
  2188. (defun erc-cmd-SAY (line)
  2189. "Send LINE to the current query or channel as a message, not a command.
  2190. Use this when you want to send a message with a leading '/'. Note
  2191. that since multi-line messages are never a command, you don't
  2192. need this when pasting multiple lines of text."
  2193. (if (string-match "^\\s-*$" line)
  2194. nil
  2195. (string-match "^ ?\\(.*\\)" line)
  2196. (erc-process-input-line (match-string 1 line) nil t)))
  2197. (put 'erc-cmd-SAY 'do-not-parse-args t)
  2198. (defun erc-cmd-SET (line)
  2199. "Set the variable named by the first word in LINE to some VALUE.
  2200. VALUE is computed by evaluating the rest of LINE in Lisp."
  2201. (cond
  2202. ((string-match "^\\s-*\\(\\S-+\\)\\s-+\\(.*\\)$" line)
  2203. (let ((var (read (concat "erc-" (match-string 1 line))))
  2204. (val (read (match-string 2 line))))
  2205. (if (boundp var)
  2206. (progn
  2207. (set var (eval val))
  2208. (erc-display-message
  2209. nil nil 'active (format "Set %S to %S" var val))
  2210. t)
  2211. (setq var (read (match-string 1 line)))
  2212. (if (boundp var)
  2213. (progn
  2214. (set var (eval val))
  2215. (erc-display-message
  2216. nil nil 'active (format "Set %S to %S" var val))
  2217. t)
  2218. (erc-display-message nil 'error 'active 'variable-not-bound)
  2219. nil))))
  2220. ((string-match "^\\s-*$" line)
  2221. (erc-display-line
  2222. (concat "Available user variables:\n"
  2223. (apply
  2224. 'concat
  2225. (mapcar
  2226. (lambda (var)
  2227. (let ((val (symbol-value var)))
  2228. (concat (format "%S:" var)
  2229. (if (consp val)
  2230. (concat "\n" (pp-to-string val))
  2231. (format " %S\n" val)))))
  2232. (apropos-internal "^erc-" 'user-variable-p))))
  2233. (current-buffer)) t)
  2234. (t nil)))
  2235. (defalias 'erc-cmd-VAR 'erc-cmd-SET)
  2236. (defalias 'erc-cmd-VARIABLE 'erc-cmd-SET)
  2237. (put 'erc-cmd-SET 'do-not-parse-args t)
  2238. (put 'erc-cmd-SET 'process-not-needed t)
  2239. (defun erc-cmd-default (line)
  2240. "Fallback command.
  2241. Commands for which no erc-cmd-xxx exists, are tunneled through
  2242. this function. LINE is sent to the server verbatim, and
  2243. therefore has to contain the command itself as well."
  2244. (erc-log (format "cmd: DEFAULT: %s" line))
  2245. (erc-server-send (substring line 1))
  2246. t)
  2247. (defun erc-cmd-IGNORE (&optional user)
  2248. "Ignore USER. This should be a regexp matching nick!user@host.
  2249. If no USER argument is specified, list the contents of `erc-ignore-list'."
  2250. (if user
  2251. (let ((quoted (regexp-quote user)))
  2252. (when (and (not (string= user quoted))
  2253. (y-or-n-p (format "Use regexp-quoted form (%s) instead? "
  2254. quoted)))
  2255. (setq user quoted))
  2256. (erc-display-line
  2257. (erc-make-notice (format "Now ignoring %s" user))
  2258. 'active)
  2259. (erc-with-server-buffer (add-to-list 'erc-ignore-list user)))
  2260. (if (null (erc-with-server-buffer erc-ignore-list))
  2261. (erc-display-line (erc-make-notice "Ignore list is empty") 'active)
  2262. (erc-display-line (erc-make-notice "Ignore list:") 'active)
  2263. (mapc #'(lambda (item)
  2264. (erc-display-line (erc-make-notice item)
  2265. 'active))
  2266. (erc-with-server-buffer erc-ignore-list))))
  2267. t)
  2268. (defun erc-cmd-UNIGNORE (user)
  2269. "Remove the user specified in USER from the ignore list."
  2270. (let ((ignored-nick (car (erc-with-server-buffer
  2271. (erc-member-ignore-case (regexp-quote user)
  2272. erc-ignore-list)))))
  2273. (unless ignored-nick
  2274. (if (setq ignored-nick (erc-ignored-user-p user))
  2275. (unless (y-or-n-p (format "Remove this regexp (%s)? "
  2276. ignored-nick))
  2277. (setq ignored-nick nil))
  2278. (erc-display-line
  2279. (erc-make-notice (format "%s is not currently ignored!" user))
  2280. 'active)))
  2281. (when ignored-nick
  2282. (erc-display-line
  2283. (erc-make-notice (format "No longer ignoring %s" user))
  2284. 'active)
  2285. (erc-with-server-buffer
  2286. (setq erc-ignore-list (delete ignored-nick erc-ignore-list)))))
  2287. t)
  2288. (defun erc-cmd-CLEAR ()
  2289. "Clear the window content."
  2290. (recenter 0)
  2291. t)
  2292. (put 'erc-cmd-CLEAR 'process-not-needed t)
  2293. (defun erc-cmd-OPS ()
  2294. "Show the ops in the current channel."
  2295. (interactive)
  2296. (let ((ops nil))
  2297. (if erc-channel-users
  2298. (maphash (lambda (nick user-data)
  2299. (let ((cuser (cdr user-data)))
  2300. (if (and cuser
  2301. (erc-channel-user-op cuser))
  2302. (setq ops (cons (erc-server-user-nickname
  2303. (car user-data))
  2304. ops)))))
  2305. erc-channel-users))
  2306. (setq ops (sort ops 'string-lessp))
  2307. (if ops
  2308. (erc-display-message
  2309. nil 'notice (current-buffer) 'ops
  2310. ?i (length ops) ?s (if (> (length ops) 1) "s" "")
  2311. ?o (mapconcat 'identity ops " "))
  2312. (erc-display-message nil 'notice (current-buffer) 'ops-none)))
  2313. t)
  2314. (defun erc-cmd-COUNTRY (tld)
  2315. "Display the country associated with the top level domain TLD."
  2316. (require 'mail-extr)
  2317. (let ((co (ignore-errors (what-domain tld))))
  2318. (if co
  2319. (erc-display-message
  2320. nil 'notice 'active 'country ?c co ?d tld)
  2321. (erc-display-message
  2322. nil 'notice 'active 'country-unknown ?d tld))
  2323. t))
  2324. (put 'erc-cmd-COUNTRY 'process-not-needed t)
  2325. (defun erc-cmd-AWAY (line)
  2326. "Mark the user as being away, the reason being indicated by LINE.
  2327. If no reason is given, unset away status."
  2328. (when (string-match "^\\s-*\\(.*\\)$" line)
  2329. (let ((reason (match-string 1 line)))
  2330. (erc-log (format "cmd: AWAY: %s" reason))
  2331. (erc-server-send
  2332. (if (string= reason "")
  2333. "AWAY"
  2334. (concat "AWAY :" reason))))
  2335. t))
  2336. (put 'erc-cmd-AWAY 'do-not-parse-args t)
  2337. (defun erc-cmd-GAWAY (line)
  2338. "Mark the user as being away everywhere, the reason being indicated by LINE."
  2339. ;; on all server buffers.
  2340. (erc-with-all-buffers-of-server nil
  2341. #'erc-open-server-buffer-p
  2342. (erc-cmd-AWAY line)))
  2343. (put 'erc-cmd-GAWAY 'do-not-parse-args t)
  2344. (defun erc-cmd-CTCP (nick cmd &rest args)
  2345. "Send a Client To Client Protocol message to NICK.
  2346. CMD is the CTCP command, possible values being ECHO, FINGER, CLIENTINFO, TIME,
  2347. VERSION and so on. It is called with ARGS."
  2348. (let ((str (concat cmd
  2349. (when args
  2350. (concat " " (mapconcat #'identity args " "))))))
  2351. (erc-log (format "cmd: CTCP [%s]: [%s]" nick str))
  2352. (erc-send-ctcp-message nick str)
  2353. t))
  2354. (defun erc-cmd-HELP (&optional func)
  2355. "Popup help information.
  2356. If FUNC contains a valid function or variable, help about that
  2357. will be displayed. If FUNC is empty, display an apropos about
  2358. ERC commands. Otherwise, do `apropos' in the ERC namespace
  2359. \(\"erc-.*LINE\"\).
  2360. Examples:
  2361. To find out about erc and bbdb, do
  2362. /help bbdb.*
  2363. For help about the WHOIS command, do:
  2364. /help whois
  2365. For a list of user commands (/join /part, ...):
  2366. /help."
  2367. (if func
  2368. (let* ((sym (or (let ((sym (intern-soft
  2369. (concat "erc-cmd-" (upcase func)))))
  2370. (if (and sym (or (boundp sym) (fboundp sym)))
  2371. sym
  2372. nil))
  2373. (let ((sym (intern-soft func)))
  2374. (if (and sym (or (boundp sym) (fboundp sym)))
  2375. sym
  2376. nil))
  2377. (let ((sym (intern-soft (concat "erc-" func))))
  2378. (if (and sym (or (boundp sym) (fboundp sym)))
  2379. sym
  2380. nil)))))
  2381. (if sym
  2382. (cond
  2383. ((boundp sym) (describe-variable sym))
  2384. ((fboundp sym) (describe-function sym))
  2385. (t nil))
  2386. (apropos-command (concat "erc-.*" func) nil
  2387. (lambda (x)
  2388. (or (commandp x)
  2389. (get x 'custom-type))))
  2390. t))
  2391. (apropos "erc-cmd-")
  2392. (message "Type C-h m to get additional information about keybindings.")
  2393. t))
  2394. (defalias 'erc-cmd-H 'erc-cmd-HELP)
  2395. (put 'erc-cmd-HELP 'process-not-needed t)
  2396. (defun erc-cmd-JOIN (channel &optional key)
  2397. "Join the channel given in CHANNEL, optionally with KEY.
  2398. If CHANNEL is specified as \"-invite\", join the channel to which you
  2399. were most recently invited. See also `invitation'."
  2400. (let (chnl)
  2401. (if (string= (upcase channel) "-INVITE")
  2402. (if erc-invitation
  2403. (setq chnl erc-invitation)
  2404. (erc-display-message nil 'error (current-buffer) 'no-invitation))
  2405. (setq chnl (erc-ensure-channel-name channel)))
  2406. (when chnl
  2407. ;; Prevent double joining of same channel on same server.
  2408. (let ((joined-channels
  2409. (mapcar #'(lambda (chanbuf)
  2410. (with-current-buffer chanbuf (erc-default-target)))
  2411. (erc-channel-list erc-server-process))))
  2412. (if (erc-member-ignore-case chnl joined-channels)
  2413. (switch-to-buffer (car (erc-member-ignore-case chnl
  2414. joined-channels)))
  2415. (erc-log (format "cmd: JOIN: %s" chnl))
  2416. (if (and chnl key)
  2417. (erc-server-send (format "JOIN %s %s" chnl key))
  2418. (erc-server-send (format "JOIN %s" chnl)))))))
  2419. t)
  2420. (defalias 'erc-cmd-CHANNEL 'erc-cmd-JOIN)
  2421. (defalias 'erc-cmd-J 'erc-cmd-JOIN)
  2422. (defvar erc-channel-new-member-names nil
  2423. "If non-nil, a names list is currently being received.
  2424. If non-nil, this variable is a hash-table that associates
  2425. received nicks with t.")
  2426. (make-variable-buffer-local 'erc-channel-new-member-names)
  2427. (defun erc-cmd-NAMES (&optional channel)
  2428. "Display the users in CHANNEL.
  2429. If CHANNEL is not specified, display the users in the current channel.
  2430. This function clears the channel name list first, then sends the
  2431. command."
  2432. (let ((tgt (or (and (erc-channel-p channel) channel)
  2433. (erc-default-target))))
  2434. (if (and tgt (erc-channel-p tgt))
  2435. (progn
  2436. (erc-log (format "cmd: DEFAULT: NAMES %s" tgt))
  2437. (erc-with-buffer
  2438. (tgt)
  2439. (erc-channel-begin-receiving-names))
  2440. (erc-server-send (concat "NAMES " tgt)))
  2441. (erc-display-message nil 'error (current-buffer) 'no-default-channel)))
  2442. t)
  2443. (defalias 'erc-cmd-N 'erc-cmd-NAMES)
  2444. (defun erc-cmd-KICK (target &optional reason-or-nick &rest reasonwords)
  2445. "Kick the user indicated in LINE from the current channel.
  2446. LINE has the format: \"#CHANNEL NICK REASON\" or \"NICK REASON\"."
  2447. (let ((reasonstring (mapconcat 'identity reasonwords " ")))
  2448. (if (string= "" reasonstring)
  2449. (setq reasonstring (format "Kicked by %s" (erc-current-nick))))
  2450. (if (erc-channel-p target)
  2451. (let ((nick reason-or-nick))
  2452. (erc-log (format "cmd: KICK: %s/%s: %s" nick target reasonstring))
  2453. (erc-server-send (format "KICK %s %s :%s" target nick reasonstring)
  2454. nil target)
  2455. t)
  2456. (when target
  2457. (let ((ch (erc-default-target)))
  2458. (setq reasonstring (concat
  2459. (if reason-or-nick (concat reason-or-nick " "))
  2460. reasonstring))
  2461. (if ch
  2462. (progn
  2463. (erc-log
  2464. (format "cmd: KICK: %s/%s: %s" target ch reasonstring))
  2465. (erc-server-send
  2466. (format "KICK %s %s :%s" ch target reasonstring) nil ch))
  2467. (erc-display-message nil 'error (current-buffer)
  2468. 'no-default-channel))
  2469. t)))))
  2470. (defvar erc-script-args nil)
  2471. (defun erc-cmd-LOAD (line)
  2472. "Load the script provided in the LINE.
  2473. If LINE continues beyond the file name, the rest of
  2474. it is put in a (local) variable `erc-script-args',
  2475. which can be used in Emacs Lisp scripts.
  2476. The optional FORCE argument is ignored here - you can't force loading
  2477. a script after exceeding the flood threshold."
  2478. (cond
  2479. ((string-match "^\\s-*\\(\\S-+\\)\\(.*\\)$" line)
  2480. (let* ((file-to-find (match-string 1 line))
  2481. (erc-script-args (match-string 2 line))
  2482. (file (erc-find-file file-to-find erc-script-path)))
  2483. (erc-log (format "cmd: LOAD: %s" file-to-find))
  2484. (cond
  2485. ((not file)
  2486. (erc-display-message nil 'error (current-buffer)
  2487. 'cannot-find-file ?f file-to-find))
  2488. ((not (file-readable-p file))
  2489. (erc-display-message nil 'error (current-buffer)
  2490. 'cannot-read-file ?f file))
  2491. (t
  2492. (message "Loading \'%s\'..." file)
  2493. (erc-load-script file)
  2494. (message "Loading \'%s\'...done" file))))
  2495. t)
  2496. (t nil)))
  2497. (defun erc-cmd-WHOIS (user &optional server)
  2498. "Display whois information for USER.
  2499. If SERVER is non-nil, use that, rather than the current server."
  2500. ;; FIXME: is the above docstring correct? -- Lawrence 2004-01-08
  2501. (let ((send (if server
  2502. (format "WHOIS %s %s" user server)
  2503. (format "WHOIS %s" user))))
  2504. (erc-log (format "cmd: %s" send))
  2505. (erc-server-send send)
  2506. t))
  2507. (defalias 'erc-cmd-WI 'erc-cmd-WHOIS)
  2508. (defun erc-cmd-WHOAMI ()
  2509. "Display whois information about yourself."
  2510. (erc-cmd-WHOIS (erc-current-nick))
  2511. t)
  2512. (defun erc-cmd-IDLE (nick)
  2513. "Show the length of time NICK has been idle."
  2514. (let ((origbuf (current-buffer))
  2515. symlist)
  2516. (erc-with-server-buffer
  2517. (add-to-list 'symlist
  2518. (cons (erc-once-with-server-event
  2519. 311 `(string= ,nick
  2520. (second
  2521. (erc-response.command-args parsed))))
  2522. 'erc-server-311-functions))
  2523. (add-to-list 'symlist
  2524. (cons (erc-once-with-server-event
  2525. 312 `(string= ,nick
  2526. (second
  2527. (erc-response.command-args parsed))))
  2528. 'erc-server-312-functions))
  2529. (add-to-list 'symlist
  2530. (cons (erc-once-with-server-event
  2531. 318 `(string= ,nick
  2532. (second
  2533. (erc-response.command-args parsed))))
  2534. 'erc-server-318-functions))
  2535. (add-to-list 'symlist
  2536. (cons (erc-once-with-server-event
  2537. 319 `(string= ,nick
  2538. (second
  2539. (erc-response.command-args parsed))))
  2540. 'erc-server-319-functions))
  2541. (add-to-list 'symlist
  2542. (cons (erc-once-with-server-event
  2543. 320 `(string= ,nick
  2544. (second
  2545. (erc-response.command-args parsed))))
  2546. 'erc-server-320-functions))
  2547. (add-to-list 'symlist
  2548. (cons (erc-once-with-server-event
  2549. 330 `(string= ,nick
  2550. (second
  2551. (erc-response.command-args parsed))))
  2552. 'erc-server-330-functions))
  2553. (add-to-list 'symlist
  2554. (cons (erc-once-with-server-event
  2555. 317
  2556. `(let ((idleseconds
  2557. (string-to-number
  2558. (third
  2559. (erc-response.command-args parsed)))))
  2560. (erc-display-line
  2561. (erc-make-notice
  2562. (format "%s has been idle for %s."
  2563. (erc-string-no-properties ,nick)
  2564. (erc-seconds-to-string idleseconds)))
  2565. ,origbuf))
  2566. t)
  2567. 'erc-server-317-functions))
  2568. ;; Send the WHOIS command.
  2569. (erc-cmd-WHOIS nick)
  2570. ;; Remove the uninterned symbols from the server hooks that did not run.
  2571. (run-at-time 20 nil `(lambda ()
  2572. (with-current-buffer ,(current-buffer)
  2573. (dolist (sym ',symlist)
  2574. (let ((hooksym (cdr sym))
  2575. (funcsym (car sym)))
  2576. (remove-hook hooksym funcsym t))))))))
  2577. t)
  2578. (defun erc-cmd-DESCRIBE (line)
  2579. "Pose some action to a certain user.
  2580. LINE has the format \"USER ACTION\"."
  2581. (cond
  2582. ((string-match
  2583. "^\\s-*\\(\\S-+\\)\\s-\\(.*\\)$" line)
  2584. (let ((dst (match-string 1 line))
  2585. (s (match-string 2 line)))
  2586. (erc-log (format "cmd: DESCRIBE: [%s] %s" dst s))
  2587. (erc-send-action dst s))
  2588. t)
  2589. (t nil)))
  2590. (put 'erc-cmd-DESCRIBE 'do-not-parse-args t)
  2591. (defun erc-cmd-ME (line)
  2592. "Send LINE as an action."
  2593. (cond
  2594. ((string-match "^\\s-\\(.*\\)$" line)
  2595. (let ((s (match-string 1 line)))
  2596. (erc-log (format "cmd: ME: %s" s))
  2597. (erc-send-action (erc-default-target) s))
  2598. t)
  2599. (t nil)))
  2600. (put 'erc-cmd-ME 'do-not-parse-args t)
  2601. (defun erc-cmd-ME\'S (line)
  2602. "Do a /ME command, but add the string \" 's\" to the beginning."
  2603. (erc-cmd-ME (concat " 's" line)))
  2604. (put 'erc-cmd-ME\'S 'do-not-parse-args t)
  2605. (defun erc-cmd-LASTLOG (line)
  2606. "Show all lines in the current buffer matching the regexp LINE.
  2607. If a match spreads across multiple lines, all those lines are shown.
  2608. The lines are shown in a buffer named `*Occur*'.
  2609. It serves as a menu to find any of the occurrences in this buffer.
  2610. \\[describe-mode] in that buffer will explain how.
  2611. If LINE contains upper case characters (excluding those preceded by `\'),
  2612. the matching is case-sensitive."
  2613. (occur line)
  2614. t)
  2615. (put 'erc-cmd-LASTLOG 'do-not-parse-args t)
  2616. (put 'erc-cmd-LASTLOG 'process-not-needed t)
  2617. (defun erc-send-message (line &optional force)
  2618. "Send LINE to the current channel or user and display it.
  2619. See also `erc-message' and `erc-display-line'."
  2620. (erc-message "PRIVMSG" (concat (erc-default-target) " " line) force)
  2621. (erc-display-line
  2622. (concat (erc-format-my-nick) line)
  2623. (current-buffer))
  2624. ;; FIXME - treat multiline, run hooks, or remove me?
  2625. t)
  2626. (defun erc-cmd-MODE (line)
  2627. "Change or display the mode value of a channel or user.
  2628. The first word specifies the target. The rest is the mode string
  2629. to send.
  2630. If only one word is given, display the mode of that target.
  2631. A list of valid mode strings for Freenode may be found at
  2632. URL `http://freenode.net/using_the_network.shtml'."
  2633. (cond
  2634. ((string-match "^\\s-\\(.*\\)$" line)
  2635. (let ((s (match-string 1 line)))
  2636. (erc-log (format "cmd: MODE: %s" s))
  2637. (erc-server-send (concat "MODE " line)))
  2638. t)
  2639. (t nil)))
  2640. (put 'erc-cmd-MODE 'do-not-parse-args t)
  2641. (defun erc-cmd-NOTICE (channel-or-user &rest message)
  2642. "Send a notice to the channel or user given as the first word.
  2643. The rest is the message to send."
  2644. (erc-message "NOTICE" (concat channel-or-user " "
  2645. (mapconcat #'identity message " "))))
  2646. (defun erc-cmd-MSG (line)
  2647. "Send a message to the channel or user given as the first word in LINE.
  2648. The rest of LINE is the message to send."
  2649. (erc-message "PRIVMSG" line))
  2650. (defalias 'erc-cmd-M 'erc-cmd-MSG)
  2651. (put 'erc-cmd-MSG 'do-not-parse-args t)
  2652. (defun erc-cmd-SQUERY (line)
  2653. "Send a Service Query to the service given as the first word in LINE.
  2654. The rest of LINE is the message to send."
  2655. (erc-message "SQUERY" line))
  2656. (defun erc-cmd-NICK (nick)
  2657. "Change current nickname to NICK."
  2658. (erc-log (format "cmd: NICK: %s (erc-bad-nick: %S)" nick erc-bad-nick))
  2659. (let ((nicklen (cdr (assoc "NICKLEN" (erc-with-server-buffer
  2660. erc-server-parameters)))))
  2661. (and nicklen (> (length nick) (string-to-number nicklen))
  2662. (erc-display-message
  2663. nil 'notice 'active 'nick-too-long
  2664. ?i (length nick) ?l nicklen)))
  2665. (erc-server-send (format "NICK %s" nick))
  2666. (cond (erc-bad-nick
  2667. (erc-set-current-nick nick)
  2668. (erc-update-mode-line)
  2669. (setq erc-bad-nick nil)))
  2670. t)
  2671. (defun erc-cmd-PART (line)
  2672. "When LINE is an empty string, leave the current channel.
  2673. Otherwise leave the channel indicated by LINE."
  2674. (cond
  2675. ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-?\\(.*\\)$" line)
  2676. (let* ((ch (match-string 1 line))
  2677. (msg (match-string 2 line))
  2678. (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
  2679. (erc-log (format "cmd: PART: %s: %s" ch reason))
  2680. (erc-server-send (if (string= reason "")
  2681. (format "PART %s" ch)
  2682. (format "PART %s :%s" ch reason))
  2683. nil ch))
  2684. t)
  2685. ((string-match "^\\s-*\\(.*\\)$" line)
  2686. (let* ((ch (erc-default-target))
  2687. (msg (match-string 1 line))
  2688. (reason (funcall erc-part-reason (if (equal msg "") nil msg))))
  2689. (if (and ch (erc-channel-p ch))
  2690. (progn
  2691. (erc-log (format "cmd: PART: %s: %s" ch reason))
  2692. (erc-server-send (if (string= reason "")
  2693. (format "PART %s" ch)
  2694. (format "PART %s :%s" ch reason))
  2695. nil ch))
  2696. (erc-display-message nil 'error (current-buffer) 'no-target)))
  2697. t)
  2698. (t nil)))
  2699. (put 'erc-cmd-PART 'do-not-parse-args t)
  2700. (defalias 'erc-cmd-LEAVE 'erc-cmd-PART)
  2701. (defun erc-cmd-PING (recipient)
  2702. "Ping RECIPIENT."
  2703. (let ((time (format "%f" (erc-current-time))))
  2704. (erc-log (format "cmd: PING: %s" time))
  2705. (erc-cmd-CTCP recipient "PING" time)))
  2706. (defun erc-cmd-QUOTE (line)
  2707. "Send LINE directly to the server.
  2708. All the text given as argument is sent to the sever as unmodified,
  2709. just as you provided it. Use this command with care!"
  2710. (cond
  2711. ((string-match "^ ?\\(.+\\)$" line)
  2712. (erc-server-send (match-string 1 line)))
  2713. (t nil)))
  2714. (put 'erc-cmd-QUOTE 'do-not-parse-args t)
  2715. (defcustom erc-query-display 'window
  2716. "Indicates how to display query buffers when using the /QUERY
  2717. command to talk to someone.
  2718. The default behavior is to display the message in a new window
  2719. and bring it to the front. See the documentation for
  2720. `erc-join-buffer' for a description of the available choices.
  2721. See also `erc-auto-query' to decide how private messages from
  2722. other people should be displayed."
  2723. :group 'erc-query
  2724. :type '(choice (const :tag "Split window and select" window)
  2725. (const :tag "Split window, don't select" window-noselect)
  2726. (const :tag "New frame" frame)
  2727. (const :tag "Bury in new buffer" bury)
  2728. (const :tag "Use current buffer" buffer)
  2729. (const :tag "Use current buffer" t)))
  2730. (defun erc-cmd-QUERY (&optional user)
  2731. "Open a query with USER.
  2732. The type of query window/frame/etc will depend on the value of
  2733. `erc-query-display'.
  2734. If USER is omitted, close the current query buffer if one exists
  2735. - except this is broken now ;-)"
  2736. (interactive
  2737. (list (read-from-minibuffer "Start a query with: " nil)))
  2738. (let ((session-buffer (erc-server-buffer))
  2739. (erc-join-buffer erc-query-display))
  2740. (if user
  2741. (erc-query user session-buffer)
  2742. ;; currently broken, evil hack to display help anyway
  2743. ;(erc-delete-query))))
  2744. (signal 'wrong-number-of-arguments ""))))
  2745. (defalias 'erc-cmd-Q 'erc-cmd-QUERY)
  2746. (defun erc-quit-reason-normal (&optional s)
  2747. "Normal quit message.
  2748. If S is non-nil, it will be used as the quit reason."
  2749. (or s
  2750. (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
  2751. erc-version-string) ; erc-official-location)
  2752. ))
  2753. (defun erc-quit-reason-zippy (&optional s)
  2754. "Zippy quit message.
  2755. If S is non-nil, it will be used as the quit reason."
  2756. (or s
  2757. (erc-replace-regexp-in-string "\n" "" (yow))))
  2758. (defun erc-quit-reason-various (s)
  2759. "Choose a quit reason based on S (a string)."
  2760. (when (featurep 'xemacs) (require 'poe))
  2761. (let ((res (car (assoc-default (or s "")
  2762. erc-quit-reason-various-alist 'string-match))))
  2763. (cond
  2764. ((functionp res) (funcall res))
  2765. ((stringp res) res)
  2766. (s s)
  2767. (t (erc-quit-reason-normal)))))
  2768. (defun erc-part-reason-normal (&optional s)
  2769. "Normal part message.
  2770. If S is non-nil, it will be used as the quit reason."
  2771. (or s
  2772. (format "\C-bERC\C-b %s (IRC client for Emacs)"; - \C-b%s\C-b"
  2773. erc-version-string) ; erc-official-location)
  2774. ))
  2775. (defun erc-part-reason-zippy (&optional s)
  2776. "Zippy part message.
  2777. If S is non-nil, it will be used as the quit reason."
  2778. (or s
  2779. (erc-replace-regexp-in-string "\n" "" (yow))))
  2780. (defun erc-part-reason-various (s)
  2781. "Choose a part reason based on S (a string)."
  2782. (when (featurep 'xemacs) (require 'poe))
  2783. (let ((res (car (assoc-default (or s "")
  2784. erc-part-reason-various-alist 'string-match))))
  2785. (cond
  2786. ((functionp res) (funcall res))
  2787. ((stringp res) res)
  2788. (s s)
  2789. (t (erc-part-reason-normal)))))
  2790. (defun erc-cmd-QUIT (reason)
  2791. "Disconnect from the current server.
  2792. If REASON is omitted, display a default quit message, otherwise display
  2793. the message given by REASON."
  2794. (unless reason
  2795. (setq reason ""))
  2796. (cond
  2797. ((string-match "^\\s-*\\(.*\\)$" reason)
  2798. (let* ((s (match-string 1 reason))
  2799. (buffer (erc-server-buffer))
  2800. (reason (funcall erc-quit-reason (if (equal s "") nil s)))
  2801. server-proc)
  2802. (with-current-buffer (if (and buffer
  2803. (bufferp buffer))
  2804. buffer
  2805. (current-buffer))
  2806. (erc-log (format "cmd: QUIT: %s" reason))
  2807. (setq erc-server-quitting t)
  2808. (erc-set-active-buffer (erc-server-buffer))
  2809. (setq server-proc erc-server-process)
  2810. (erc-server-send (format "QUIT :%s" reason)))
  2811. (run-hook-with-args 'erc-quit-hook server-proc)
  2812. (when erc-kill-queries-on-quit
  2813. (erc-kill-query-buffers server-proc))
  2814. ;; if the process has not been killed within 4 seconds, kill it
  2815. (run-at-time 4 nil
  2816. (lambda (proc)
  2817. (when (and (processp proc)
  2818. (memq (process-status proc) '(run open)))
  2819. (delete-process proc)))
  2820. server-proc))
  2821. t)
  2822. (t nil)))
  2823. (defalias 'erc-cmd-BYE 'erc-cmd-QUIT)
  2824. (defalias 'erc-cmd-EXIT 'erc-cmd-QUIT)
  2825. (defalias 'erc-cmd-SIGNOFF 'erc-cmd-QUIT)
  2826. (put 'erc-cmd-QUIT 'do-not-parse-args t)
  2827. (put 'erc-cmd-QUIT 'process-not-needed t)
  2828. (defun erc-cmd-GQUIT (reason)
  2829. "Disconnect from all servers at once with the same quit REASON."
  2830. (erc-with-all-buffers-of-server nil #'erc-open-server-buffer-p
  2831. (erc-cmd-QUIT reason))
  2832. (when erc-kill-queries-on-quit
  2833. ;; if the query buffers have not been killed within 4 seconds,
  2834. ;; kill them
  2835. (run-at-time
  2836. 4 nil
  2837. (lambda ()
  2838. (dolist (buffer (erc-buffer-list (lambda (buf)
  2839. (not (erc-server-buffer-p buf)))))
  2840. (kill-buffer buffer)))))
  2841. t)
  2842. (defalias 'erc-cmd-GQ 'erc-cmd-GQUIT)
  2843. (put 'erc-cmd-GQUIT 'do-not-parse-args t)
  2844. (put 'erc-cmd-GQUIT 'process-not-needed t)
  2845. (defun erc-cmd-RECONNECT ()
  2846. "Try to reconnect to the current IRC server."
  2847. (let ((buffer (erc-server-buffer))
  2848. (process nil))
  2849. (unless (buffer-live-p buffer)
  2850. (setq buffer (current-buffer)))
  2851. (with-current-buffer buffer
  2852. (setq erc-server-quitting nil)
  2853. (setq erc-server-reconnecting t)
  2854. (setq erc-server-reconnect-count 0)
  2855. (setq process (get-buffer-process (erc-server-buffer)))
  2856. (if process
  2857. (delete-process process)
  2858. (erc-server-reconnect))
  2859. (setq erc-server-reconnecting nil)))
  2860. t)
  2861. (put 'erc-cmd-RECONNECT 'process-not-needed t)
  2862. (defun erc-cmd-SERVER (server)
  2863. "Connect to SERVER, leaving existing connection intact."
  2864. (erc-log (format "cmd: SERVER: %s" server))
  2865. (condition-case nil
  2866. (erc :server server :nick (erc-current-nick))
  2867. (error
  2868. (erc-error "Cannot find host %s." server)))
  2869. t)
  2870. (put 'erc-cmd-SERVER 'process-not-needed t)
  2871. (defvar motif-version-string)
  2872. (defvar gtk-version-string)
  2873. (defun erc-cmd-SV ()
  2874. "Say the current ERC and Emacs version into channel."
  2875. (erc-send-message (format "I'm using ERC %s with %s %s (%s%s) of %s."
  2876. erc-version-string
  2877. (if (featurep 'xemacs) "XEmacs" "GNU Emacs")
  2878. emacs-version
  2879. system-configuration
  2880. (concat
  2881. (cond ((featurep 'motif)
  2882. (concat ", " (substring
  2883. motif-version-string 4)))
  2884. ((featurep 'gtk)
  2885. (concat ", GTK+ Version "
  2886. gtk-version-string))
  2887. ((featurep 'x-toolkit) ", X toolkit")
  2888. (t ""))
  2889. (if (and (boundp 'x-toolkit-scroll-bars)
  2890. (memq x-toolkit-scroll-bars
  2891. '(xaw xaw3d)))
  2892. (format ", %s scroll bars"
  2893. (capitalize (symbol-name
  2894. x-toolkit-scroll-bars)))
  2895. "")
  2896. (if (featurep 'multi-tty) ", multi-tty" ""))
  2897. erc-emacs-build-time))
  2898. t)
  2899. (defun erc-cmd-SM ()
  2900. "Say the current ERC modes into channel."
  2901. (erc-send-message (format "I'm using the following modules: %s!"
  2902. (erc-modes)))
  2903. t)
  2904. (defun erc-cmd-DEOP (&rest people)
  2905. "Remove the operator setting from user(s) given in PEOPLE."
  2906. (when (> (length people) 0)
  2907. (erc-server-send (concat "MODE " (erc-default-target)
  2908. " -"
  2909. (make-string (length people) ?o)
  2910. " "
  2911. (mapconcat 'identity people " ")))
  2912. t))
  2913. (defun erc-cmd-OP (&rest people)
  2914. "Add the operator setting to users(s) given in PEOPLE."
  2915. (when (> (length people) 0)
  2916. (erc-server-send (concat "MODE " (erc-default-target)
  2917. " +"
  2918. (make-string (length people) ?o)
  2919. " "
  2920. (mapconcat 'identity people " ")))
  2921. t))
  2922. (defun erc-cmd-TIME (&optional line)
  2923. "Request the current time and date from the current server."
  2924. (cond
  2925. ((and line (string-match "^\\s-*\\(.*\\)$" line))
  2926. (let ((args (match-string 1 line)))
  2927. (erc-log (format "cmd: TIME: %s" args))
  2928. (erc-server-send (concat "TIME " args)))
  2929. t)
  2930. (t (erc-server-send "TIME"))))
  2931. (defalias 'erc-cmd-DATE 'erc-cmd-TIME)
  2932. (defun erc-cmd-TOPIC (topic)
  2933. "Set or request the topic for a channel.
  2934. LINE has the format: \"#CHANNEL TOPIC\", \"#CHANNEL\", \"TOPIC\"
  2935. or the empty string.
  2936. If no #CHANNEL is given, the default channel is used. If TOPIC is
  2937. given, the channel topic is modified, otherwise the current topic will
  2938. be displayed."
  2939. (cond
  2940. ;; /topic #channel TOPIC
  2941. ((string-match "^\\s-*\\([&#+!]\\S-+\\)\\s-\\(.*\\)$" topic)
  2942. (let ((ch (match-string 1 topic))
  2943. (topic (match-string 2 topic)))
  2944. (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
  2945. (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
  2946. t)
  2947. ;; /topic #channel
  2948. ((string-match "^\\s-*\\([&#+!]\\S-+\\)" topic)
  2949. (let ((ch (match-string 1 topic)))
  2950. (erc-server-send (format "TOPIC %s" ch) nil ch)
  2951. t))
  2952. ;; /topic
  2953. ((string-match "^\\s-*$" topic)
  2954. (let ((ch (erc-default-target)))
  2955. (erc-server-send (format "TOPIC %s" ch) nil ch)
  2956. t))
  2957. ;; /topic TOPIC
  2958. ((string-match "^\\s-*\\(.*\\)$" topic)
  2959. (let ((ch (erc-default-target))
  2960. (topic (match-string 1 topic)))
  2961. (if (and ch (erc-channel-p ch))
  2962. (progn
  2963. (erc-log (format "cmd: TOPIC [%s]: %s" ch topic))
  2964. (erc-server-send (format "TOPIC %s :%s" ch topic) nil ch))
  2965. (erc-display-message nil 'error (current-buffer) 'no-target)))
  2966. t)
  2967. (t nil)))
  2968. (defalias 'erc-cmd-T 'erc-cmd-TOPIC)
  2969. (put 'erc-cmd-TOPIC 'do-not-parse-args t)
  2970. (defun erc-cmd-APPENDTOPIC (topic)
  2971. "Append TOPIC to the current channel topic, separated by a space."
  2972. (let ((oldtopic erc-channel-topic))
  2973. ;; display help when given no arguments
  2974. (when (string-match "^\\s-*$" topic)
  2975. (signal 'wrong-number-of-arguments nil))
  2976. ;; strip trailing ^O
  2977. (when (string-match "\\(.*\\)\C-o" oldtopic)
  2978. (erc-cmd-TOPIC (concat (match-string 1 oldtopic) topic)))))
  2979. (defalias 'erc-cmd-AT 'erc-cmd-APPENDTOPIC)
  2980. (put 'erc-cmd-APPENDTOPIC 'do-not-parse-args t)
  2981. (defun erc-cmd-CLEARTOPIC (&optional channel)
  2982. "Clear the topic for a CHANNEL.
  2983. If CHANNEL is not specified, clear the topic for the default channel."
  2984. (interactive "sClear topic of channel (RET is current channel): ")
  2985. (let ((chnl (or (and (erc-channel-p channel) channel) (erc-default-target))))
  2986. (when chnl
  2987. (erc-server-send (format "TOPIC %s :" chnl))
  2988. t)))
  2989. ;;; Banlists
  2990. (defvar erc-channel-banlist nil
  2991. "A list of bans seen for the current channel.
  2992. Each ban is an alist of the form:
  2993. (WHOSET . MASK)
  2994. The property `received-from-server' indicates whether
  2995. or not the ban list has been requested from the server.")
  2996. (make-variable-buffer-local 'erc-channel-banlist)
  2997. (put 'erc-channel-banlist 'received-from-server nil)
  2998. (defun erc-cmd-BANLIST ()
  2999. "Pretty-print the contents of `erc-channel-banlist'.
  3000. The ban list is fetched from the server if necessary."
  3001. (let ((chnl (erc-default-target))
  3002. (chnl-name (buffer-name)))
  3003. (cond
  3004. ((not (erc-channel-p chnl))
  3005. (erc-display-line (erc-make-notice "You're not on a channel\n")
  3006. 'active))
  3007. ((not (get 'erc-channel-banlist 'received-from-server))
  3008. (let ((old-367-hook erc-server-367-functions))
  3009. (setq erc-server-367-functions 'erc-banlist-store
  3010. erc-channel-banlist nil)
  3011. ;; fetch the ban list then callback
  3012. (erc-with-server-buffer
  3013. (erc-once-with-server-event
  3014. 368
  3015. `(with-current-buffer ,chnl-name
  3016. (put 'erc-channel-banlist 'received-from-server t)
  3017. (setq erc-server-367-functions ',old-367-hook)
  3018. (erc-cmd-BANLIST)
  3019. t))
  3020. (erc-server-send (format "MODE %s b" chnl)))))
  3021. ((null erc-channel-banlist)
  3022. (erc-display-line (erc-make-notice
  3023. (format "No bans for channel: %s\n" chnl))
  3024. 'active)
  3025. (put 'erc-channel-banlist 'received-from-server nil))
  3026. (t
  3027. (let* ((erc-fill-column (or (and (boundp 'erc-fill-column)
  3028. erc-fill-column)
  3029. (and (boundp 'fill-column)
  3030. fill-column)
  3031. (1- (window-width))))
  3032. (separator (make-string erc-fill-column ?=))
  3033. (fmt (concat
  3034. "%-" (number-to-string (/ erc-fill-column 2)) "s"
  3035. "%" (number-to-string (/ erc-fill-column 2)) "s")))
  3036. (erc-display-line
  3037. (erc-make-notice (format "Ban list for channel: %s\n"
  3038. (erc-default-target)))
  3039. 'active)
  3040. (erc-display-line separator 'active)
  3041. (erc-display-line (format fmt "Ban Mask" "Banned By") 'active)
  3042. (erc-display-line separator 'active)
  3043. (mapc
  3044. (lambda (x)
  3045. (erc-display-line
  3046. (format fmt
  3047. (truncate-string-to-width (cdr x) (/ erc-fill-column 2))
  3048. (if (car x)
  3049. (truncate-string-to-width (car x) (/ erc-fill-column 2))
  3050. ""))
  3051. 'active))
  3052. erc-channel-banlist)
  3053. (erc-display-line (erc-make-notice "End of Ban list")
  3054. 'active)
  3055. (put 'erc-channel-banlist 'received-from-server nil)))))
  3056. t)
  3057. (defalias 'erc-cmd-BL 'erc-cmd-BANLIST)
  3058. (defun erc-cmd-MASSUNBAN ()
  3059. "Mass Unban.
  3060. Unban all currently banned users in the current channel."
  3061. (let ((chnl (erc-default-target)))
  3062. (cond
  3063. ((not (erc-channel-p chnl))
  3064. (erc-display-line
  3065. (erc-make-notice "You're not on a channel\n")
  3066. 'active))
  3067. ((not (get 'erc-channel-banlist 'received-from-server))
  3068. (let ((old-367-hook erc-server-367-functions))
  3069. (setq erc-server-367-functions 'erc-banlist-store)
  3070. ;; fetch the ban list then callback
  3071. (erc-with-server-buffer
  3072. (erc-once-with-server-event
  3073. 368
  3074. `(with-current-buffer ,chnl
  3075. (put 'erc-channel-banlist 'received-from-server t)
  3076. (setq erc-server-367-functions ,old-367-hook)
  3077. (erc-cmd-MASSUNBAN)
  3078. t))
  3079. (erc-server-send (format "MODE %s b" chnl)))))
  3080. (t (let ((bans (mapcar 'cdr erc-channel-banlist)))
  3081. (when bans
  3082. ;; Glob the bans into groups of three, and carry out the unban.
  3083. ;; eg. /mode #foo -bbb a*!*@* b*!*@* c*!*@*
  3084. (mapc
  3085. (lambda (x)
  3086. (erc-server-send
  3087. (format "MODE %s -%s %s" (erc-default-target)
  3088. (make-string (length x) ?b)
  3089. (mapconcat 'identity x " "))))
  3090. (erc-group-list bans 3))))
  3091. t))))
  3092. (defalias 'erc-cmd-MUB 'erc-cmd-MASSUNBAN)
  3093. ;;;; End of IRC commands
  3094. (defun erc-ensure-channel-name (channel)
  3095. "Return CHANNEL if it is a valid channel name.
  3096. Eventually add a # in front of it, if that turns it into a valid channel name."
  3097. (if (erc-channel-p channel)
  3098. channel
  3099. (concat "#" channel)))
  3100. (defun erc-grab-region (start end)
  3101. "Copy the region between START and END in a recreatable format.
  3102. Converts all the IRC text properties in each line of the region
  3103. into control codes and writes them to a separate buffer. The
  3104. resulting text may be used directly as a script to generate this
  3105. text again."
  3106. (interactive "r")
  3107. (erc-set-active-buffer (current-buffer))
  3108. (save-excursion
  3109. (let* ((cb (current-buffer))
  3110. (buf (generate-new-buffer erc-grab-buffer-name))
  3111. (region (buffer-substring start end))
  3112. (lines (erc-split-multiline-safe region)))
  3113. (set-buffer buf)
  3114. (dolist (line lines)
  3115. (insert (concat line "\n")))
  3116. (set-buffer cb)
  3117. (switch-to-buffer-other-window buf)))
  3118. (message "erc-grab-region doesn't grab colors etc. anymore. If you use this, please tell the maintainers.")
  3119. (ding))
  3120. (defun erc-display-prompt (&optional buffer pos prompt face)
  3121. "Display PROMPT in BUFFER at position POS.
  3122. Display an ERC prompt in BUFFER.
  3123. If PROMPT is nil, one is constructed with the function `erc-prompt'.
  3124. If BUFFER is nil, the `current-buffer' is used.
  3125. If POS is nil, PROMPT will be displayed at `point'.
  3126. If FACE is non-nil, it will be used to propertize the prompt. If it is nil,
  3127. `erc-prompt-face' will be used."
  3128. (let* ((prompt (or prompt (erc-prompt)))
  3129. (l (length prompt))
  3130. (ob (current-buffer)))
  3131. ;; We cannot use save-excursion because we move point, therefore
  3132. ;; we resort to the ol' ob trick to restore this.
  3133. (when (and buffer (bufferp buffer))
  3134. (set-buffer buffer))
  3135. ;; now save excursion again to store where point and mark are
  3136. ;; in the current buffer
  3137. (save-excursion
  3138. (setq pos (or pos (point)))
  3139. (goto-char pos)
  3140. (when (> l 0)
  3141. ;; Do not extend the text properties when typing at the end
  3142. ;; of the prompt, but stuff typed in front of the prompt
  3143. ;; shall remain part of the prompt.
  3144. (setq prompt (erc-propertize prompt
  3145. 'start-open t ; XEmacs
  3146. 'rear-nonsticky t ; Emacs
  3147. 'erc-prompt t
  3148. 'front-sticky t
  3149. 'read-only t))
  3150. (erc-put-text-property 0 (1- (length prompt))
  3151. 'face (or face 'erc-prompt-face)
  3152. prompt)
  3153. (insert prompt))
  3154. ;; Set the input marker
  3155. (set-marker erc-input-marker (point)))
  3156. ;; Now we are back at the old position. If the prompt was
  3157. ;; inserted here or before us, advance point by the length of
  3158. ;; the prompt.
  3159. (when (or (not pos) (<= (point) pos))
  3160. (forward-char l))
  3161. ;; Clear the undo buffer now, so the user can undo his stuff,
  3162. ;; but not the stuff we did. Sneaky!
  3163. (setq buffer-undo-list nil)
  3164. (set-buffer ob)))
  3165. ;; interactive operations
  3166. (defun erc-input-message ()
  3167. "Read input from the minibuffer."
  3168. (interactive)
  3169. (let ((minibuffer-allow-text-properties t)
  3170. (read-map minibuffer-local-map))
  3171. (insert (read-from-minibuffer "Message: "
  3172. (string (if (featurep 'xemacs)
  3173. last-command-char
  3174. last-command-event)) read-map))
  3175. (erc-send-current-line)))
  3176. (defvar erc-action-history-list ()
  3177. "History list for interactive action input.")
  3178. (defun erc-input-action ()
  3179. "Interactively input a user action and send it to IRC."
  3180. (interactive "")
  3181. (erc-set-active-buffer (current-buffer))
  3182. (let ((action (read-from-minibuffer
  3183. "Action: " nil nil nil 'erc-action-history-list)))
  3184. (if (not (string-match "^\\s-*$" action))
  3185. (erc-send-action (erc-default-target) action))))
  3186. (defun erc-join-channel (channel &optional key)
  3187. "Join CHANNEL.
  3188. If `point' is at the beginning of a channel name, use that as default."
  3189. (interactive
  3190. (list
  3191. (let ((chnl (if (looking-at "\\([&#+!][^ \n]+\\)") (match-string 1) ""))
  3192. (table (when (erc-server-buffer-live-p)
  3193. (set-buffer (process-buffer erc-server-process))
  3194. erc-channel-list)))
  3195. (completing-read "Join channel: " table nil nil nil nil chnl))
  3196. (when (or current-prefix-arg erc-prompt-for-channel-key)
  3197. (read-from-minibuffer "Channel key (RET for none): " nil))))
  3198. (erc-cmd-JOIN channel (when (>= (length key) 1) key)))
  3199. (defun erc-part-from-channel (reason)
  3200. "Part from the current channel and prompt for a REASON."
  3201. (interactive
  3202. (list
  3203. (if (and (boundp 'reason) (stringp reason) (not (string= reason "")))
  3204. reason
  3205. (read-from-minibuffer (concat "Reason for leaving " (erc-default-target)
  3206. ": ")))))
  3207. (erc-cmd-PART (concat (erc-default-target)" " reason)))
  3208. (defun erc-set-topic (topic)
  3209. "Prompt for a TOPIC for the current channel."
  3210. (interactive
  3211. (list
  3212. (read-from-minibuffer
  3213. (concat "Set topic of " (erc-default-target) ": ")
  3214. (when erc-channel-topic
  3215. (let ((ss (split-string erc-channel-topic "\C-o")))
  3216. (cons (apply 'concat (if (cdr ss) (butlast ss) ss))
  3217. 0))))))
  3218. (let ((topic-list (split-string topic "\C-o"))) ; strip off the topic setter
  3219. (erc-cmd-TOPIC (concat (erc-default-target) " " (car topic-list)))))
  3220. (defun erc-set-channel-limit (&optional limit)
  3221. "Set a LIMIT for the current channel. Remove limit if nil.
  3222. Prompt for one if called interactively."
  3223. (interactive (list (read-from-minibuffer
  3224. (format "Limit for %s (RET to remove limit): "
  3225. (erc-default-target)))))
  3226. (let ((tgt (erc-default-target)))
  3227. (if (and limit (>= (length limit) 1))
  3228. (erc-server-send (format "MODE %s +l %s" tgt limit))
  3229. (erc-server-send (format "MODE %s -l" tgt)))))
  3230. (defun erc-set-channel-key (&optional key)
  3231. "Set a KEY for the current channel. Remove key if nil.
  3232. Prompt for one if called interactively."
  3233. (interactive (list (read-from-minibuffer
  3234. (format "Key for %s (RET to remove key): "
  3235. (erc-default-target)))))
  3236. (let ((tgt (erc-default-target)))
  3237. (if (and key (>= (length key) 1))
  3238. (erc-server-send (format "MODE %s +k %s" tgt key))
  3239. (erc-server-send (format "MODE %s -k" tgt)))))
  3240. (defun erc-quit-server (reason)
  3241. "Disconnect from current server after prompting for REASON.
  3242. `erc-quit-reason' works with this just like with `erc-cmd-QUIT'."
  3243. (interactive (list (read-from-minibuffer
  3244. (format "Reason for quitting %s: "
  3245. (or erc-server-announced-name
  3246. erc-session-server)))))
  3247. (erc-cmd-QUIT reason))
  3248. ;; Movement of point
  3249. (defun erc-bol ()
  3250. "Move `point' to the beginning of the current line.
  3251. This places `point' just after the prompt, or at the beginning of the line."
  3252. (interactive)
  3253. (forward-line 0)
  3254. (when (get-text-property (point) 'erc-prompt)
  3255. (goto-char erc-input-marker))
  3256. (point))
  3257. (defun erc-kill-input ()
  3258. "Kill current input line using `erc-bol' followed by `kill-line'."
  3259. (interactive)
  3260. (when (and (erc-bol)
  3261. (/= (point) (point-max))) ;; Prevent a (ding) and an error when
  3262. ;; there's nothing to kill
  3263. (if (boundp 'erc-input-ring-index)
  3264. (setq erc-input-ring-index nil))
  3265. (kill-line)))
  3266. (defun erc-complete-word-at-point ()
  3267. (run-hook-with-args-until-success 'erc-complete-functions))
  3268. (define-obsolete-function-alias 'erc-complete-word 'completion-at-point "24.1")
  3269. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3270. ;;
  3271. ;; IRC SERVER INPUT HANDLING
  3272. ;;
  3273. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3274. ;;;; New Input parsing
  3275. ; Stolen from ZenIRC. I just wanna test this code, so here is
  3276. ; experiment area.
  3277. (defcustom erc-default-server-hook '(erc-debug-missing-hooks
  3278. erc-default-server-handler)
  3279. "*Default for server messages which aren't covered by `erc-server-hooks'."
  3280. :group 'erc-server-hooks
  3281. :type 'hook)
  3282. (defun erc-default-server-handler (proc parsed)
  3283. "Default server handler.
  3284. Displays PROC and PARSED appropriately using `erc-display-message'."
  3285. (erc-display-message
  3286. parsed 'notice proc
  3287. (mapconcat
  3288. 'identity
  3289. (let (res)
  3290. (mapc #'(lambda (x)
  3291. (if (stringp x)
  3292. (setq res (append res (list x)))))
  3293. parsed)
  3294. res)
  3295. " ")))
  3296. (defvar erc-server-vectors
  3297. '(["msgtype" "sender" "to" "arg1" "arg2" "arg3" "..."])
  3298. "List of received server messages which ERC does not specifically handle.
  3299. See `erc-debug-missing-hooks'.")
  3300. ;(make-variable-buffer-local 'erc-server-vectors)
  3301. (defun erc-debug-missing-hooks (proc parsed)
  3302. "Add PARSED server message ERC does not yet handle to `erc-server-vectors'.
  3303. These vectors can be helpful when adding new server message handlers to ERC.
  3304. See `erc-default-server-hook'."
  3305. (nconc erc-server-vectors (list parsed))
  3306. nil)
  3307. (defun erc-query (target server)
  3308. "Open a query buffer on TARGET, using SERVER.
  3309. To change how this query window is displayed, use `let' to bind
  3310. `erc-join-buffer' before calling this."
  3311. (unless (and server
  3312. (buffer-live-p server)
  3313. (set-buffer server))
  3314. (error "Couldn't switch to server buffer"))
  3315. (let ((buf (erc-open erc-session-server
  3316. erc-session-port
  3317. (erc-current-nick)
  3318. erc-session-user-full-name
  3319. nil
  3320. nil
  3321. (list target)
  3322. target
  3323. erc-server-process)))
  3324. (unless buf
  3325. (error "Couldn't open query window"))
  3326. (erc-update-mode-line)
  3327. buf))
  3328. (defcustom erc-auto-query 'window-noselect
  3329. "If non-nil, create a query buffer each time you receive a private message.
  3330. If the buffer doesn't already exist, it is created.
  3331. This can be set to a symbol, to control how the new query window
  3332. should appear. The default behavior is to display the buffer in
  3333. a new window, but not to select it. See the documentation for
  3334. `erc-join-buffer' for a description of the available choices."
  3335. :group 'erc-query
  3336. :type '(choice (const :tag "Don't create query window" nil)
  3337. (const :tag "Split window and select" window)
  3338. (const :tag "Split window, don't select" window-noselect)
  3339. (const :tag "New frame" frame)
  3340. (const :tag "Bury in new buffer" bury)
  3341. (const :tag "Use current buffer" buffer)
  3342. (const :tag "Use current buffer" t)))
  3343. (defcustom erc-query-on-unjoined-chan-privmsg t
  3344. "If non-nil create query buffer on receiving any PRIVMSG at all.
  3345. This includes PRIVMSGs directed to channels. If you are using an IRC
  3346. bouncer, such as dircproxy, to keep a log of channels when you are
  3347. disconnected, you should set this option to t."
  3348. :group 'erc-query
  3349. :type 'boolean)
  3350. (defcustom erc-format-query-as-channel-p t
  3351. "If non-nil, format text from others in a query buffer like in a channel,
  3352. otherwise format like a private message."
  3353. :group 'erc-query
  3354. :type 'boolean)
  3355. (defcustom erc-minibuffer-notice nil
  3356. "If non-nil, print ERC notices for the user in the minibuffer.
  3357. Only happens when the session buffer isn't visible."
  3358. :group 'erc-display
  3359. :type 'boolean)
  3360. (defcustom erc-minibuffer-ignored nil
  3361. "If non-nil, print a message in the minibuffer if we ignored something."
  3362. :group 'erc-ignore
  3363. :type 'boolean)
  3364. (defun erc-wash-quit-reason (reason nick login host)
  3365. "Remove duplicate text from quit REASON.
  3366. Specifically in relation to NICK (user@host) information. Returns REASON
  3367. unmodified if nothing can be removed.
  3368. E.g. \"Read error to Nick [user@some.host]: 110\" would be shortened to
  3369. \"Read error: 110\". The same applies for \"Ping Timeout\"."
  3370. (setq nick (regexp-quote nick)
  3371. login (regexp-quote login)
  3372. host (regexp-quote host))
  3373. (or (when (string-match (concat "^\\(Read error\\) to "
  3374. nick "\\[" host "\\]: "
  3375. "\\(.+\\)$") reason)
  3376. (concat (match-string 1 reason) ": " (match-string 2 reason)))
  3377. (when (string-match (concat "^\\(Ping timeout\\) for "
  3378. nick "\\[" host "\\]$") reason)
  3379. (match-string 1 reason))
  3380. reason))
  3381. (defun erc-nickname-in-use (nick reason)
  3382. "If NICK is unavailable, tell the user the REASON.
  3383. See also `erc-display-error-notice'."
  3384. (if (or (not erc-try-new-nick-p)
  3385. ;; how many default-nicks are left + one more try...
  3386. (eq erc-nick-change-attempt-count
  3387. (if (consp erc-nick)
  3388. (+ (length erc-nick) 1)
  3389. 1)))
  3390. (erc-display-error-notice
  3391. nil
  3392. (format "Nickname %s is %s, try another." nick reason))
  3393. (setq erc-nick-change-attempt-count (+ erc-nick-change-attempt-count 1))
  3394. (let ((newnick (nth 1 erc-default-nicks))
  3395. (nicklen (cdr (assoc "NICKLEN"
  3396. (erc-with-server-buffer
  3397. erc-server-parameters)))))
  3398. (setq erc-bad-nick t)
  3399. ;; try to use a different nick
  3400. (if erc-default-nicks
  3401. (setq erc-default-nicks (cdr erc-default-nicks)))
  3402. (if (not newnick)
  3403. (setq newnick (concat (truncate-string-to-width
  3404. nick
  3405. (if (and erc-server-connected nicklen)
  3406. (- (string-to-number nicklen)
  3407. (length erc-nick-uniquifier))
  3408. ;; rfc2812 max nick length = 9
  3409. ;; we must assume this is the
  3410. ;; server's setting if we haven't
  3411. ;; established a connection yet
  3412. (- 9 (length erc-nick-uniquifier))))
  3413. erc-nick-uniquifier)))
  3414. (erc-cmd-NICK newnick)
  3415. (erc-display-error-notice
  3416. nil
  3417. (format "Nickname %s is %s, trying %s"
  3418. nick reason newnick)))))
  3419. ;;; Server messages
  3420. (defgroup erc-server-hooks nil
  3421. "Server event callbacks.
  3422. Every server event - like numeric replies - has its own hook.
  3423. Those hooks are all called using `run-hook-with-args-until-success'.
  3424. They receive as first argument the process object from where the event
  3425. originated from,
  3426. and as second argument the event parsed as a vector."
  3427. :group 'erc-hooks)
  3428. (defun erc-display-server-message (proc parsed)
  3429. "Display the message sent by the server as a notice."
  3430. (erc-display-message
  3431. parsed 'notice 'active (erc-response.contents parsed)))
  3432. (defun erc-auto-query (proc parsed)
  3433. ;; FIXME: This needs more documentation, unless it's not a user function --
  3434. ;; Lawrence 2004-01-08
  3435. "Put this on `erc-server-PRIVMSG-functions'."
  3436. (when erc-auto-query
  3437. (let* ((nick (car (erc-parse-user (erc-response.sender parsed))))
  3438. (target (car (erc-response.command-args parsed)))
  3439. (msg (erc-response.contents parsed))
  3440. (query (if (not erc-query-on-unjoined-chan-privmsg)
  3441. nick
  3442. (if (erc-current-nick-p target)
  3443. nick
  3444. target))))
  3445. (and (not (erc-ignored-user-p (erc-response.sender parsed)))
  3446. (or erc-query-on-unjoined-chan-privmsg
  3447. (string= target (erc-current-nick)))
  3448. (not (erc-get-buffer query proc))
  3449. (not (erc-is-message-ctcp-and-not-action-p msg))
  3450. (let ((erc-query-display erc-auto-query))
  3451. (erc-cmd-QUERY query))
  3452. nil))))
  3453. (defun erc-is-message-ctcp-p (message)
  3454. "Check if MESSAGE is a CTCP message or not."
  3455. (string-match "^\C-a\\([^\C-a]*\\)\C-a?$" message))
  3456. (defun erc-is-message-ctcp-and-not-action-p (message)
  3457. "Check if MESSAGE is a CTCP message or not."
  3458. (and (erc-is-message-ctcp-p message)
  3459. (not (string-match "^\C-a\\ACTION.*\C-a$" message))))
  3460. (defun erc-format-privmessage (nick msg privp msgp)
  3461. "Format a PRIVMSG in an insertable fashion."
  3462. (let* ((mark-s (if msgp (if privp "*" "<") "-"))
  3463. (mark-e (if msgp (if privp "*" ">") "-"))
  3464. (str (format "%s%s%s %s" mark-s nick mark-e msg))
  3465. (nick-face (if privp 'erc-nick-msg-face 'erc-nick-default-face))
  3466. (msg-face (if privp 'erc-direct-msg-face 'erc-default-face)))
  3467. ;; add text properties to text before the nick, the nick and after the nick
  3468. (erc-put-text-property 0 (length mark-s) 'face msg-face str)
  3469. (erc-put-text-property (length mark-s) (+ (length mark-s) (length nick))
  3470. 'face nick-face str)
  3471. (erc-put-text-property (+ (length mark-s) (length nick)) (length str)
  3472. 'face msg-face str)
  3473. str))
  3474. (defcustom erc-format-nick-function 'erc-format-nick
  3475. "*Function to format a nickname for message display."
  3476. :group 'erc-display
  3477. :type 'function)
  3478. (defun erc-format-nick (&optional user channel-data)
  3479. "Return the nickname of USER.
  3480. See also `erc-format-nick-function'."
  3481. (when user (erc-server-user-nickname user)))
  3482. (defun erc-format-@nick (&optional user channel-data)
  3483. "Format the nickname of USER showing if USER is an operator or has voice.
  3484. Operators have \"@\" and users with voice have \"+\" as a prefix.
  3485. Use CHANNEL-DATA to determine op and voice status.
  3486. See also `erc-format-nick-function'."
  3487. (when user
  3488. (let ((op (and channel-data (erc-channel-user-op channel-data) "@"))
  3489. (voice (and channel-data (erc-channel-user-voice channel-data) "+")))
  3490. (concat voice op (erc-server-user-nickname user)))))
  3491. (defun erc-format-my-nick ()
  3492. "Return the beginning of this user's message, correctly propertized."
  3493. (if erc-show-my-nick
  3494. (let ((open "<")
  3495. (close "> ")
  3496. (nick (erc-current-nick)))
  3497. (concat
  3498. (erc-propertize open 'face 'erc-default-face)
  3499. (erc-propertize nick 'face 'erc-my-nick-face)
  3500. (erc-propertize close 'face 'erc-default-face)))
  3501. (let ((prefix "> "))
  3502. (erc-propertize prefix 'face 'erc-default-face))))
  3503. (defun erc-echo-notice-in-default-buffer (s parsed buffer sender)
  3504. "Echos a private notice in the default buffer, namely the
  3505. target buffer specified by BUFFER, or there is no target buffer,
  3506. the server buffer. This function is designed to be added to
  3507. either `erc-echo-notice-hook' or `erc-echo-notice-always-hook',
  3508. and always returns t."
  3509. (erc-display-message parsed nil buffer s)
  3510. t)
  3511. (defun erc-echo-notice-in-target-buffer (s parsed buffer sender)
  3512. "Echos a private notice in BUFFER, if BUFFER is non-nil. This
  3513. function is designed to be added to either `erc-echo-notice-hook'
  3514. or `erc-echo-notice-always-hook', and returns non-nil if BUFFER
  3515. is non-nil."
  3516. (if buffer
  3517. (progn (erc-display-message parsed nil buffer s) t)
  3518. nil))
  3519. (defun erc-echo-notice-in-minibuffer (s parsed buffer sender)
  3520. "Echos a private notice in the minibuffer. This function is
  3521. designed to be added to either `erc-echo-notice-hook' or
  3522. `erc-echo-notice-always-hook', and always returns t."
  3523. (message "%s" (concat "NOTICE: " s))
  3524. t)
  3525. (defun erc-echo-notice-in-server-buffer (s parsed buffer sender)
  3526. "Echos a private notice in the server buffer. This function is
  3527. designed to be added to either `erc-echo-notice-hook' or
  3528. `erc-echo-notice-always-hook', and always returns t."
  3529. (erc-display-message parsed nil nil s)
  3530. t)
  3531. (defun erc-echo-notice-in-active-non-server-buffer (s parsed buffer sender)
  3532. "Echos a private notice in the active buffer if the active
  3533. buffer is not the server buffer. This function is designed to be
  3534. added to either `erc-echo-notice-hook' or
  3535. `erc-echo-notice-always-hook', and returns non-nil if the active
  3536. buffer is not the server buffer."
  3537. (if (not (eq (erc-server-buffer) (erc-active-buffer)))
  3538. (progn (erc-display-message parsed nil 'active s) t)
  3539. nil))
  3540. (defun erc-echo-notice-in-active-buffer (s parsed buffer sender)
  3541. "Echos a private notice in the active buffer. This function is
  3542. designed to be added to either `erc-echo-notice-hook' or
  3543. `erc-echo-notice-always-hook', and always returns t."
  3544. (erc-display-message parsed nil 'active s)
  3545. t)
  3546. (defun erc-echo-notice-in-user-buffers (s parsed buffer sender)
  3547. "Echos a private notice in all of the buffers for which SENDER
  3548. is a member. This function is designed to be added to either
  3549. `erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
  3550. returns non-nil if there is at least one buffer for which the
  3551. sender is a member.
  3552. See also: `erc-echo-notice-in-first-user-buffer',
  3553. `erc-buffer-list-with-nick'."
  3554. (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
  3555. (if buffers
  3556. (progn (erc-display-message parsed nil buffers s) t)
  3557. nil)))
  3558. (defun erc-echo-notice-in-user-and-target-buffers (s parsed buffer sender)
  3559. "Echos a private notice in BUFFER and in all of the buffers for
  3560. which SENDER is a member. This function is designed to be added
  3561. to either `erc-echo-notice-hook' or
  3562. `erc-echo-notice-always-hook', and returns non-nil if there is
  3563. at least one buffer for which the sender is a member or the
  3564. default target.
  3565. See also: `erc-echo-notice-in-user-buffers',
  3566. `erc-buffer-list-with-nick'."
  3567. (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
  3568. (add-to-list 'buffers buffer)
  3569. (if buffers
  3570. (progn (erc-display-message parsed nil buffers s) t)
  3571. nil)))
  3572. (defun erc-echo-notice-in-first-user-buffer (s parsed buffer sender)
  3573. "Echos a private notice in one of the buffers for which SENDER
  3574. is a member. This function is designed to be added to either
  3575. `erc-echo-notice-hook' or `erc-echo-notice-always-hook', and
  3576. returns non-nil if there is at least one buffer for which the
  3577. sender is a member.
  3578. See also: `erc-echo-notice-in-user-buffers',
  3579. `erc-buffer-list-with-nick'."
  3580. (let ((buffers (erc-buffer-list-with-nick sender erc-server-process)))
  3581. (if buffers
  3582. (progn (erc-display-message parsed nil (car buffers) s) t)
  3583. nil)))
  3584. ;;; Ban manipulation
  3585. (defun erc-banlist-store (proc parsed)
  3586. "Record ban entries for a channel."
  3587. (multiple-value-bind (channel mask whoset)
  3588. (values-list (cdr (erc-response.command-args parsed)))
  3589. ;; Determine to which buffer the message corresponds
  3590. (let ((buffer (erc-get-buffer channel proc)))
  3591. (with-current-buffer buffer
  3592. (unless (member (cons whoset mask) erc-channel-banlist)
  3593. (setq erc-channel-banlist (cons (cons whoset mask)
  3594. erc-channel-banlist))))))
  3595. nil)
  3596. (defun erc-banlist-finished (proc parsed)
  3597. "Record that we have received the banlist."
  3598. (let* ((channel (second (erc-response.command-args parsed)))
  3599. (buffer (erc-get-buffer channel proc)))
  3600. (with-current-buffer buffer
  3601. (put 'erc-channel-banlist 'received-from-server t)))
  3602. t) ; suppress the 'end of banlist' message
  3603. (defun erc-banlist-update (proc parsed)
  3604. "Check MODE commands for bans and update the banlist appropriately."
  3605. ;; FIXME: Possibly incorrect. -- Lawrence 2004-05-11
  3606. (let* ((tgt (first (erc-response.command-args parsed)))
  3607. (mode (erc-response.contents parsed))
  3608. (whoset (erc-response.sender parsed))
  3609. (buffer (erc-get-buffer tgt proc)))
  3610. (when buffer
  3611. (with-current-buffer buffer
  3612. (cond ((not (get 'erc-channel-banlist 'received-from-server)) nil)
  3613. ((string-match "^\\([+-]\\)b" mode)
  3614. ;; This is a ban
  3615. (cond
  3616. ((string-match "^-" mode)
  3617. ;; Remove the unbanned masks from the ban list
  3618. (setq erc-channel-banlist
  3619. (erc-delete-if
  3620. #'(lambda (y)
  3621. (member (upcase (cdr y))
  3622. (mapcar #'upcase
  3623. (cdr (split-string mode)))))
  3624. erc-channel-banlist)))
  3625. ((string-match "^+" mode)
  3626. ;; Add the banned mask(s) to the ban list
  3627. (mapc
  3628. (lambda (mask)
  3629. (unless (member (cons whoset mask) erc-channel-banlist)
  3630. (setq erc-channel-banlist
  3631. (cons (cons whoset mask) erc-channel-banlist))))
  3632. (cdr (split-string mode))))))))))
  3633. nil)
  3634. ;; used for the banlist cmds
  3635. (defun erc-group-list (list n)
  3636. "Group LIST into sublists of length N."
  3637. (cond ((null list) nil)
  3638. ((null (nthcdr n list)) (list list))
  3639. (t (cons (erc-subseq list 0 n) (erc-group-list (nthcdr n list) n)))))
  3640. ;;; MOTD numreplies
  3641. (defun erc-handle-login ()
  3642. "Handle the logging in process of connection."
  3643. (unless erc-logged-in
  3644. (setq erc-logged-in t)
  3645. (message "Logging in as \'%s\'... done" (erc-current-nick))
  3646. ;; execute a startup script
  3647. (let ((f (erc-select-startup-file)))
  3648. (when f
  3649. (erc-load-script f)))))
  3650. (defun erc-connection-established (proc parsed)
  3651. "Run just after connection.
  3652. Set user modes and run `erc-after-connect' hook."
  3653. (with-current-buffer (process-buffer proc)
  3654. (unless erc-server-connected ; only once per session
  3655. (let ((server (or erc-server-announced-name
  3656. (erc-response.sender parsed)))
  3657. (nick (car (erc-response.command-args parsed)))
  3658. (buffer (process-buffer proc)))
  3659. (setq erc-server-connected t)
  3660. (erc-update-mode-line)
  3661. (erc-set-initial-user-mode nick buffer)
  3662. (erc-server-setup-periodical-ping buffer)
  3663. (run-hook-with-args 'erc-after-connect server nick)))))
  3664. (defun erc-set-initial-user-mode (nick buffer)
  3665. "If `erc-user-mode' is non-nil for NICK, set the user modes.
  3666. The server buffer is given by BUFFER."
  3667. (with-current-buffer buffer
  3668. (when erc-user-mode
  3669. (let ((mode (if (functionp erc-user-mode)
  3670. (funcall erc-user-mode)
  3671. erc-user-mode)))
  3672. (when (stringp mode)
  3673. (erc-log (format "changing mode for %s to %s" nick mode))
  3674. (erc-server-send (format "MODE %s %s" nick mode)))))))
  3675. (defun erc-display-error-notice (parsed string)
  3676. "Display STRING as an error notice.
  3677. See also `erc-display-message'."
  3678. (erc-display-message
  3679. parsed '(notice error) 'active string))
  3680. (defun erc-process-ctcp-query (proc parsed nick login host)
  3681. ;; FIXME: This needs a proper docstring -- Lawrence 2004-01-08
  3682. "Process a CTCP query."
  3683. (let ((queries (delete "" (split-string (erc-response.contents parsed)
  3684. "\C-a"))))
  3685. (if (> (length queries) 4)
  3686. (erc-display-message
  3687. parsed (list 'notice 'error) proc 'ctcp-too-many)
  3688. (if (= 0 (length queries))
  3689. (erc-display-message
  3690. parsed (list 'notice 'error) proc
  3691. 'ctcp-empty ?n nick)
  3692. (while queries
  3693. (let* ((type (upcase (car (split-string (car queries)))))
  3694. (hook (intern-soft (concat "erc-ctcp-query-" type "-hook"))))
  3695. (if (and hook (boundp hook))
  3696. (if (string-equal type "ACTION")
  3697. (run-hook-with-args-until-success
  3698. hook proc parsed nick login host
  3699. (car (erc-response.command-args parsed))
  3700. (car queries))
  3701. (when erc-paranoid
  3702. (if (erc-current-nick-p
  3703. (car (erc-response.command-args parsed)))
  3704. (erc-display-message
  3705. parsed 'error 'active 'ctcp-request
  3706. ?n nick ?u login ?h host ?r (car queries))
  3707. (erc-display-message
  3708. parsed 'error 'active 'ctcp-request-to
  3709. ?n nick ?u login ?h host ?r (car queries)
  3710. ?t (car (erc-response.command-args parsed)))))
  3711. (run-hook-with-args-until-success
  3712. hook proc nick login host
  3713. (car (erc-response.command-args parsed))
  3714. (car queries)))
  3715. (erc-display-message
  3716. parsed (list 'notice 'error) proc
  3717. 'undefined-ctcp)))
  3718. (setq queries (cdr queries)))))))
  3719. (defvar erc-ctcp-query-ACTION-hook '(erc-ctcp-query-ACTION))
  3720. (defun erc-ctcp-query-ACTION (proc parsed nick login host to msg)
  3721. "Respond to a CTCP ACTION query."
  3722. (when (string-match "^ACTION\\s-\\(.*\\)\\s-*$" msg)
  3723. (let ((s (match-string 1 msg))
  3724. (buf (or (erc-get-buffer to proc)
  3725. (erc-get-buffer nick proc)
  3726. (process-buffer proc))))
  3727. (erc-display-message
  3728. parsed 'action buf
  3729. 'ACTION ?n nick ?u login ?h host ?a s))))
  3730. (defvar erc-ctcp-query-CLIENTINFO-hook '(erc-ctcp-query-CLIENTINFO))
  3731. (defun erc-ctcp-query-CLIENTINFO (proc nick login host to msg)
  3732. "Respond to a CTCP CLIENTINFO query."
  3733. (when (string-match "^CLIENTINFO\\(\\s-*\\|\\s-+.*\\)$" msg)
  3734. (let ((s (erc-client-info (erc-trim-string (match-string 1 msg)))))
  3735. (unless erc-disable-ctcp-replies
  3736. (erc-send-ctcp-notice nick (format "CLIENTINFO %s" s)))))
  3737. nil)
  3738. (defvar erc-ctcp-query-ECHO-hook '(erc-ctcp-query-ECHO))
  3739. (defun erc-ctcp-query-ECHO (proc nick login host to msg)
  3740. "Respond to a CTCP ECHO query."
  3741. (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
  3742. (let ((s (match-string 1 msg)))
  3743. (unless erc-disable-ctcp-replies
  3744. (erc-send-ctcp-notice nick (format "ECHO %s" s)))))
  3745. nil)
  3746. (defvar erc-ctcp-query-FINGER-hook '(erc-ctcp-query-FINGER))
  3747. (defun erc-ctcp-query-FINGER (proc nick login host to msg)
  3748. "Respond to a CTCP FINGER query."
  3749. (unless erc-disable-ctcp-replies
  3750. (let ((s (if erc-anonymous-login
  3751. (format "FINGER I'm %s." (erc-current-nick))
  3752. (format "FINGER %s (%s@%s)."
  3753. (user-full-name)
  3754. (user-login-name)
  3755. (system-name))))
  3756. (ns (erc-time-diff erc-server-last-sent-time (erc-current-time))))
  3757. (when (> ns 0)
  3758. (setq s (concat s " Idle for " (erc-sec-to-time ns))))
  3759. (erc-send-ctcp-notice nick s)))
  3760. nil)
  3761. (defvar erc-ctcp-query-PING-hook '(erc-ctcp-query-PING))
  3762. (defun erc-ctcp-query-PING (proc nick login host to msg)
  3763. "Respond to a CTCP PING query."
  3764. (when (string-match "^PING\\s-+\\(.*\\)" msg)
  3765. (unless erc-disable-ctcp-replies
  3766. (let ((arg (match-string 1 msg)))
  3767. (erc-send-ctcp-notice nick (format "PING %s" arg)))))
  3768. nil)
  3769. (defvar erc-ctcp-query-TIME-hook '(erc-ctcp-query-TIME))
  3770. (defun erc-ctcp-query-TIME (proc nick login host to msg)
  3771. "Respond to a CTCP TIME query."
  3772. (unless erc-disable-ctcp-replies
  3773. (erc-send-ctcp-notice nick (format "TIME %s" (current-time-string))))
  3774. nil)
  3775. (defvar erc-ctcp-query-USERINFO-hook '(erc-ctcp-query-USERINFO))
  3776. (defun erc-ctcp-query-USERINFO (proc nick login host to msg)
  3777. "Respond to a CTCP USERINFO query."
  3778. (unless erc-disable-ctcp-replies
  3779. (erc-send-ctcp-notice nick (format "USERINFO %s" erc-user-information)))
  3780. nil)
  3781. (defvar erc-ctcp-query-VERSION-hook '(erc-ctcp-query-VERSION))
  3782. (defun erc-ctcp-query-VERSION (proc nick login host to msg)
  3783. "Respond to a CTCP VERSION query."
  3784. (unless erc-disable-ctcp-replies
  3785. (erc-send-ctcp-notice
  3786. nick (format
  3787. "VERSION \C-bERC\C-b %s - an IRC client for emacs (\C-b%s\C-b)"
  3788. erc-version-string
  3789. erc-official-location)))
  3790. nil)
  3791. (defun erc-process-ctcp-reply (proc parsed nick login host msg)
  3792. "Process MSG as a CTCP reply."
  3793. (let* ((type (car (split-string msg)))
  3794. (hook (intern (concat "erc-ctcp-reply-" type "-hook"))))
  3795. (if (boundp hook)
  3796. (run-hook-with-args-until-success
  3797. hook proc nick login host
  3798. (car (erc-response.command-args parsed)) msg)
  3799. (erc-display-message
  3800. parsed 'notice 'active
  3801. 'CTCP-UNKNOWN ?n nick ?u login ?h host ?m msg))))
  3802. (defvar erc-ctcp-reply-ECHO-hook '(erc-ctcp-reply-ECHO))
  3803. (defun erc-ctcp-reply-ECHO (proc nick login host to msg)
  3804. "Handle a CTCP ECHO reply."
  3805. (when (string-match "^ECHO\\s-+\\(.*\\)\\s-*$" msg)
  3806. (let ((message (match-string 1 msg)))
  3807. (erc-display-message
  3808. nil '(notice action) 'active
  3809. 'CTCP-ECHO ?n nick ?m message)))
  3810. nil)
  3811. (defvar erc-ctcp-reply-CLIENTINFO-hook '(erc-ctcp-reply-CLIENTINFO))
  3812. (defun erc-ctcp-reply-CLIENTINFO (proc nick login host to msg)
  3813. "Handle a CTCP CLIENTINFO reply."
  3814. (when (string-match "^CLIENTINFO\\s-+\\(.*\\)\\s-*$" msg)
  3815. (let ((message (match-string 1 msg)))
  3816. (erc-display-message
  3817. nil 'notice 'active
  3818. 'CTCP-CLIENTINFO ?n nick ?m message)))
  3819. nil)
  3820. (defvar erc-ctcp-reply-FINGER-hook '(erc-ctcp-reply-FINGER))
  3821. (defun erc-ctcp-reply-FINGER (proc nick login host to msg)
  3822. "Handle a CTCP FINGER reply."
  3823. (when (string-match "^FINGER\\s-+\\(.*\\)\\s-*$" msg)
  3824. (let ((message (match-string 1 msg)))
  3825. (erc-display-message
  3826. nil 'notice 'active
  3827. 'CTCP-FINGER ?n nick ?m message)))
  3828. nil)
  3829. (defvar erc-ctcp-reply-PING-hook '(erc-ctcp-reply-PING))
  3830. (defun erc-ctcp-reply-PING (proc nick login host to msg)
  3831. "Handle a CTCP PING reply."
  3832. (if (not (string-match "^PING\\s-+\\([0-9.]+\\)" msg))
  3833. nil
  3834. (let ((time (match-string 1 msg)))
  3835. (condition-case nil
  3836. (let ((delta (erc-time-diff (string-to-number time)
  3837. (erc-current-time))))
  3838. (erc-display-message
  3839. nil 'notice 'active
  3840. 'CTCP-PING ?n nick
  3841. ?t (erc-sec-to-time delta)))
  3842. (range-error
  3843. (erc-display-message
  3844. nil 'error 'active
  3845. 'bad-ping-response ?n nick ?t time))))))
  3846. (defvar erc-ctcp-reply-TIME-hook '(erc-ctcp-reply-TIME))
  3847. (defun erc-ctcp-reply-TIME (proc nick login host to msg)
  3848. "Handle a CTCP TIME reply."
  3849. (when (string-match "^TIME\\s-+\\(.*\\)\\s-*$" msg)
  3850. (let ((message (match-string 1 msg)))
  3851. (erc-display-message
  3852. nil 'notice 'active
  3853. 'CTCP-TIME ?n nick ?m message)))
  3854. nil)
  3855. (defvar erc-ctcp-reply-VERSION-hook '(erc-ctcp-reply-VERSION))
  3856. (defun erc-ctcp-reply-VERSION (proc nick login host to msg)
  3857. "Handle a CTCP VERSION reply."
  3858. (when (string-match "^VERSION\\s-+\\(.*\\)\\s-*$" msg)
  3859. (let ((message (match-string 1 msg)))
  3860. (erc-display-message
  3861. nil 'notice 'active
  3862. 'CTCP-VERSION ?n nick ?m message)))
  3863. nil)
  3864. (defun erc-process-away (proc away-p)
  3865. "Toggle the away status of the user depending on the value of AWAY-P.
  3866. If nil, set the user as away.
  3867. If non-nil, return from being away."
  3868. (let ((sessionbuf (process-buffer proc)))
  3869. (when sessionbuf
  3870. (with-current-buffer sessionbuf
  3871. (when erc-away-nickname
  3872. (erc-log (format "erc-process-away: away-nick: %s, away-p: %s"
  3873. erc-away-nickname away-p))
  3874. (erc-cmd-NICK (if away-p
  3875. erc-away-nickname
  3876. erc-nick)))
  3877. (cond
  3878. (away-p
  3879. (setq erc-away (current-time)))
  3880. (t
  3881. (let ((away-time erc-away))
  3882. ;; away must be set to NIL BEFORE sending anything to prevent
  3883. ;; an infinite recursion
  3884. (setq erc-away nil)
  3885. (with-current-buffer (erc-active-buffer)
  3886. (when erc-public-away-p
  3887. (erc-send-action
  3888. (erc-default-target)
  3889. (if away-time
  3890. (format "is back (gone for %s)"
  3891. (erc-sec-to-time
  3892. (erc-time-diff
  3893. (erc-emacs-time-to-erc-time away-time)
  3894. (erc-current-time))))
  3895. "is back")))))))))
  3896. (erc-update-mode-line)))
  3897. ;;;; List of channel members handling
  3898. (defun erc-channel-begin-receiving-names ()
  3899. "Internal function.
  3900. Used when a channel names list is about to be received. Should
  3901. be called with the current buffer set to the channel buffer.
  3902. See also `erc-channel-end-receiving-names'."
  3903. (setq erc-channel-new-member-names (make-hash-table :test 'equal)))
  3904. (defun erc-channel-end-receiving-names ()
  3905. "Internal function.
  3906. Used to fix `erc-channel-users' after a channel names list has been
  3907. received. Should be called with the current buffer set to the
  3908. channel buffer.
  3909. See also `erc-channel-begin-receiving-names'."
  3910. (maphash (lambda (nick user)
  3911. (if (null (gethash nick erc-channel-new-member-names))
  3912. (erc-remove-channel-user nick)))
  3913. erc-channel-users)
  3914. (setq erc-channel-new-member-names nil))
  3915. (defun erc-parse-prefix ()
  3916. "Return an alist of valid prefix character types and their representations.
  3917. Example: (operator) o => @, (voiced) v => +."
  3918. (let ((str (or (cdr (assoc "PREFIX" (erc-with-server-buffer
  3919. erc-server-parameters)))
  3920. ;; provide a sane default
  3921. "(ov)@+"))
  3922. types chars)
  3923. (when (string-match "^(\\([^)]+\\))\\(.+\\)$" str)
  3924. (setq types (match-string 1 str)
  3925. chars (match-string 2 str))
  3926. (let ((len (min (length types) (length chars)))
  3927. (i 0)
  3928. (alist nil))
  3929. (while (< i len)
  3930. (setq alist (cons (cons (elt types i) (elt chars i))
  3931. alist))
  3932. (setq i (1+ i)))
  3933. alist))))
  3934. (defun erc-channel-receive-names (names-string)
  3935. "This function is for internal use only.
  3936. Update `erc-channel-users' according to NAMES-STRING.
  3937. NAMES-STRING is a string listing some of the names on the
  3938. channel."
  3939. (let (prefix op-ch voice-ch names name op voice)
  3940. (setq prefix (erc-parse-prefix))
  3941. (setq op-ch (cdr (assq ?o prefix))
  3942. voice-ch (cdr (assq ?v prefix)))
  3943. ;; We need to delete "" because in XEmacs, (split-string "a ")
  3944. ;; returns ("a" "").
  3945. (setq names (delete "" (split-string names-string)))
  3946. (let ((erc-channel-members-changed-hook nil))
  3947. (dolist (item names)
  3948. (let ((updatep t)
  3949. ch)
  3950. (if (rassq (elt item 0) prefix)
  3951. (cond ((= (length item) 1)
  3952. (setq updatep nil))
  3953. ((eq (elt item 0) op-ch)
  3954. (setq name (substring item 1)
  3955. op 'on
  3956. voice 'off))
  3957. ((eq (elt item 0) voice-ch)
  3958. (setq name (substring item 1)
  3959. op 'off
  3960. voice 'on))
  3961. (t (setq name (substring item 1)
  3962. op 'off
  3963. voice 'off)))
  3964. (setq name item
  3965. op 'off
  3966. voice 'off))
  3967. (when updatep
  3968. (puthash (erc-downcase name) t
  3969. erc-channel-new-member-names)
  3970. (erc-update-current-channel-member
  3971. name name t op voice)))))
  3972. (run-hooks 'erc-channel-members-changed-hook)))
  3973. (defcustom erc-channel-members-changed-hook nil
  3974. "*This hook is called every time the variable `channel-members' changes.
  3975. The buffer where the change happened is current while this hook is called."
  3976. :group 'erc-hooks
  3977. :type 'hook)
  3978. (defun erc-update-user-nick (nick &optional new-nick
  3979. host login full-name info)
  3980. "Updates the stored user information for the user with nickname
  3981. NICK.
  3982. See also: `erc-update-user'."
  3983. (erc-update-user (erc-get-server-user nick) new-nick
  3984. host login full-name info))
  3985. (defun erc-update-user (user &optional new-nick
  3986. host login full-name info)
  3987. "Update user info for USER. USER must be an erc-server-user
  3988. struct. Any of NEW-NICK, HOST, LOGIN, FULL-NAME, INFO which are
  3989. non-nil and not equal to the existing values for USER are used to
  3990. replace the stored values in USER.
  3991. If, and only if, a change is made,
  3992. `erc-channel-members-changed-hook' is run for each channel for
  3993. which USER is a member, and t is returned."
  3994. (let (changed)
  3995. (when user
  3996. (when (and new-nick
  3997. (not (equal (erc-server-user-nickname user)
  3998. new-nick)))
  3999. (setq changed t)
  4000. (erc-change-user-nickname user new-nick))
  4001. (when (and host
  4002. (not (equal (erc-server-user-host user) host)))
  4003. (setq changed t)
  4004. (setf (erc-server-user-host user) host))
  4005. (when (and login
  4006. (not (equal (erc-server-user-login user) login)))
  4007. (setq changed t)
  4008. (setf (erc-server-user-login user) login))
  4009. (when (and full-name
  4010. (not (equal (erc-server-user-full-name user)
  4011. full-name)))
  4012. (setq changed t)
  4013. (setf (erc-server-user-full-name user) full-name))
  4014. (when (and info
  4015. (not (equal (erc-server-user-info user) info)))
  4016. (setq changed t)
  4017. (setf (erc-server-user-info user) info))
  4018. (if changed
  4019. (dolist (buf (erc-server-user-buffers user))
  4020. (if (buffer-live-p buf)
  4021. (with-current-buffer buf
  4022. (run-hooks 'erc-channel-members-changed-hook))))))
  4023. changed))
  4024. (defun erc-update-current-channel-member
  4025. (nick new-nick &optional add op voice host login full-name info
  4026. update-message-time)
  4027. "Updates the stored user information for the user with nickname
  4028. NICK. `erc-update-user' is called to handle changes to nickname,
  4029. HOST, LOGIN, FULL-NAME, and INFO. If OP or VOICE are non-nil,
  4030. they must be equal to either `on' or `off', in which case the
  4031. operator or voice status of the user in the current channel is
  4032. changed accordingly. If UPDATE-MESSAGE-TIME is non-nil, the
  4033. last-message-time of the user in the current channel is set
  4034. to (current-time).
  4035. If ADD is non-nil, the user will be added with the specified
  4036. information if it is not already present in the user or channel
  4037. lists.
  4038. If, and only if, changes are made, or the user is added,
  4039. `erc-channel-members-updated-hook' is run, and t is returned.
  4040. See also: `erc-update-user' and `erc-update-channel-member'."
  4041. (let* (changed user-changed
  4042. (channel-data (erc-get-channel-user nick))
  4043. (cuser (if channel-data (cdr channel-data)))
  4044. (user (if channel-data (car channel-data)
  4045. (erc-get-server-user nick))))
  4046. (if cuser
  4047. (progn
  4048. (erc-log (format "update-member: user = %S, cuser = %S" user cuser))
  4049. (when (and op
  4050. (not (eq (erc-channel-user-op cuser) op)))
  4051. (setq changed t)
  4052. (setf (erc-channel-user-op cuser)
  4053. (cond ((eq op 'on) t)
  4054. ((eq op 'off) nil)
  4055. (t op))))
  4056. (when (and voice
  4057. (not (eq (erc-channel-user-voice cuser) voice)))
  4058. (setq changed t)
  4059. (setf (erc-channel-user-voice cuser)
  4060. (cond ((eq voice 'on) t)
  4061. ((eq voice 'off) nil)
  4062. (t voice))))
  4063. (when update-message-time
  4064. (setf (erc-channel-user-last-message-time cuser) (current-time)))
  4065. (setq user-changed
  4066. (erc-update-user user new-nick
  4067. host login full-name info)))
  4068. (when add
  4069. (if (null user)
  4070. (progn
  4071. (setq user (make-erc-server-user
  4072. :nickname nick
  4073. :host host
  4074. :full-name full-name
  4075. :login login
  4076. :info info
  4077. :buffers (list (current-buffer))))
  4078. (erc-add-server-user nick user))
  4079. (setf (erc-server-user-buffers user)
  4080. (cons (current-buffer)
  4081. (erc-server-user-buffers user))))
  4082. (setq cuser (make-erc-channel-user
  4083. :op (cond ((eq op 'on) t)
  4084. ((eq op 'off) nil)
  4085. (t op))
  4086. :voice (cond ((eq voice 'on) t)
  4087. ((eq voice 'off) nil)
  4088. (t voice))
  4089. :last-message-time
  4090. (if update-message-time (current-time))))
  4091. (puthash (erc-downcase nick) (cons user cuser)
  4092. erc-channel-users)
  4093. (setq changed t)))
  4094. (when (and changed (null user-changed))
  4095. (run-hooks 'erc-channel-members-changed-hook))
  4096. (or changed user-changed add)))
  4097. (defun erc-update-channel-member (channel nick new-nick
  4098. &optional add op voice host login
  4099. full-name info update-message-time)
  4100. "Updates user and channel information for the user with
  4101. nickname NICK in channel CHANNEL.
  4102. See also: `erc-update-current-channel-member'."
  4103. (erc-with-buffer
  4104. (channel)
  4105. (erc-update-current-channel-member nick new-nick add op voice host
  4106. login full-name info
  4107. update-message-time)))
  4108. (defun erc-remove-current-channel-member (nick)
  4109. "Remove NICK from current channel membership list.
  4110. Runs `erc-channel-members-changed-hook'."
  4111. (let ((channel-data (erc-get-channel-user nick)))
  4112. (when channel-data
  4113. (erc-remove-channel-user nick)
  4114. (run-hooks 'erc-channel-members-changed-hook))))
  4115. (defun erc-remove-channel-member (channel nick)
  4116. "Remove NICK from CHANNEL's membership list.
  4117. See also `erc-remove-current-channel-member'."
  4118. (erc-with-buffer
  4119. (channel)
  4120. (erc-remove-current-channel-member nick)))
  4121. (defun erc-update-channel-topic (channel topic &optional modify)
  4122. "Find a buffer for CHANNEL and set the TOPIC for it.
  4123. If optional MODIFY is 'append or 'prepend, then append or prepend the
  4124. TOPIC string to the current topic."
  4125. (erc-with-buffer (channel)
  4126. (cond ((eq modify 'append)
  4127. (setq erc-channel-topic (concat erc-channel-topic topic)))
  4128. ((eq modify 'prepend)
  4129. (setq erc-channel-topic (concat topic erc-channel-topic)))
  4130. (t (setq erc-channel-topic topic)))
  4131. (erc-update-mode-line-buffer (current-buffer))))
  4132. (defun erc-set-modes (tgt mode-string)
  4133. "Set the modes for the TGT provided as MODE-STRING."
  4134. (let* ((modes (erc-parse-modes mode-string))
  4135. (add-modes (nth 0 modes))
  4136. (remove-modes (nth 1 modes))
  4137. ;; list of triples: (mode-char 'on/'off argument)
  4138. (arg-modes (nth 2 modes)))
  4139. (cond ((erc-channel-p tgt); channel modes
  4140. (let ((buf (and erc-server-process
  4141. (erc-get-buffer tgt erc-server-process))))
  4142. (when buf
  4143. (with-current-buffer buf
  4144. (setq erc-channel-modes add-modes)
  4145. (setq erc-channel-user-limit nil)
  4146. (setq erc-channel-key nil)
  4147. (while arg-modes
  4148. (let ((mode (nth 0 (car arg-modes)))
  4149. (onoff (nth 1 (car arg-modes)))
  4150. (arg (nth 2 (car arg-modes))))
  4151. (cond ((string-match "^[Ll]" mode)
  4152. (erc-update-channel-limit tgt onoff arg))
  4153. ((string-match "^[Kk]" mode)
  4154. (erc-update-channel-key tgt onoff arg))
  4155. (t nil)))
  4156. (setq arg-modes (cdr arg-modes)))
  4157. (erc-update-mode-line-buffer buf)))))
  4158. ;; we do not keep our nick's modes yet
  4159. ;;(t (setq erc-user-modes add-modes))
  4160. )
  4161. ))
  4162. (defun erc-sort-strings (list-of-strings)
  4163. "Sort LIST-OF-STRINGS in lexicographic order.
  4164. Side-effect free."
  4165. (sort (copy-sequence list-of-strings) 'string<))
  4166. (defun erc-parse-modes (mode-string)
  4167. "Parse MODE-STRING into a list.
  4168. Returns a list of three elements:
  4169. (ADD-MODES REMOVE-MODES ARG-MODES).
  4170. The add-modes and remove-modes are lists of single-character strings
  4171. for modes without parameters to add and remove respectively. The
  4172. arg-modes is a list of triples of the form:
  4173. (MODE-CHAR ON/OFF ARGUMENT)."
  4174. (if (string-match "^\\s-*\\(\\S-+\\)\\(\\s-.*$\\|$\\)" mode-string)
  4175. (let ((chars (mapcar 'char-to-string (match-string 1 mode-string)))
  4176. ;; arguments in channel modes
  4177. (args-str (match-string 2 mode-string))
  4178. (args nil)
  4179. (add-modes nil)
  4180. (remove-modes nil)
  4181. (arg-modes nil); list of triples: (mode-char 'on/'off argument)
  4182. (add-p t))
  4183. ;; make the argument list
  4184. (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" args-str)
  4185. (setq args (cons (match-string 1 args-str) args))
  4186. (setq args-str (match-string 2 args-str)))
  4187. (setq args (nreverse args))
  4188. ;; collect what modes changed, and match them with arguments
  4189. (while chars
  4190. (cond ((string= (car chars) "+") (setq add-p t))
  4191. ((string= (car chars) "-") (setq add-p nil))
  4192. ((string-match "^[ovbOVB]" (car chars))
  4193. (setq arg-modes (cons (list (car chars)
  4194. (if add-p 'on 'off)
  4195. (if args (car args) nil))
  4196. arg-modes))
  4197. (if args (setq args (cdr args))))
  4198. ((string-match "^[LlKk]" (car chars))
  4199. (setq arg-modes (cons (list (car chars)
  4200. (if add-p 'on 'off)
  4201. (if (and add-p args)
  4202. (car args) nil))
  4203. arg-modes))
  4204. (if (and add-p args) (setq args (cdr args))))
  4205. (add-p (setq add-modes (cons (car chars) add-modes)))
  4206. (t (setq remove-modes (cons (car chars) remove-modes))))
  4207. (setq chars (cdr chars)))
  4208. (setq add-modes (nreverse add-modes))
  4209. (setq remove-modes (nreverse remove-modes))
  4210. (setq arg-modes (nreverse arg-modes))
  4211. (list add-modes remove-modes arg-modes))
  4212. nil))
  4213. (defun erc-update-modes (tgt mode-string &optional nick host login)
  4214. "Update the mode information for TGT, provided as MODE-STRING.
  4215. Optional arguments: NICK, HOST and LOGIN - the attributes of the
  4216. person who changed the modes."
  4217. (let* ((modes (erc-parse-modes mode-string))
  4218. (add-modes (nth 0 modes))
  4219. (remove-modes (nth 1 modes))
  4220. ;; list of triples: (mode-char 'on/'off argument)
  4221. (arg-modes (nth 2 modes)))
  4222. ;; now parse the modes changes and do the updates
  4223. (cond ((erc-channel-p tgt); channel modes
  4224. (let ((buf (and erc-server-process
  4225. (erc-get-buffer tgt erc-server-process))))
  4226. (when buf
  4227. ;; FIXME! This used to have an original buffer
  4228. ;; variable, but it never switched back to the original
  4229. ;; buffer. Is this wanted behavior?
  4230. (set-buffer buf)
  4231. (if (not (boundp 'erc-channel-modes))
  4232. (setq erc-channel-modes nil))
  4233. (while remove-modes
  4234. (setq erc-channel-modes (delete (car remove-modes)
  4235. erc-channel-modes)
  4236. remove-modes (cdr remove-modes)))
  4237. (while add-modes
  4238. (setq erc-channel-modes (cons (car add-modes)
  4239. erc-channel-modes)
  4240. add-modes (cdr add-modes)))
  4241. (setq erc-channel-modes (erc-sort-strings erc-channel-modes))
  4242. (while arg-modes
  4243. (let ((mode (nth 0 (car arg-modes)))
  4244. (onoff (nth 1 (car arg-modes)))
  4245. (arg (nth 2 (car arg-modes))))
  4246. (cond ((string-match "^[oO]" mode)
  4247. (erc-update-channel-member tgt arg arg nil onoff))
  4248. ((string-match "^[Vv]" mode)
  4249. (erc-update-channel-member tgt arg arg nil nil
  4250. onoff))
  4251. ((string-match "^[Ll]" mode)
  4252. (erc-update-channel-limit tgt onoff arg))
  4253. ((string-match "^[Kk]" mode)
  4254. (erc-update-channel-key tgt onoff arg))
  4255. (t nil)); only ops are tracked now
  4256. (setq arg-modes (cdr arg-modes))))
  4257. (erc-update-mode-line buf))))
  4258. ;; nick modes - ignored at this point
  4259. (t nil))))
  4260. (defun erc-update-channel-limit (channel onoff n)
  4261. ;; FIXME: what does ONOFF actually do? -- Lawrence 2004-01-08
  4262. "Update CHANNEL's user limit to N."
  4263. (if (or (not (eq onoff 'on))
  4264. (and (stringp n) (string-match "^[0-9]+$" n)))
  4265. (erc-with-buffer
  4266. (channel)
  4267. (cond ((eq onoff 'on) (setq erc-channel-user-limit (string-to-number n)))
  4268. (t (setq erc-channel-user-limit nil))))))
  4269. (defun erc-update-channel-key (channel onoff key)
  4270. "Update CHANNEL's key to KEY if ONOFF is 'on or to nil if it's 'off."
  4271. (erc-with-buffer
  4272. (channel)
  4273. (cond ((eq onoff 'on) (setq erc-channel-key key))
  4274. (t (setq erc-channel-key nil)))))
  4275. (defun erc-handle-user-status-change (type nlh &optional l)
  4276. "Handle changes in any user's status.
  4277. So far, only nick change is handled.
  4278. Generally, the TYPE argument is a symbol describing the change type, NLH is
  4279. a list containing the original nickname, login name and hostname for the user,
  4280. and L is a list containing additional TYPE-specific arguments.
  4281. So far the following TYPE/L pairs are supported:
  4282. Event TYPE L
  4283. nickname change 'nick (NEW-NICK)"
  4284. (erc-log (format "user-change: type: %S nlh: %S l: %S" type nlh l))
  4285. (cond
  4286. ;; nickname change
  4287. ((equal type 'nick)
  4288. t)
  4289. (t
  4290. nil)))
  4291. (defun erc-highlight-notice (s)
  4292. "Highlight notice message S and return it.
  4293. See also variable `erc-notice-highlight-type'."
  4294. (cond
  4295. ((eq erc-notice-highlight-type 'prefix)
  4296. (erc-put-text-property 0 (length erc-notice-prefix)
  4297. 'face 'erc-notice-face s)
  4298. s)
  4299. ((eq erc-notice-highlight-type 'all)
  4300. (erc-put-text-property 0 (length s) 'face 'erc-notice-face s)
  4301. s)
  4302. (t s)))
  4303. (defun erc-make-notice (message)
  4304. "Notify the user of MESSAGE."
  4305. (when erc-minibuffer-notice
  4306. (message "%s" message))
  4307. (erc-highlight-notice (concat erc-notice-prefix message)))
  4308. (defun erc-highlight-error (s)
  4309. "Highlight error message S and return it."
  4310. (erc-put-text-property 0 (length s) 'face 'erc-error-face s)
  4311. s)
  4312. (defun erc-put-text-property (start end property value &optional object)
  4313. "Set text-property for an object (usually a string).
  4314. START and END define the characters covered.
  4315. PROPERTY is the text-property set, usually the symbol `face'.
  4316. VALUE is the value for the text-property, usually a face symbol such as
  4317. the face `bold' or `erc-pal-face'.
  4318. OBJECT is a string which will be modified and returned.
  4319. OBJECT is modified without being copied first.
  4320. You can redefine or `defadvice' this function in order to add
  4321. EmacsSpeak support."
  4322. (put-text-property start end property value object))
  4323. (defun erc-list (thing)
  4324. "Return THING if THING is a list, or a list with THING as its element."
  4325. (if (listp thing)
  4326. thing
  4327. (list thing)))
  4328. (defun erc-parse-user (string)
  4329. "Parse STRING as a user specification (nick!login@host).
  4330. Return a list of the three separate tokens."
  4331. (cond
  4332. ((string-match "^\\([^!\n]*\\)!\\([^@\n]*\\)@\\(.*\\)$" string)
  4333. (list (match-string 1 string)
  4334. (match-string 2 string)
  4335. (match-string 3 string)))
  4336. ;; Some bogus bouncers send Nick!(null), try to live with that.
  4337. ((string-match "^\\([^!\n]*\\)!\\(.*\\)$" string)
  4338. (list (match-string 1 string)
  4339. ""
  4340. (match-string 2 string)))
  4341. (t
  4342. (list string "" ""))))
  4343. (defun erc-extract-nick (string)
  4344. "Return the nick corresponding to a user specification STRING.
  4345. See also `erc-parse-user'."
  4346. (car (erc-parse-user string)))
  4347. (defun erc-put-text-properties (start end properties
  4348. &optional object value-list)
  4349. "Set text-properties for OBJECT.
  4350. START and END describe positions in OBJECT.
  4351. If VALUE-LIST is nil, set each property in PROPERTIES to t, else set
  4352. each property to the corresponding value in VALUE-LIST."
  4353. (unless value-list
  4354. (setq value-list (mapcar (lambda (x)
  4355. t)
  4356. properties)))
  4357. (while (and properties value-list)
  4358. (erc-put-text-property
  4359. start end (pop properties) (pop value-list) object)))
  4360. ;;; Input area handling:
  4361. (defun erc-beg-of-input-line ()
  4362. "Return the value of `point' at the beginning of the input line.
  4363. Specifically, return the position of `erc-insert-marker'."
  4364. (or (and (boundp 'erc-insert-marker)
  4365. (markerp erc-insert-marker))
  4366. (error "erc-insert-marker has no value, please report a bug"))
  4367. (marker-position erc-insert-marker))
  4368. (defun erc-end-of-input-line ()
  4369. "Return the value of `point' at the end of the input line."
  4370. (point-max))
  4371. (defun erc-send-current-line ()
  4372. "Parse current line and send it to IRC."
  4373. (interactive)
  4374. (save-restriction
  4375. (widen)
  4376. (if (< (point) (erc-beg-of-input-line))
  4377. (erc-error "Point is not in the input area")
  4378. (let ((inhibit-read-only t)
  4379. (str (erc-user-input))
  4380. (old-buf (current-buffer)))
  4381. (if (and (not (erc-server-buffer-live-p))
  4382. (not (erc-command-no-process-p str)))
  4383. (erc-error "ERC: No process running")
  4384. (erc-set-active-buffer (current-buffer))
  4385. ;; Kill the input and the prompt
  4386. (delete-region (erc-beg-of-input-line)
  4387. (erc-end-of-input-line))
  4388. (unwind-protect
  4389. (erc-send-input str)
  4390. ;; Fix the buffer if the command didn't kill it
  4391. (when (buffer-live-p old-buf)
  4392. (with-current-buffer old-buf
  4393. (save-restriction
  4394. (widen)
  4395. (goto-char (point-max))
  4396. (when (processp erc-server-process)
  4397. (set-marker (process-mark erc-server-process) (point)))
  4398. (set-marker erc-insert-marker (point))
  4399. (let ((buffer-modified (buffer-modified-p)))
  4400. (erc-display-prompt)
  4401. (set-buffer-modified-p buffer-modified))))))
  4402. ;; Only when last hook has been run...
  4403. (run-hook-with-args 'erc-send-completed-hook str))))))
  4404. (defun erc-user-input ()
  4405. "Return the input of the user in the current buffer."
  4406. (buffer-substring-no-properties
  4407. erc-input-marker
  4408. (erc-end-of-input-line)))
  4409. (defvar erc-command-regexp "^/\\([A-Za-z']+\\)\\(\\s-+.*\\|\\s-*\\)$"
  4410. "Regular expression used for matching commands in ERC.")
  4411. (defun erc-send-input (input)
  4412. "Treat INPUT as typed in by the user. It is assumed that the input
  4413. and the prompt is already deleted.
  4414. This returns non-nil only if we actually send anything."
  4415. ;; Handle different kinds of inputs
  4416. (cond
  4417. ;; Ignore empty input
  4418. ((if erc-send-whitespace-lines
  4419. (string= input "")
  4420. (string-match "\\`[ \t\r\f\n]*\\'" input))
  4421. (when erc-warn-about-blank-lines
  4422. (message "Blank line - ignoring...")
  4423. (beep))
  4424. nil)
  4425. (t
  4426. (let ((str input)
  4427. (erc-insert-this t))
  4428. (setq erc-send-this t)
  4429. (run-hook-with-args 'erc-send-pre-hook input)
  4430. (when erc-send-this
  4431. (if (or (string-match "\n" str)
  4432. (not (string-match erc-command-regexp str)))
  4433. (mapc
  4434. (lambda (line)
  4435. (mapc
  4436. (lambda (line)
  4437. ;; Insert what has to be inserted for this.
  4438. (erc-display-msg line)
  4439. (erc-process-input-line (concat line "\n")
  4440. (null erc-flood-protect) t))
  4441. (or (and erc-flood-protect (erc-split-line line))
  4442. (list line))))
  4443. (split-string str "\n"))
  4444. ;; Insert the prompt along with the command.
  4445. (erc-display-command str)
  4446. (erc-process-input-line (concat str "\n") t nil))
  4447. t)))))
  4448. (defun erc-display-command (line)
  4449. (when erc-insert-this
  4450. (let ((insert-position (point)))
  4451. (unless erc-hide-prompt
  4452. (erc-display-prompt nil nil (erc-command-indicator)
  4453. (and (erc-command-indicator)
  4454. 'erc-command-indicator-face)))
  4455. (let ((beg (point)))
  4456. (insert line)
  4457. (erc-put-text-property beg (point)
  4458. 'face 'erc-command-indicator-face)
  4459. (insert "\n"))
  4460. (when (processp erc-server-process)
  4461. (set-marker (process-mark erc-server-process) (point)))
  4462. (set-marker erc-insert-marker (point))
  4463. (save-excursion
  4464. (save-restriction
  4465. (narrow-to-region insert-position (point))
  4466. (run-hooks 'erc-send-modify-hook)
  4467. (run-hooks 'erc-send-post-hook))))))
  4468. (defun erc-display-msg (line)
  4469. "Display LINE as a message of the user to the current target at the
  4470. current position."
  4471. (when erc-insert-this
  4472. (let ((insert-position (point)))
  4473. (insert (erc-format-my-nick))
  4474. (let ((beg (point)))
  4475. (insert line)
  4476. (erc-put-text-property beg (point)
  4477. 'face 'erc-input-face))
  4478. (insert "\n")
  4479. (when (processp erc-server-process)
  4480. (set-marker (process-mark erc-server-process) (point)))
  4481. (set-marker erc-insert-marker (point))
  4482. (save-excursion
  4483. (save-restriction
  4484. (narrow-to-region insert-position (point))
  4485. (run-hooks 'erc-send-modify-hook)
  4486. (run-hooks 'erc-send-post-hook))))))
  4487. (defun erc-command-symbol (command)
  4488. "Return the ERC command symbol for COMMAND if it exists and is bound."
  4489. (let ((cmd (intern-soft (format "erc-cmd-%s" (upcase command)))))
  4490. (when (fboundp cmd) cmd)))
  4491. (defun erc-extract-command-from-line (line)
  4492. "Extract command and args from the input LINE.
  4493. If no command was given, return nil. If command matches, return a
  4494. list of the form: (command args) where both elements are strings."
  4495. (when (string-match erc-command-regexp line)
  4496. (let* ((cmd (erc-command-symbol (match-string 1 line)))
  4497. ;; note: return is nil, we apply this simply for side effects
  4498. (canon-defun (while (and cmd (symbolp (symbol-function cmd)))
  4499. (setq cmd (symbol-function cmd))))
  4500. (cmd-fun (or cmd #'erc-cmd-default))
  4501. (arg (if cmd
  4502. (if (get cmd-fun 'do-not-parse-args)
  4503. (format "%s" (match-string 2 line))
  4504. (delete "" (split-string (erc-trim-string
  4505. (match-string 2 line)) " ")))
  4506. line)))
  4507. (list cmd-fun arg))))
  4508. (defun erc-split-multiline-safe (string)
  4509. "Split STRING, containing multiple lines and return them in a list.
  4510. Do it only for STRING as the complete input, do not carry unfinished
  4511. strings over to the next call."
  4512. (let ((l ())
  4513. (i0 0)
  4514. (doit t))
  4515. (while doit
  4516. (let ((i (string-match "\r?\n" string i0))
  4517. (s (substring string i0)))
  4518. (cond (i (setq l (cons (substring string i0 i) l))
  4519. (setq i0 (match-end 0)))
  4520. ((> (length s) 0)
  4521. (setq l (cons s l))(setq doit nil))
  4522. (t (setq doit nil)))))
  4523. (nreverse l)))
  4524. ;; nick handling
  4525. (defun erc-set-current-nick (nick)
  4526. "Set the current nickname to NICK."
  4527. (with-current-buffer (if (buffer-live-p (erc-server-buffer))
  4528. (erc-server-buffer)
  4529. (current-buffer))
  4530. (setq erc-server-current-nick nick)))
  4531. (defun erc-current-nick ()
  4532. "Return the current nickname."
  4533. (with-current-buffer (if (buffer-live-p (erc-server-buffer))
  4534. (erc-server-buffer)
  4535. (current-buffer))
  4536. erc-server-current-nick))
  4537. (defun erc-current-nick-p (nick)
  4538. "Return non-nil if NICK is the current nickname."
  4539. (erc-nick-equal-p nick (erc-current-nick)))
  4540. (defun erc-nick-equal-p (nick1 nick2)
  4541. "Return non-nil if NICK1 and NICK2 are the same.
  4542. This matches strings according to the IRC protocol's case convention.
  4543. See also `erc-downcase'."
  4544. (string= (erc-downcase nick1)
  4545. (erc-downcase nick2)))
  4546. ;; default target handling
  4547. (defun erc-default-target ()
  4548. "Return the current default target (as a character string) or nil if none."
  4549. (let ((tgt (car erc-default-recipients)))
  4550. (cond
  4551. ((not tgt) nil)
  4552. ((listp tgt) (cdr tgt))
  4553. (t tgt))))
  4554. (defun erc-add-default-channel (channel)
  4555. "Add CHANNEL to the default channel list."
  4556. (let ((d1 (car erc-default-recipients))
  4557. (d2 (cdr erc-default-recipients))
  4558. (chl (downcase channel)))
  4559. (setq erc-default-recipients
  4560. (cons chl erc-default-recipients))))
  4561. (defun erc-delete-default-channel (channel &optional buffer)
  4562. "Delete CHANNEL from the default channel list."
  4563. (let ((ob (current-buffer)))
  4564. (with-current-buffer (if (and buffer
  4565. (bufferp buffer))
  4566. buffer
  4567. (current-buffer))
  4568. (setq erc-default-recipients (delete (downcase channel)
  4569. erc-default-recipients)))))
  4570. (defun erc-add-query (nickname)
  4571. "Add QUERY'd NICKNAME to the default channel list.
  4572. The previous default target of QUERY type gets removed."
  4573. (let ((d1 (car erc-default-recipients))
  4574. (d2 (cdr erc-default-recipients))
  4575. (qt (cons 'QUERY (downcase nickname))))
  4576. (if (and (listp d1)
  4577. (eq (car d1) 'QUERY))
  4578. (setq erc-default-recipients (cons qt d2))
  4579. (setq erc-default-recipients (cons qt erc-default-recipients)))))
  4580. (defun erc-delete-query ()
  4581. "Delete the topmost target if it is a QUERY."
  4582. (let ((d1 (car erc-default-recipients))
  4583. (d2 (cdr erc-default-recipients)))
  4584. (if (and (listp d1)
  4585. (eq (car d1) 'QUERY))
  4586. (setq erc-default-recipients d2)
  4587. (error "Current target is not a QUERY"))))
  4588. (defun erc-ignored-user-p (spec)
  4589. "Return non-nil if SPEC matches something in `erc-ignore-list'.
  4590. Takes a full SPEC of a user in the form \"nick!login@host\", and
  4591. matches against all the regexp's in `erc-ignore-list'. If any
  4592. match, returns that regexp."
  4593. (catch 'found
  4594. (dolist (ignored (erc-with-server-buffer erc-ignore-list))
  4595. (if (string-match ignored spec)
  4596. (throw 'found ignored)))))
  4597. (defun erc-ignored-reply-p (msg tgt proc)
  4598. ;; FIXME: this docstring needs fixing -- Lawrence 2004-01-08
  4599. "Return non-nil if MSG matches something in `erc-ignore-reply-list'.
  4600. Takes a message MSG to a channel and returns non-nil if the addressed
  4601. user matches any regexp in `erc-ignore-reply-list'."
  4602. (let ((target-nick (erc-message-target msg)))
  4603. (if (not target-nick)
  4604. nil
  4605. (erc-with-buffer (tgt proc)
  4606. (let ((user (erc-get-server-user target-nick)))
  4607. (when user
  4608. (erc-list-match erc-ignore-reply-list
  4609. (erc-user-spec user))))))))
  4610. (defun erc-message-target (msg)
  4611. "Return the addressed target in MSG.
  4612. The addressed target is the string before the first colon in MSG."
  4613. (if (string-match "^\\([^: \n]*\\):" msg)
  4614. (match-string 1 msg)
  4615. nil))
  4616. (defun erc-user-spec (user)
  4617. "Create a nick!user@host spec from a user struct."
  4618. (let ((nick (erc-server-user-nickname user))
  4619. (host (erc-server-user-host user))
  4620. (login (erc-server-user-login user)))
  4621. (concat (if nick
  4622. nick
  4623. "")
  4624. "!"
  4625. (if login
  4626. login
  4627. "")
  4628. "@"
  4629. (if host
  4630. host
  4631. ""))))
  4632. (defun erc-list-match (lst str)
  4633. "Return non-nil if any regexp in LST matches STR."
  4634. (memq nil (mapcar (lambda (regexp)
  4635. (not (string-match regexp str)))
  4636. lst)))
  4637. ;; other "toggles"
  4638. (defun erc-toggle-ctcp-autoresponse (&optional arg)
  4639. "Toggle automatic CTCP replies (like VERSION and PING).
  4640. If ARG is positive, turns CTCP replies on.
  4641. If ARG is non-nil and not positive, turns CTCP replies off."
  4642. (interactive "P")
  4643. (cond ((and (numberp arg) (> arg 0))
  4644. (setq erc-disable-ctcp-replies t))
  4645. (arg (setq erc-disable-ctcp-replies nil))
  4646. (t (setq erc-disable-ctcp-replies (not erc-disable-ctcp-replies))))
  4647. (message "ERC CTCP replies are %s" (if erc-disable-ctcp-replies "OFF" "ON")))
  4648. (defun erc-toggle-flood-control (&optional arg)
  4649. "Toggle use of flood control on sent messages.
  4650. If ARG is positive, use flood control.
  4651. If ARG is non-nil and not positive, do not use flood control.
  4652. See `erc-server-flood-margin' for an explanation of the available
  4653. flood control parameters."
  4654. (interactive "P")
  4655. (cond ((and (numberp arg) (> arg 0))
  4656. (setq erc-flood-protect t))
  4657. (arg (setq erc-flood-protect nil))
  4658. (t (setq erc-flood-protect (not erc-flood-protect))))
  4659. (message "ERC flood control is %s"
  4660. (cond (erc-flood-protect "ON")
  4661. (t "OFF"))))
  4662. ;; Some useful channel and nick commands for fast key bindings
  4663. (defun erc-invite-only-mode (&optional arg)
  4664. "Turn on the invite only mode (+i) for the current channel.
  4665. If ARG is non-nil, turn this mode off (-i).
  4666. This command is sent even if excess flood is detected."
  4667. (interactive "P")
  4668. (erc-set-active-buffer (current-buffer))
  4669. (let ((tgt (erc-default-target))
  4670. (erc-force-send t))
  4671. (cond ((or (not tgt) (not (erc-channel-p tgt)))
  4672. (erc-display-message nil 'error (current-buffer) 'no-target))
  4673. (arg (erc-load-irc-script-lines (list (concat "/mode " tgt " -i"))
  4674. t))
  4675. (t (erc-load-irc-script-lines (list (concat "/mode " tgt " +i"))
  4676. t)))))
  4677. (defun erc-get-channel-mode-from-keypress (key)
  4678. "Read a key sequence and call the corresponding channel mode function.
  4679. After doing C-c C-o, type in a channel mode letter.
  4680. C-g means quit.
  4681. RET lets you type more than one mode at a time.
  4682. If \"l\" is pressed, `erc-set-channel-limit' gets called.
  4683. If \"k\" is pressed, `erc-set-channel-key' gets called.
  4684. Anything else will be sent to `erc-toggle-channel-mode'."
  4685. (interactive "kChannel mode (RET to set more than one): ")
  4686. (when (featurep 'xemacs)
  4687. (setq key (char-to-string (event-to-character (aref key 0)))))
  4688. (cond ((equal key "\C-g")
  4689. (keyboard-quit))
  4690. ((equal key "\C-m")
  4691. (erc-insert-mode-command))
  4692. ((equal key "l")
  4693. (call-interactively 'erc-set-channel-limit))
  4694. ((equal key "k")
  4695. (call-interactively 'erc-set-channel-key))
  4696. (t (erc-toggle-channel-mode key))))
  4697. (defun erc-toggle-channel-mode (mode &optional channel)
  4698. "Toggle channel MODE.
  4699. If CHANNEL is non-nil, toggle MODE for that channel, otherwise use
  4700. `erc-default-target'."
  4701. (interactive "P")
  4702. (erc-set-active-buffer (current-buffer))
  4703. (let ((tgt (or channel (erc-default-target)))
  4704. (erc-force-send t))
  4705. (cond ((or (null tgt) (null (erc-channel-p tgt)))
  4706. (erc-display-message nil 'error 'active 'no-target))
  4707. ((member mode erc-channel-modes)
  4708. (erc-log (format "%s: Toggle mode %s OFF" tgt mode))
  4709. (message "Toggle channel mode %s OFF" mode)
  4710. (erc-server-send (format "MODE %s -%s" tgt mode)))
  4711. (t (erc-log (format "%s: Toggle channel mode %s ON" tgt mode))
  4712. (message "Toggle channel mode %s ON" mode)
  4713. (erc-server-send (format "MODE %s +%s" tgt mode))))))
  4714. (defun erc-insert-mode-command ()
  4715. "Insert the line \"/mode <current target> \" at `point'."
  4716. (interactive)
  4717. (let ((tgt (erc-default-target)))
  4718. (if tgt (insert (concat "/mode " tgt " "))
  4719. (erc-display-message nil 'error (current-buffer) 'no-target))))
  4720. (defun erc-channel-names ()
  4721. "Run \"/names #channel\" in the current channel."
  4722. (interactive)
  4723. (erc-set-active-buffer (current-buffer))
  4724. (let ((tgt (erc-default-target)))
  4725. (if tgt (erc-load-irc-script-lines (list (concat "/names " tgt)))
  4726. (erc-display-message nil 'error (current-buffer) 'no-target))))
  4727. (defun erc-remove-text-properties-region (start end &optional object)
  4728. "Clears the region (START,END) in OBJECT from all colors, etc."
  4729. (interactive "r")
  4730. (save-excursion
  4731. (let ((inhibit-read-only t))
  4732. (set-text-properties start end nil object))))
  4733. (put 'erc-remove-text-properties-region 'disabled t)
  4734. ;; script execution and startup
  4735. (defun erc-find-file (file &optional path)
  4736. "Search for a FILE in the filesystem.
  4737. First the `default-directory' is searched for FILE, then any directories
  4738. specified in the list PATH.
  4739. If FILE is found, return the path to it."
  4740. (let ((filepath file))
  4741. (if (file-readable-p filepath) filepath
  4742. (progn
  4743. (while (and path
  4744. (progn (setq filepath (expand-file-name file (car path)))
  4745. (not (file-readable-p filepath))))
  4746. (setq path (cdr path)))
  4747. (if path filepath nil)))))
  4748. (defun erc-select-startup-file ()
  4749. "Select an ERC startup file.
  4750. See also `erc-startup-file-list'."
  4751. (catch 'found
  4752. (dolist (f erc-startup-file-list)
  4753. (setq f (convert-standard-filename f))
  4754. (when (file-readable-p f)
  4755. (throw 'found f)))))
  4756. (defun erc-find-script-file (file)
  4757. "Search for FILE in `default-directory', and any in `erc-script-path'."
  4758. (erc-find-file file erc-script-path))
  4759. (defun erc-load-script (file)
  4760. "Load a script from FILE.
  4761. FILE must be the full name, it is not searched in the
  4762. `erc-script-path'. If the filename ends with `.el', then load it
  4763. as an Emacs Lisp program. Otherwise, treat it as a regular IRC
  4764. script."
  4765. (erc-log (concat "erc-load-script: " file))
  4766. (cond
  4767. ((string-match "\\.el$" file)
  4768. (load file))
  4769. (t
  4770. (erc-load-irc-script file))))
  4771. (defun erc-process-script-line (line &optional args)
  4772. "Process an IRC script LINE.
  4773. Does script-specific substitutions (script arguments, current nick,
  4774. server, etc.) in LINE and returns it.
  4775. Substitutions are: %C and %c = current target (channel or nick),
  4776. %S %s = current server, %N %n = my current nick, and %x is x verbatim,
  4777. where x is any other character;
  4778. $* = the entire argument string, $1 = the first argument, $2 = the second,
  4779. and so on."
  4780. (if (not args) (setq args ""))
  4781. (let* ((arg-esc-regexp "\\(\\$\\(\\*\\|[1-9][0-9]*\\)\\)\\([^0-9]\\|$\\)")
  4782. (percent-regexp "\\(%.\\)")
  4783. (esc-regexp (concat arg-esc-regexp "\\|" percent-regexp))
  4784. (tgt (erc-default-target))
  4785. (server (and (boundp 'erc-session-server) erc-session-server))
  4786. (nick (erc-current-nick))
  4787. (res "")
  4788. (tmp nil)
  4789. (arg-list nil)
  4790. (arg-num 0))
  4791. (if (not tgt) (setq tgt ""))
  4792. (if (not server) (setq server ""))
  4793. (if (not nick) (setq nick ""))
  4794. ;; First, compute the argument list
  4795. (setq tmp args)
  4796. (while (string-match "^\\s-*\\(\\S-+\\)\\(\\s-+.*$\\|$\\)" tmp)
  4797. (setq arg-list (cons (match-string 1 tmp) arg-list))
  4798. (setq tmp (match-string 2 tmp)))
  4799. (setq arg-list (nreverse arg-list))
  4800. (setq arg-num (length arg-list))
  4801. ;; now do the substitution
  4802. (setq tmp (string-match esc-regexp line))
  4803. (while tmp
  4804. ;;(message "beginning of while: tmp=%S" tmp)
  4805. (let* ((hd (substring line 0 tmp))
  4806. (esc "")
  4807. (subst "")
  4808. (tail (substring line tmp)))
  4809. (cond ((string-match (concat "^" arg-esc-regexp) tail)
  4810. (setq esc (match-string 1 tail))
  4811. (setq tail (substring tail (match-end 1))))
  4812. ((string-match (concat "^" percent-regexp) tail)
  4813. (setq esc (match-string 1 tail))
  4814. (setq tail (substring tail (match-end 1)))))
  4815. ;;(message "hd=%S, esc=%S, tail=%S, arg-num=%S" hd esc tail arg-num)
  4816. (setq res (concat res hd))
  4817. (setq subst
  4818. (cond ((string= esc "") "")
  4819. ((string-match "^\\$\\*$" esc) args)
  4820. ((string-match "^\\$\\([0-9]+\\)$" esc)
  4821. (let ((n (string-to-number (match-string 1 esc))))
  4822. (message "n = %S, integerp(n)=%S" n (integerp n))
  4823. (if (<= n arg-num) (nth (1- n) arg-list) "")))
  4824. ((string-match "^%[Cc]$" esc) tgt)
  4825. ((string-match "^%[Ss]$" esc) server)
  4826. ((string-match "^%[Nn]$" esc) nick)
  4827. ((string-match "^%\\(.\\)$" esc) (match-string 1 esc))
  4828. (t (erc-log (format "BUG in erc-process-script-line: bad escape sequence: %S\n" esc))
  4829. (message "BUG IN ERC: esc=%S" esc)
  4830. "")))
  4831. (setq line tail)
  4832. (setq tmp (string-match esc-regexp line))
  4833. (setq res (concat res subst))
  4834. ;;(message "end of while: line=%S, res=%S, tmp=%S" line res tmp)
  4835. ))
  4836. (setq res (concat res line))
  4837. res))
  4838. (defun erc-load-irc-script (file &optional force)
  4839. "Load an IRC script from FILE."
  4840. (erc-log (concat "erc-load-script: " file))
  4841. (let ((str (with-temp-buffer
  4842. (insert-file-contents file)
  4843. (buffer-string))))
  4844. (erc-load-irc-script-lines (erc-split-multiline-safe str) force)))
  4845. (defun erc-load-irc-script-lines (lines &optional force noexpand)
  4846. "Load IRC script LINES (a list of strings).
  4847. If optional NOEXPAND is non-nil, do not expand script-specific
  4848. sequences, process the lines verbatim. Use this for multiline
  4849. user input."
  4850. (let* ((cb (current-buffer))
  4851. (pnt (point))
  4852. (s "")
  4853. (sp (or (erc-command-indicator) (erc-prompt)))
  4854. (args (and (boundp 'erc-script-args) erc-script-args)))
  4855. (if (and args (string-match "^ " args))
  4856. (setq args (substring args 1)))
  4857. ;; prepare the prompt string for echo
  4858. (erc-put-text-property 0 (length sp)
  4859. 'face 'erc-command-indicator-face sp)
  4860. (while lines
  4861. (setq s (car lines))
  4862. (erc-log (concat "erc-load-script: CMD: " s))
  4863. (unless (string-match "^\\s-*$" s)
  4864. (let ((line (if noexpand s (erc-process-script-line s args))))
  4865. (if (and (erc-process-input-line line force)
  4866. erc-script-echo)
  4867. (progn
  4868. (erc-put-text-property 0 (length line)
  4869. 'face 'erc-input-face line)
  4870. (erc-display-line (concat sp line) cb)))))
  4871. (setq lines (cdr lines)))))
  4872. ;; authentication
  4873. (defun erc-login ()
  4874. "Perform user authentication at the IRC server."
  4875. (erc-log (format "login: nick: %s, user: %s %s %s :%s"
  4876. (erc-current-nick)
  4877. (user-login-name)
  4878. (or erc-system-name (system-name))
  4879. erc-session-server
  4880. erc-session-user-full-name))
  4881. (if erc-session-password
  4882. (erc-server-send (format "PASS %s" erc-session-password))
  4883. (message "Logging in without password"))
  4884. (erc-server-send (format "NICK %s" (erc-current-nick)))
  4885. (erc-server-send
  4886. (format "USER %s %s %s :%s"
  4887. ;; hacked - S.B.
  4888. (if erc-anonymous-login erc-email-userid (user-login-name))
  4889. "0" "*"
  4890. erc-session-user-full-name))
  4891. (erc-update-mode-line))
  4892. ;; connection properties' heuristics
  4893. (defun erc-determine-parameters (&optional server port nick name)
  4894. "Determine the connection and authentication parameters.
  4895. Sets the buffer local variables:
  4896. - `erc-session-connector'
  4897. - `erc-session-server'
  4898. - `erc-session-port'
  4899. - `erc-session-full-name'
  4900. - `erc-server-current-nick'"
  4901. (setq erc-session-connector erc-server-connect-function
  4902. erc-session-server (erc-compute-server server)
  4903. erc-session-port (or port erc-default-port)
  4904. erc-session-user-full-name (erc-compute-full-name name))
  4905. (erc-set-current-nick (erc-compute-nick nick)))
  4906. (defun erc-compute-server (&optional server)
  4907. "Return an IRC server name.
  4908. This tries a number of increasingly more default methods until a
  4909. non-nil value is found.
  4910. - SERVER (the argument passed to this function)
  4911. - The `erc-server' option
  4912. - The value of the IRCSERVER environment variable
  4913. - The `erc-default-server' variable"
  4914. (or server
  4915. erc-server
  4916. (getenv "IRCSERVER")
  4917. erc-default-server))
  4918. (defun erc-compute-nick (&optional nick)
  4919. "Return user's IRC nick.
  4920. This tries a number of increasingly more default methods until a
  4921. non-nil value is found.
  4922. - NICK (the argument passed to this function)
  4923. - The `erc-nick' option
  4924. - The value of the IRCNICK environment variable
  4925. - The result from the `user-login-name' function"
  4926. (or nick
  4927. (if (consp erc-nick) (car erc-nick) erc-nick)
  4928. (getenv "IRCNICK")
  4929. (user-login-name)))
  4930. (defun erc-compute-full-name (&optional full-name)
  4931. "Return user's full name.
  4932. This tries a number of increasingly more default methods until a
  4933. non-nil value is found.
  4934. - FULL-NAME (the argument passed to this function)
  4935. - The `erc-user-full-name' option
  4936. - The value of the IRCNAME environment variable
  4937. - The result from the `user-full-name' function"
  4938. (or full-name
  4939. erc-user-full-name
  4940. (getenv "IRCNAME")
  4941. (if erc-anonymous-login "unknown" nil)
  4942. (user-full-name)))
  4943. (defun erc-compute-port (&optional port)
  4944. "Return a port for an IRC server.
  4945. This tries a number of increasingly more default methods until a
  4946. non-nil value is found.
  4947. - PORT (the argument passed to this function)
  4948. - The `erc-port' option
  4949. - The `erc-default-port' variable"
  4950. (or port erc-port erc-default-port))
  4951. ;; time routines
  4952. (defun erc-string-to-emacs-time (string)
  4953. "Convert the long number represented by STRING into an Emacs format.
  4954. Returns a list of the form (HIGH LOW), compatible with Emacs time format."
  4955. (let* ((n (string-to-number (concat string ".0"))))
  4956. (list (truncate (/ n 65536))
  4957. (truncate (mod n 65536)))))
  4958. (defun erc-emacs-time-to-erc-time (time)
  4959. "Convert Emacs TIME to a number of seconds since the epoch."
  4960. (when time
  4961. (+ (* (nth 0 time) 65536.0) (nth 1 time))))
  4962. ; (round (+ (* (nth 0 tm) 65536.0) (nth 1 tm))))
  4963. (defun erc-current-time ()
  4964. "Return the `current-time' as a number of seconds since the epoch.
  4965. See also `erc-emacs-time-to-erc-time'."
  4966. (erc-emacs-time-to-erc-time (current-time)))
  4967. (defun erc-time-diff (t1 t2)
  4968. "Return the time difference in seconds between T1 and T2."
  4969. (abs (- t2 t1)))
  4970. (defun erc-time-gt (t1 t2)
  4971. "Check whether T1 > T2."
  4972. (> t1 t2))
  4973. (defun erc-sec-to-time (ns)
  4974. "Convert NS to a time string HH:MM.SS."
  4975. (setq ns (truncate ns))
  4976. (format "%02d:%02d.%02d"
  4977. (/ ns 3600)
  4978. (/ (% ns 3600) 60)
  4979. (% ns 60)))
  4980. (defun erc-seconds-to-string (seconds)
  4981. "Convert a number of SECONDS into an English phrase."
  4982. (let (days hours minutes format-args output)
  4983. (setq days (/ seconds 86400)
  4984. seconds (% seconds 86400)
  4985. hours (/ seconds 3600)
  4986. seconds (% seconds 3600)
  4987. minutes (/ seconds 60)
  4988. seconds (% seconds 60)
  4989. format-args (if (> days 0)
  4990. `("%d days, %d hours, %d minutes, %d seconds"
  4991. ,days ,hours ,minutes ,seconds)
  4992. (if (> hours 0)
  4993. `("%d hours, %d minutes, %d seconds"
  4994. ,hours ,minutes ,seconds)
  4995. (if (> minutes 0)
  4996. `("%d minutes, %d seconds" ,minutes ,seconds)
  4997. `("%d seconds" ,seconds))))
  4998. output (apply 'format format-args))
  4999. ;; Change all "1 units" to "1 unit".
  5000. (while (string-match "\\([^0-9]\\|^\\)1 \\S-+\\(s\\)" output)
  5001. (setq output (erc-replace-match-subexpression-in-string
  5002. "" output (match-string 2 output) 2 (match-beginning 2))))
  5003. output))
  5004. ;; info
  5005. (defconst erc-clientinfo-alist
  5006. '(("ACTION" . "is used to inform about one's current activity")
  5007. ("CLIENTINFO" . "gives help on CTCP commands supported by client")
  5008. ("ECHO" . "echoes its arguments back")
  5009. ("FINGER" . "shows user's name, location, and idle time")
  5010. ("PING" . "measures delay between peers")
  5011. ("TIME" . "shows client-side time")
  5012. ("USERINFO" . "shows information provided by a user")
  5013. ("VERSION" . "shows client type and version"))
  5014. "Alist of CTCP CLIENTINFO for ERC commands.")
  5015. (defun erc-client-info (s)
  5016. "Return CTCP CLIENTINFO on command S.
  5017. If S is nil or an empty string then return general CLIENTINFO."
  5018. (if (or (not s) (string= s ""))
  5019. (concat
  5020. (apply #'concat
  5021. (mapcar (lambda (e)
  5022. (concat (car e) " "))
  5023. erc-clientinfo-alist))
  5024. ": use CLIENTINFO <COMMAND> to get more specific information")
  5025. (let ((h (assoc (upcase s) erc-clientinfo-alist)))
  5026. (if h
  5027. (concat s " " (cdr h))
  5028. (concat s ": unknown command")))))
  5029. ;; Hook functions
  5030. (defun erc-directory-writable-p (dir)
  5031. "Determine whether DIR is a writable directory.
  5032. If it doesn't exist, create it."
  5033. (unless (file-attributes dir) (make-directory dir))
  5034. (or (file-accessible-directory-p dir) (error "Cannot access %s" dir)))
  5035. (defun erc-kill-query-buffers (process)
  5036. "Kill all buffers of PROCESS."
  5037. ;; here, we only want to match the channel buffers, to avoid
  5038. ;; "selecting killed buffers" b0rkage.
  5039. (erc-with-all-buffers-of-server process
  5040. (lambda ()
  5041. (not (erc-server-buffer-p)))
  5042. (kill-buffer (current-buffer))))
  5043. (defun erc-nick-at-point ()
  5044. "Give information about the nickname at `point'.
  5045. If called interactively, give a human readable message in the
  5046. minibuffer. If called programmatically, return the corresponding
  5047. entry of `channel-members'."
  5048. (interactive)
  5049. (require 'thingatpt)
  5050. (let* ((word (word-at-point))
  5051. (channel-data (erc-get-channel-user word))
  5052. (cuser (cdr channel-data))
  5053. (user (if channel-data
  5054. (car channel-data)
  5055. (erc-get-server-user word)))
  5056. host login full-name info nick op voice)
  5057. (when user
  5058. (setq nick (erc-server-user-nickname user)
  5059. host (erc-server-user-host user)
  5060. login (erc-server-user-login user)
  5061. full-name (erc-server-user-full-name user)
  5062. info (erc-server-user-info user))
  5063. (if cuser
  5064. (setq op (erc-channel-user-op cuser)
  5065. voice (erc-channel-user-voice cuser)))
  5066. (if (interactive-p)
  5067. (message "%s is %s@%s%s%s"
  5068. nick login host
  5069. (if full-name (format " (%s)" full-name) "")
  5070. (if (or op voice)
  5071. (format " and is +%s%s on %s"
  5072. (if op "o" "")
  5073. (if voice "v" "")
  5074. (erc-default-target))
  5075. ""))
  5076. user))))
  5077. (defun erc-away-time ()
  5078. "Return non-nil if the current ERC process is set away.
  5079. In particular, the time that we were set away is returned.
  5080. See `current-time' for details on the time format."
  5081. (erc-with-server-buffer erc-away))
  5082. ;; Mode line handling
  5083. (defcustom erc-mode-line-format "%S %a"
  5084. "A string to be formatted and shown in the mode-line in `erc-mode'.
  5085. The string is formatted using `format-spec' and the result is set as the value
  5086. of `mode-line-buffer-identification'.
  5087. The following characters are replaced:
  5088. %a: String indicating away status or \"\" if you are not away
  5089. %l: The estimated lag time to the server
  5090. %m: The modes of the channel
  5091. %n: The current nick name
  5092. %N: The name of the network
  5093. %o: The topic of the channel
  5094. %p: The session port
  5095. %t: The name of the target (channel, nickname, or servername:port)
  5096. %s: In the server-buffer, this gets filled with the value of
  5097. `erc-server-announced-name', in a channel, the value of
  5098. (erc-default-target) also get concatenated.
  5099. %S: In the server-buffer, this gets filled with the value of
  5100. `erc-network', in a channel, the value of (erc-default-target)
  5101. also get concatenated."
  5102. :group 'erc-mode-line-and-header
  5103. :type 'string)
  5104. (defcustom erc-header-line-format "%n on %t (%m,%l) %o"
  5105. "A string to be formatted and shown in the header-line in `erc-mode'.
  5106. Only used starting in Emacs 21.
  5107. Set this to nil if you do not want the header line to be
  5108. displayed.
  5109. See `erc-mode-line-format' for which characters are can be used."
  5110. :group 'erc-mode-line-and-header
  5111. :set (lambda (sym val)
  5112. (set sym val)
  5113. (when (fboundp 'erc-update-mode-line)
  5114. (erc-update-mode-line nil)))
  5115. :type '(choice (const :tag "Disabled" nil)
  5116. string))
  5117. (defcustom erc-header-line-uses-tabbar-p nil
  5118. "Use tabbar mode instead of the header line to display the header."
  5119. :group 'erc-mode-line-and-header
  5120. :type 'boolean)
  5121. (defcustom erc-header-line-uses-help-echo-p t
  5122. "Show the contents of the header line in the echo area or as a tooltip
  5123. when you move point into the header line."
  5124. :group 'erc-mode-line-and-header
  5125. :type 'boolean)
  5126. (defcustom erc-header-line-face-method nil
  5127. "Determine what method to use when colorizing the header line text.
  5128. If nil, don't colorize the header text.
  5129. If given a function, call it and use the resulting face name.
  5130. Otherwise, use the `erc-header-line' face."
  5131. :group 'erc-mode-line-and-header
  5132. :type '(choice (const :tag "Don't colorize" nil)
  5133. (const :tag "Use the erc-header-line face" t)
  5134. (function :tag "Call a function")))
  5135. (defcustom erc-show-channel-key-p t
  5136. "Show the channel key in the header line."
  5137. :group 'erc-paranoia
  5138. :type 'boolean)
  5139. (defcustom erc-common-server-suffixes
  5140. '(("openprojects.net$" . "OPN")
  5141. ("freenode.net$" . "freenode")
  5142. ("oftc.net$" . "OFTC"))
  5143. "Alist of common server name suffixes.
  5144. This variable is used in mode-line display to save screen
  5145. real estate. Set it to nil if you want to avoid changing
  5146. displayed hostnames."
  5147. :group 'erc-mode-line-and-header
  5148. :type 'alist)
  5149. (defcustom erc-mode-line-away-status-format
  5150. "(AWAY since %a %b %d %H:%M) "
  5151. "When you're away on a server, this is shown in the mode line.
  5152. This should be a string with substitution variables recognized by
  5153. `format-time-string'."
  5154. :group 'erc-mode-line-and-header
  5155. :type 'string)
  5156. (defun erc-shorten-server-name (server-name)
  5157. "Shorten SERVER-NAME according to `erc-common-server-suffixes'."
  5158. (if (stringp server-name)
  5159. (with-temp-buffer
  5160. (insert server-name)
  5161. (let ((alist erc-common-server-suffixes))
  5162. (while alist
  5163. (goto-char (point-min))
  5164. (if (re-search-forward (caar alist) nil t)
  5165. (replace-match (cdar alist)))
  5166. (setq alist (cdr alist))))
  5167. (buffer-string))))
  5168. (defun erc-format-target ()
  5169. "Return the name of the target (channel or nickname or servername:port)."
  5170. (let ((target (erc-default-target)))
  5171. (or target
  5172. (concat (erc-shorten-server-name
  5173. (or erc-server-announced-name
  5174. erc-session-server))
  5175. ":" (erc-port-to-string erc-session-port)))))
  5176. (defun erc-format-target-and/or-server ()
  5177. "Return the server name or the current target and server name combined."
  5178. (let ((server-name (erc-shorten-server-name
  5179. (or erc-server-announced-name
  5180. erc-session-server))))
  5181. (cond ((erc-default-target)
  5182. (concat (erc-string-no-properties (erc-default-target))
  5183. "@" server-name))
  5184. (server-name server-name)
  5185. (t (buffer-name (current-buffer))))))
  5186. (defun erc-format-network ()
  5187. "Return the name of the network we are currently on."
  5188. (let ((network (and (fboundp 'erc-network-name) (erc-network-name))))
  5189. (if (and network (symbolp network))
  5190. (symbol-name network)
  5191. "")))
  5192. (defun erc-format-target-and/or-network ()
  5193. "Return the network or the current target and network combined.
  5194. If the name of the network is not available, then use the
  5195. shortened server name instead."
  5196. (let ((network-name (or (and (fboundp 'erc-network-name) (erc-network-name))
  5197. (erc-shorten-server-name
  5198. (or erc-server-announced-name
  5199. erc-session-server)))))
  5200. (when (and network-name (symbolp network-name))
  5201. (setq network-name (symbol-name network-name)))
  5202. (cond ((erc-default-target)
  5203. (concat (erc-string-no-properties (erc-default-target))
  5204. "@" network-name))
  5205. (network-name network-name)
  5206. (t (buffer-name (current-buffer))))))
  5207. (defun erc-format-away-status ()
  5208. "Return a formatted `erc-mode-line-away-status-format'
  5209. if `erc-away' is non-nil."
  5210. (let ((a (erc-away-time)))
  5211. (if a
  5212. (format-time-string erc-mode-line-away-status-format a)
  5213. "")))
  5214. (defun erc-format-channel-modes ()
  5215. "Return the current channel's modes."
  5216. (concat (apply 'concat
  5217. "+" erc-channel-modes)
  5218. (cond ((and erc-channel-user-limit erc-channel-key)
  5219. (if erc-show-channel-key-p
  5220. (format "lk %.0f %s" erc-channel-user-limit
  5221. erc-channel-key)
  5222. (format "kl %.0f" erc-channel-user-limit)))
  5223. (erc-channel-user-limit
  5224. ;; Emacs has no bignums
  5225. (format "l %.0f" erc-channel-user-limit))
  5226. (erc-channel-key
  5227. (if erc-show-channel-key-p
  5228. (format "k %s" erc-channel-key)
  5229. "k"))
  5230. (t nil))))
  5231. (defun erc-format-lag-time ()
  5232. "Return the estimated lag time to server, `erc-server-lag'."
  5233. (let ((lag (erc-with-server-buffer erc-server-lag)))
  5234. (cond (lag (format "lag:%.0f" lag))
  5235. (t ""))))
  5236. ;; erc-goodies is required at end of this file.
  5237. (declare-function erc-controls-strip "erc-goodies" (str))
  5238. (defvar tabbar--local-hlf)
  5239. (defun erc-update-mode-line-buffer (buffer)
  5240. "Update the mode line in a single ERC buffer BUFFER."
  5241. (with-current-buffer buffer
  5242. (let ((spec (format-spec-make
  5243. ?a (erc-format-away-status)
  5244. ?l (erc-format-lag-time)
  5245. ?m (erc-format-channel-modes)
  5246. ?n (or (erc-current-nick) "")
  5247. ?N (erc-format-network)
  5248. ?o (erc-controls-strip erc-channel-topic)
  5249. ?p (erc-port-to-string erc-session-port)
  5250. ?s (erc-format-target-and/or-server)
  5251. ?S (erc-format-target-and/or-network)
  5252. ?t (erc-format-target)))
  5253. (process-status (cond ((and (erc-server-process-alive)
  5254. (not erc-server-connected))
  5255. ":connecting")
  5256. ((erc-server-process-alive)
  5257. "")
  5258. (t
  5259. ": CLOSED")))
  5260. (face (cond ((eq erc-header-line-face-method nil)
  5261. nil)
  5262. ((functionp erc-header-line-face-method)
  5263. (funcall erc-header-line-face-method))
  5264. (t
  5265. 'erc-header-line))))
  5266. (cond ((featurep 'xemacs)
  5267. (setq modeline-buffer-identification
  5268. (list (format-spec erc-mode-line-format spec)))
  5269. (setq modeline-process (list process-status)))
  5270. (t
  5271. (setq mode-line-buffer-identification
  5272. (list (format-spec erc-mode-line-format spec)))
  5273. (setq mode-line-process (list process-status))))
  5274. (when (boundp 'header-line-format)
  5275. (let ((header (if erc-header-line-format
  5276. (format-spec erc-header-line-format spec)
  5277. nil)))
  5278. (cond (erc-header-line-uses-tabbar-p
  5279. (set (make-local-variable 'tabbar--local-hlf)
  5280. header-line-format)
  5281. (kill-local-variable 'header-line-format))
  5282. ((null header)
  5283. (setq header-line-format nil))
  5284. (erc-header-line-uses-help-echo-p
  5285. (let ((help-echo (with-temp-buffer
  5286. (insert header)
  5287. (fill-region (point-min) (point-max))
  5288. (buffer-string))))
  5289. (setq header-line-format
  5290. (erc-replace-regexp-in-string
  5291. "%"
  5292. "%%"
  5293. (if face
  5294. (erc-propertize header 'help-echo help-echo
  5295. 'face face)
  5296. (erc-propertize header 'help-echo help-echo))))))
  5297. (t (setq header-line-format
  5298. (if face
  5299. (erc-propertize header 'face face)
  5300. header)))))))
  5301. (if (featurep 'xemacs)
  5302. (redraw-modeline)
  5303. (force-mode-line-update))))
  5304. (defun erc-update-mode-line (&optional buffer)
  5305. "Update the mode line in BUFFER.
  5306. If BUFFER is nil, update the mode line in all ERC buffers."
  5307. (if (and buffer (bufferp buffer))
  5308. (erc-update-mode-line-buffer buffer)
  5309. (dolist (buf (erc-buffer-list))
  5310. (when (buffer-live-p buf)
  5311. (erc-update-mode-line-buffer buf)))))
  5312. ;; Miscellaneous
  5313. (defun erc-port-to-string (p)
  5314. "Convert port P to a string.
  5315. P may be an integer or a service name."
  5316. (if (integerp p)
  5317. (int-to-string p)
  5318. p))
  5319. (defun erc-string-to-port (s)
  5320. "Convert string S to either an integer port number or a service name."
  5321. (if (numberp s)
  5322. s
  5323. (let ((n (string-to-number s)))
  5324. (if (= n 0)
  5325. s
  5326. n))))
  5327. (defun erc-version (&optional here)
  5328. "Show the version number of ERC in the minibuffer.
  5329. If optional argument HERE is non-nil, insert version number at point."
  5330. (interactive "P")
  5331. (let ((version-string
  5332. (format "ERC %s (GNU Emacs %s)" erc-version-string emacs-version)))
  5333. (if here
  5334. (insert version-string)
  5335. (if (interactive-p)
  5336. (message "%s" version-string)
  5337. version-string))))
  5338. (defun erc-modes (&optional here)
  5339. "Show the active ERC modes in the minibuffer.
  5340. If optional argument HERE is non-nil, insert version number at point."
  5341. (interactive "P")
  5342. (let ((string
  5343. (mapconcat 'identity
  5344. (let (modes (case-fold-search nil))
  5345. (dolist (var (apropos-internal "^erc-.*mode$"))
  5346. (when (and (boundp var)
  5347. (symbol-value var))
  5348. (setq modes (cons (symbol-name var)
  5349. modes))))
  5350. modes)
  5351. ", ")))
  5352. (if here
  5353. (insert string)
  5354. (if (interactive-p)
  5355. (message "%s" string)
  5356. string))))
  5357. (defun erc-trim-string (s)
  5358. "Trim leading and trailing spaces off S."
  5359. (cond
  5360. ((not (stringp s)) nil)
  5361. ((string-match "^\\s-*$" s)
  5362. "")
  5363. ((string-match "^\\s-*\\(.*\\S-\\)\\s-*$" s)
  5364. (match-string 1 s))
  5365. (t
  5366. s)))
  5367. (defun erc-arrange-session-in-multiple-windows ()
  5368. "Open a window for every non-server buffer related to `erc-session-server'.
  5369. All windows are opened in the current frame."
  5370. (interactive)
  5371. (unless erc-server-process
  5372. (error "No erc-server-process found in current buffer"))
  5373. (let ((bufs (erc-buffer-list nil erc-server-process)))
  5374. (when bufs
  5375. (delete-other-windows)
  5376. (switch-to-buffer (car bufs))
  5377. (setq bufs (cdr bufs))
  5378. (while bufs
  5379. (split-window)
  5380. (other-window 1)
  5381. (switch-to-buffer (car bufs))
  5382. (setq bufs (cdr bufs))
  5383. (balance-windows)))))
  5384. (defun erc-popup-input-buffer ()
  5385. "Provide an input buffer."
  5386. (interactive)
  5387. (let ((buffer-name (generate-new-buffer-name "*ERC input*"))
  5388. (mode (intern
  5389. (completing-read
  5390. "Mode: "
  5391. (mapcar (lambda (e)
  5392. (list (symbol-name e)))
  5393. (apropos-internal "-mode$" 'commandp))
  5394. nil t))))
  5395. (pop-to-buffer (make-indirect-buffer (current-buffer) buffer-name))
  5396. (funcall mode)
  5397. (narrow-to-region (point) (point))
  5398. (shrink-window-if-larger-than-buffer)))
  5399. ;;; Message catalog
  5400. (defun erc-make-message-variable-name (catalog entry)
  5401. "Create a variable name corresponding to CATALOG's ENTRY."
  5402. (intern (concat "erc-message-"
  5403. (symbol-name catalog) "-" (symbol-name entry))))
  5404. (defun erc-define-catalog-entry (catalog entry format-spec)
  5405. "Set CATALOG's ENTRY to FORMAT-SPEC."
  5406. (set (erc-make-message-variable-name catalog entry)
  5407. format-spec))
  5408. (defun erc-define-catalog (catalog entries)
  5409. "Define a CATALOG according to ENTRIES."
  5410. (dolist (entry entries)
  5411. (erc-define-catalog-entry catalog (car entry) (cdr entry))))
  5412. (erc-define-catalog
  5413. 'english
  5414. '((bad-ping-response . "Unexpected PING response from %n (time %t)")
  5415. (bad-syntax . "Error occurred - incorrect usage?\n%c %u\n%d")
  5416. (incorrect-args . "Incorrect arguments. Usage:\n%c %u\n%d")
  5417. (cannot-find-file . "Cannot find file %f")
  5418. (cannot-read-file . "Cannot read file %f")
  5419. (connect . "Connecting to %S:%p... ")
  5420. (country . "%c")
  5421. (country-unknown . "%d: No such domain")
  5422. (ctcp-empty . "Illegal empty CTCP query received from %n. Ignoring.")
  5423. (ctcp-request . "==> CTCP request from %n (%u@%h): %r")
  5424. (ctcp-request-to . "==> CTCP request from %n (%u@%h) to %t: %r")
  5425. (ctcp-too-many . "Too many CTCP queries in single message. Ignoring")
  5426. (flood-ctcp-off . "FLOOD PROTECTION: Automatic CTCP responses turned off.")
  5427. (flood-strict-mode
  5428. . "FLOOD PROTECTION: Switched to Strict Flood Control mode.")
  5429. (disconnected . "\n\nConnection failed! Re-establishing connection...\n")
  5430. (disconnected-noreconnect
  5431. . "\n\nConnection failed! Not re-establishing connection.\n")
  5432. (finished . "\n\n*** ERC finished ***\n")
  5433. (terminated . "\n\n*** ERC terminated: %e\n")
  5434. (login . "Logging in as \'%n\'...")
  5435. (nick-in-use . "%n is in use. Choose new nickname: ")
  5436. (nick-too-long
  5437. . "WARNING: Nick length (%i) exceeds max NICKLEN(%l) defined by server")
  5438. (no-default-channel . "No default channel")
  5439. (no-invitation . "You've got no invitation")
  5440. (no-target . "No target")
  5441. (ops . "%i operator%s: %o")
  5442. (ops-none . "No operators in this channel.")
  5443. (undefined-ctcp . "Undefined CTCP query received. Silently ignored")
  5444. (variable-not-bound . "Variable not bound!")
  5445. (ACTION . "* %n %a")
  5446. (CTCP-CLIENTINFO . "Client info for %n: %m")
  5447. (CTCP-ECHO . "Echo %n: %m")
  5448. (CTCP-FINGER . "Finger info for %n: %m")
  5449. (CTCP-PING . "Ping time to %n is %t")
  5450. (CTCP-TIME . "Time by %n is %m")
  5451. (CTCP-UNKNOWN . "Unknown CTCP message from %n (%u@%h): %m")
  5452. (CTCP-VERSION . "Version for %n is %m")
  5453. (ERROR . "==> ERROR from %s: %c\n")
  5454. (INVITE . "%n (%u@%h) invites you to channel %c")
  5455. (JOIN . "%n (%u@%h) has joined channel %c")
  5456. (JOIN-you . "You have joined channel %c")
  5457. (KICK . "%n (%u@%h) has kicked %k off channel %c: %r")
  5458. (KICK-you . "You have been kicked off channel %c by %n (%u@%h): %r")
  5459. (KICK-by-you . "You have kicked %k off channel %c: %r")
  5460. (MODE . "%n (%u@%h) has changed mode for %t to %m")
  5461. (MODE-nick . "%n has changed mode for %t to %m")
  5462. (NICK . "%n (%u@%h) is now known as %N")
  5463. (NICK-you . "Your new nickname is %N")
  5464. (PART . erc-message-english-PART)
  5465. (PING . "PING from server (last: %s sec. ago)")
  5466. (PONG . "PONG from %h (%i second%s)")
  5467. (QUIT . "%n (%u@%h) has quit: %r")
  5468. (TOPIC . "%n (%u@%h) has set the topic for %c: \"%T\"")
  5469. (WALLOPS . "Wallops from %n: %m")
  5470. (s004 . "%s %v %U %C")
  5471. (s221 . "User modes for %n: %m")
  5472. (s252 . "%i operator(s) online")
  5473. (s253 . "%i unknown connection(s)")
  5474. (s254 . "%i channels formed")
  5475. (s275 . "%n %m")
  5476. (s301 . "%n is AWAY: %r")
  5477. (s303 . "Is online: %n")
  5478. (s305 . "%m")
  5479. (s306 . "%m")
  5480. (s307 . "%n %m")
  5481. (s311 . "%n is %f (%u@%h)")
  5482. (s312 . "%n is/was on server %s (%c)")
  5483. (s313 . "%n is an IRC operator")
  5484. (s314 . "%n was %f (%u@%h)")
  5485. (s317 . "%n has been idle for %i")
  5486. (s317-on-since . "%n has been idle for %i, on since %t")
  5487. (s319 . "%n is on channel(s): %c")
  5488. (s320 . "%n is an identified user")
  5489. (s321 . "Channel Users Topic")
  5490. (s322 . "%c [%u] %t")
  5491. (s324 . "%c modes: %m")
  5492. (s328 . "%c URL: %u")
  5493. (s329 . "%c was created on %t")
  5494. (s330 . "%n %a %i")
  5495. (s331 . "No topic is set for %c")
  5496. (s332 . "Topic for %c: %T")
  5497. (s333 . "%c: topic set by %n, %t")
  5498. (s341 . "Inviting %n to channel %c")
  5499. (s352 . "%-11c %-10n %-4a %u@%h (%f)")
  5500. (s353 . "Users on %c: %u")
  5501. (s367 . "Ban for %b on %c")
  5502. (s367-set-by . "Ban for %b on %c set by %s on %t")
  5503. (s368 . "Banlist of %c ends.")
  5504. (s379 . "%c: Forwarded to %f")
  5505. (s391 . "The time at %s is %t")
  5506. (s401 . "%n: No such nick/channel")
  5507. (s403 . "%c: No such channel")
  5508. (s404 . "%c: Cannot send to channel")
  5509. (s405 . "%c: You have joined too many channels")
  5510. (s406 . "%n: There was no such nickname")
  5511. (s412 . "No text to send")
  5512. (s421 . "%c: Unknown command")
  5513. (s431 . "No nickname given")
  5514. (s432 . "%n is an erroneous nickname")
  5515. (s442 . "%c: You're not on that channel")
  5516. (s445 . "SUMMON has been disabled")
  5517. (s446 . "USERS has been disabled")
  5518. (s451 . "You have not registered")
  5519. (s461 . "%c: not enough parameters")
  5520. (s462 . "Unauthorized command (already registered)")
  5521. (s463 . "Your host isn't among the privileged")
  5522. (s464 . "Password incorrect")
  5523. (s465 . "You are banned from this server")
  5524. (s474 . "You can't join %c because you're banned (+b)")
  5525. (s475 . "You must specify the correct channel key (+k) to join %c")
  5526. (s481 . "Permission Denied - You're not an IRC operator")
  5527. (s482 . "You need to be a channel operator of %c to do that")
  5528. (s483 . "You can't kill a server!")
  5529. (s484 . "Your connection is restricted!")
  5530. (s485 . "You're not the original channel operator")
  5531. (s491 . "No O-lines for your host")
  5532. (s501 . "Unknown MODE flag")
  5533. (s502 . "You can't change modes for other users")
  5534. (s671 . "%n %a")))
  5535. (defun erc-message-english-PART (&rest args)
  5536. "Format a proper PART message.
  5537. This function is an example on what could be done with formatting
  5538. functions."
  5539. (let ((nick (cadr (memq ?n args)))
  5540. (user (cadr (memq ?u args)))
  5541. (host (cadr (memq ?h args)))
  5542. (channel (cadr (memq ?c args)))
  5543. (reason (cadr (memq ?r args))))
  5544. (if (string= nick (erc-current-nick))
  5545. (format "You have left channel %s" channel)
  5546. (format "%s (%s@%s) has left channel %s%s"
  5547. nick user host channel
  5548. (if (not (string= reason ""))
  5549. (format ": %s"
  5550. (erc-replace-regexp-in-string "%" "%%" reason))
  5551. "")))))
  5552. (defvar erc-current-message-catalog 'english)
  5553. (make-variable-buffer-local 'erc-current-message-catalog)
  5554. (defun erc-retrieve-catalog-entry (entry &optional catalog)
  5555. "Retrieve ENTRY from CATALOG.
  5556. If CATALOG is nil, `erc-current-message-catalog' is used.
  5557. If ENTRY is nil in CATALOG, it is retrieved from the fallback,
  5558. english, catalog."
  5559. (unless catalog (setq catalog erc-current-message-catalog))
  5560. (let ((var (erc-make-message-variable-name catalog entry)))
  5561. (if (boundp var)
  5562. (symbol-value var)
  5563. (when (boundp (erc-make-message-variable-name 'english entry))
  5564. (symbol-value (erc-make-message-variable-name 'english entry))))))
  5565. (defun erc-format-message (msg &rest args)
  5566. "Format MSG according to ARGS.
  5567. See also `format-spec'."
  5568. (when (eq (logand (length args) 1) 1) ; oddp
  5569. (error "Obscure usage of this function appeared"))
  5570. (let ((entry (erc-retrieve-catalog-entry msg)))
  5571. (when (not entry)
  5572. (error "No format spec for message %s" msg))
  5573. (when (functionp entry)
  5574. (setq entry (apply entry args)))
  5575. (format-spec entry (apply 'format-spec-make args))))
  5576. ;;; Various hook functions
  5577. (add-hook 'kill-buffer-hook 'erc-kill-buffer-function)
  5578. (defcustom erc-kill-server-hook '(erc-kill-server)
  5579. "*Invoked whenever a server-buffer is killed via `kill-buffer'."
  5580. :group 'erc-hooks
  5581. :type 'hook)
  5582. (defcustom erc-kill-channel-hook '(erc-kill-channel)
  5583. "*Invoked whenever a channel-buffer is killed via `kill-buffer'."
  5584. :group 'erc-hooks
  5585. :type 'hook)
  5586. (defcustom erc-kill-buffer-hook nil
  5587. "*Hook run whenever a non-server or channel buffer is killed.
  5588. See also `kill-buffer'."
  5589. :group 'erc-hooks
  5590. :type 'hook)
  5591. (defun erc-kill-buffer-function ()
  5592. "Function to call when an ERC buffer is killed.
  5593. This function should be on `kill-buffer-hook'.
  5594. When the current buffer is in `erc-mode', this function will run
  5595. one of the following hooks:
  5596. `erc-kill-server-hook' if the server buffer was killed,
  5597. `erc-kill-channel-hook' if a channel buffer was killed,
  5598. or `erc-kill-buffer-hook' if any other buffer."
  5599. (when (eq major-mode 'erc-mode)
  5600. (erc-remove-channel-users)
  5601. (cond
  5602. ((eq (erc-server-buffer) (current-buffer))
  5603. (run-hooks 'erc-kill-server-hook))
  5604. ((erc-channel-p (erc-default-target))
  5605. (run-hooks 'erc-kill-channel-hook))
  5606. (t
  5607. (run-hooks 'erc-kill-buffer-hook)))))
  5608. (defun erc-kill-server ()
  5609. "Sends a QUIT command to the server when the server buffer is killed.
  5610. This function should be on `erc-kill-server-hook'."
  5611. (when (erc-server-process-alive)
  5612. (setq erc-server-quitting t)
  5613. (erc-server-send (format "QUIT :%s" (funcall erc-quit-reason nil)))))
  5614. (defun erc-kill-channel ()
  5615. "Sends a PART command to the server when the channel buffer is killed.
  5616. This function should be on `erc-kill-channel-hook'."
  5617. (when (erc-server-process-alive)
  5618. (let ((tgt (erc-default-target)))
  5619. (erc-server-send (format "PART %s :%s" tgt
  5620. (funcall erc-part-reason nil))
  5621. nil tgt))))
  5622. ;;; Dealing with `erc-parsed'
  5623. (defun erc-find-parsed-property ()
  5624. "Find the next occurrence of the `erc-parsed' text property."
  5625. (text-property-not-all (point-min) (point-max) 'erc-parsed nil))
  5626. (defun erc-restore-text-properties ()
  5627. "Restore the property 'erc-parsed for the region."
  5628. (let ((parsed-posn (erc-find-parsed-property)))
  5629. (put-text-property
  5630. (point-min) (point-max)
  5631. 'erc-parsed (when parsed-posn (erc-get-parsed-vector parsed-posn)))))
  5632. (defun erc-get-parsed-vector (point)
  5633. "Return the whole parsed vector on POINT."
  5634. (get-text-property point 'erc-parsed))
  5635. (defun erc-get-parsed-vector-nick (vect)
  5636. "Return nickname in the parsed vector VECT."
  5637. (let* ((untreated-nick (and vect (erc-response.sender vect)))
  5638. (maybe-nick (when untreated-nick
  5639. (car (split-string untreated-nick "!")))))
  5640. (when (and (not (null maybe-nick))
  5641. (erc-is-valid-nick-p maybe-nick))
  5642. untreated-nick)))
  5643. (defun erc-get-parsed-vector-type (vect)
  5644. "Return message type in the parsed vector VECT."
  5645. (and vect
  5646. (erc-response.command vect)))
  5647. ;; Teach url.el how to open irc:// URLs with ERC.
  5648. ;; To activate, customize `url-irc-function' to `url-irc-erc'.
  5649. ;;;###autoload
  5650. (defun erc-handle-irc-url (host port channel user password)
  5651. "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD.
  5652. If ERC is already connected to HOST:PORT, simply /join CHANNEL.
  5653. Otherwise, connect to HOST:PORT as USER and /join CHANNEL."
  5654. (let ((server-buffer
  5655. (car (erc-buffer-filter
  5656. (lambda ()
  5657. (and (string-equal erc-session-server host)
  5658. (= erc-session-port port)
  5659. (erc-open-server-buffer-p)))))))
  5660. (with-current-buffer (or server-buffer (current-buffer))
  5661. (if (and server-buffer channel)
  5662. (erc-cmd-JOIN channel)
  5663. (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name)
  5664. (not server-buffer) password nil channel
  5665. (when server-buffer
  5666. (get-buffer-process server-buffer)))))))
  5667. (provide 'erc)
  5668. ;;; Deprecated. We might eventually stop requiring the goodies automatically.
  5669. ;;; IMPORTANT: This require must appear _after_ the above (provide 'erc) to
  5670. ;;; avoid a recursive require error when byte-compiling the entire package.
  5671. (require 'erc-goodies)
  5672. ;;; erc.el ends here
  5673. ;;
  5674. ;; Local Variables:
  5675. ;; outline-regexp: ";;+"
  5676. ;; indent-tabs-mode: t
  5677. ;; tab-width: 8
  5678. ;; End: