ps-print.el 228 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732
  1. ;;; ps-print.el --- print text from the buffer as PostScript
  2. ;; Copyright (C) 1993-2012 Free Software Foundation, Inc.
  3. ;; Author: Jim Thompson (was <thompson@wg2.waii.com>)
  4. ;; Jacques Duthen (was <duthen@cegelec-red.fr>)
  5. ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
  6. ;; Kenichi Handa <handa@m17n.org> (multi-byte characters)
  7. ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters)
  8. ;; Vinicius Jose Latorre <viniciusjl@ig.com.br>
  9. ;; Keywords: wp, print, PostScript
  10. ;; Version: 7.3.5
  11. ;; X-URL: http://www.emacswiki.org/cgi-bin/wiki/ViniciusJoseLatorre
  12. (defconst ps-print-version "7.3.5"
  13. "ps-print.el, v 7.3.5 <2009/12/23 vinicius>
  14. Vinicius's last change version -- this file may have been edited as part of
  15. Emacs without changes to the version number. When reporting bugs, please also
  16. report the version of Emacs, if any, that ps-print was distributed with.
  17. Please send all bug fixes and enhancements to
  18. Vinicius Jose Latorre <viniciusjl@ig.com.br>.")
  19. ;; This file is part of GNU Emacs.
  20. ;; GNU Emacs is free software: you can redistribute it and/or modify
  21. ;; it under the terms of the GNU General Public License as published by
  22. ;; the Free Software Foundation, either version 3 of the License, or
  23. ;; (at your option) any later version.
  24. ;; GNU Emacs is distributed in the hope that it will be useful,
  25. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  26. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  27. ;; GNU General Public License for more details.
  28. ;; You should have received a copy of the GNU General Public License
  29. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  30. ;;; Commentary:
  31. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32. ;;
  33. ;; About ps-print
  34. ;; --------------
  35. ;;
  36. ;; This package provides printing of Emacs buffers on PostScript printers; the
  37. ;; buffer's bold and italic text attributes are preserved in the printer
  38. ;; output. ps-print is intended for use with Emacs or XEmacs, together with a
  39. ;; fontifying package such as font-lock or hilit.
  40. ;;
  41. ;; ps-print uses the same face attributes defined through font-lock or hilit to
  42. ;; print a PostScript file, but some faces are better seeing on the screen than
  43. ;; on paper, specially when you have a black/white PostScript printer.
  44. ;;
  45. ;; ps-print allows a remap of face to another one that it is better to print,
  46. ;; for example, the face font-lock-comment-face (if you are using font-lock)
  47. ;; could have bold or italic attribute when printing, besides foreground color.
  48. ;; This remap improves printing look (see How Ps-Print Maps Faces).
  49. ;;
  50. ;;
  51. ;; Using ps-print
  52. ;; --------------
  53. ;;
  54. ;; ps-print provides eight commands for generating PostScript images of Emacs
  55. ;; buffers:
  56. ;;
  57. ;; ps-print-buffer
  58. ;; ps-print-buffer-with-faces
  59. ;; ps-print-region
  60. ;; ps-print-region-with-faces
  61. ;; ps-spool-buffer
  62. ;; ps-spool-buffer-with-faces
  63. ;; ps-spool-region
  64. ;; ps-spool-region-with-faces
  65. ;;
  66. ;; These commands all perform essentially the same function: they generate
  67. ;; PostScript images suitable for printing on a PostScript printer or
  68. ;; displaying with GhostScript. These commands are collectively referred to as
  69. ;; "ps-print- commands".
  70. ;;
  71. ;; The word "print" or "spool" in the command name determines when the
  72. ;; PostScript image is sent to the printer:
  73. ;;
  74. ;; print - The PostScript image is immediately sent to the printer;
  75. ;;
  76. ;; spool - The PostScript image is saved temporarily in an Emacs
  77. ;; buffer. Many images may be spooled locally before
  78. ;; printing them. To send the spooled images to the
  79. ;; printer, use the command `ps-despool'.
  80. ;;
  81. ;; The spooling mechanism was designed for printing lots of small files (mail
  82. ;; messages or netnews articles) to save paper that would otherwise be wasted
  83. ;; on banner pages, and to make it easier to find your output at the printer
  84. ;; (it's easier to pick up one 50-page printout than to find 50 single-page
  85. ;; printouts).
  86. ;;
  87. ;; ps-print has a hook in the `kill-emacs-hook' so that you won't accidentally
  88. ;; quit from Emacs while you have unprinted PostScript waiting in the spool
  89. ;; buffer. If you do attempt to exit with spooled PostScript, you'll be asked
  90. ;; if you want to print it, and if you decline, you'll be asked to confirm the
  91. ;; exit; this is modeled on the confirmation that Emacs uses for modified
  92. ;; buffers.
  93. ;;
  94. ;; The word "buffer" or "region" in the command name determines how much of the
  95. ;; buffer is printed:
  96. ;;
  97. ;; buffer - Print the entire buffer.
  98. ;;
  99. ;; region - Print just the current region.
  100. ;;
  101. ;; The -with-faces suffix on the command name means that the command will
  102. ;; include font, color, and underline information in the PostScript image, so
  103. ;; the printed image can look as pretty as the buffer. The ps-print- commands
  104. ;; without the -with-faces suffix don't include font, color, or underline
  105. ;; information; images printed with these commands aren't as pretty, but are
  106. ;; faster to generate.
  107. ;;
  108. ;; Two ps-print- command examples:
  109. ;;
  110. ;; ps-print-buffer - print the entire buffer, without font,
  111. ;; color, or underline information, and
  112. ;; send it immediately to the printer.
  113. ;;
  114. ;; ps-spool-region-with-faces - print just the current region; include
  115. ;; font, color, and underline information,
  116. ;; and spool the image in Emacs to send to
  117. ;; the printer later.
  118. ;;
  119. ;;
  120. ;; Invoking Ps-Print
  121. ;; -----------------
  122. ;;
  123. ;; To print your buffer, type
  124. ;;
  125. ;; M-x ps-print-buffer
  126. ;;
  127. ;; or substitute one of the other seven ps-print- commands. The command will
  128. ;; generate the PostScript image and print or spool it as specified. By giving
  129. ;; the command a prefix argument
  130. ;;
  131. ;; C-u M-x ps-print-buffer
  132. ;;
  133. ;; it will save the PostScript image to a file instead of sending it to the
  134. ;; printer; you will be prompted for the name of the file to save the image to.
  135. ;; The prefix argument is ignored by the commands that spool their images, but
  136. ;; you may save the spooled images to a file by giving a prefix argument to
  137. ;; `ps-despool':
  138. ;;
  139. ;; C-u M-x ps-despool
  140. ;;
  141. ;; When invoked this way, `ps-despool' will prompt you for the name of the file
  142. ;; to save to.
  143. ;;
  144. ;; Any of the `ps-print-' commands can be bound to keys; I recommend binding
  145. ;; `ps-spool-buffer-with-faces', `ps-spool-region-with-faces', and
  146. ;; `ps-despool'. Here are the bindings I use on my Sun 4 keyboard:
  147. ;;
  148. ;; (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
  149. ;; (global-set-key '(shift f22) 'ps-spool-region-with-faces)
  150. ;; (global-set-key '(control f22) 'ps-despool)
  151. ;;
  152. ;;
  153. ;; The Printer Interface
  154. ;; ---------------------
  155. ;;
  156. ;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what command
  157. ;; is used to send the PostScript images to the printer, and what arguments to
  158. ;; give the command. These are analogous to `lpr-command' and `lpr-switches'.
  159. ;;
  160. ;; Make sure that they contain appropriate values for your system;
  161. ;; see the usage notes below and the documentation of these variables.
  162. ;;
  163. ;; The variable `ps-printer-name' determines the name of a local printer for
  164. ;; printing PostScript files.
  165. ;;
  166. ;; The variable `ps-printer-name-option' determines the option used by some
  167. ;; utilities to indicate the printer name, it's used only when
  168. ;; `ps-printer-name' is a non-empty string. If you're using lpr utility to
  169. ;; print, for example, `ps-printer-name-option' should be set to "-P".
  170. ;;
  171. ;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values from
  172. ;; the variables `lpr-command' and `lpr-switches'. If you have
  173. ;; `lpr-command' set to invoke a pretty-printer such as `enscript', then
  174. ;; ps-print won't work properly. `ps-lpr-command' must name a program
  175. ;; that does not format the files it prints.
  176. ;; `ps-printer-name' takes its initial value from the variable
  177. ;; `printer-name'. `ps-printer-name-option' tries to guess which system
  178. ;; Emacs is running and takes its initial value in accordance with this
  179. ;; guess.
  180. ;;
  181. ;; The variable `ps-print-region-function' specifies a function to print the
  182. ;; region on a PostScript printer.
  183. ;; See definition of `call-process-region' for calling conventions. The fourth
  184. ;; and the sixth arguments are both nil.
  185. ;;
  186. ;; The variable `ps-manual-feed' indicates if the printer will manually feed
  187. ;; paper. If it's nil, automatic feeding takes place. If it's non-nil, manual
  188. ;; feeding takes place. The default is nil (automatic feeding).
  189. ;;
  190. ;; The variable `ps-end-with-control-d' specifies whether C-d (\x04) should be
  191. ;; inserted at end of PostScript generated. Non-nil means do so. The default
  192. ;; is nil (don't insert).
  193. ;;
  194. ;; If you're using Emacs for Windows 95/98/NT or MS-DOS, don't forget to
  195. ;; customize the following variables: `ps-printer-name',
  196. ;; `ps-printer-name-option', `ps-lpr-command', `ps-lpr-switches' and
  197. ;; `ps-spool-config'. See these variables documentation in the code or by
  198. ;; typing, for example, C-h v ps-printer-name RET.
  199. ;;
  200. ;;
  201. ;; The Page Layout
  202. ;; ---------------
  203. ;;
  204. ;; All dimensions are floats in PostScript points.
  205. ;; 1 inch == 2.54 cm == 72 points
  206. ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
  207. ;;
  208. ;; The variable `ps-paper-type' determines the size of paper ps-print formats
  209. ;; for; it should contain one of the symbols: `a4' `a3' `letter' `legal'
  210. ;; `letter-small' `tabloid' `ledger' `statement' `executive' `a4small' `b4'
  211. ;; `b5'.
  212. ;;
  213. ;; If variable `ps-warn-paper-type' is nil, it's *not* given an error if
  214. ;; PostScript printer doesn't have a paper with the size indicated by
  215. ;; `ps-paper-type', instead it uses the default paper size. If variable
  216. ;; `ps-warn-paper-type' is non-nil, it's given an error if PostScript printer
  217. ;; doesn't have a paper with the size indicated by `ps-paper-type'. It's used
  218. ;; when `ps-spool-config' is set to `setpagedevice' (see section Duplex
  219. ;; Printers). The default value is non-nil (it gives an error).
  220. ;;
  221. ;; The variable `ps-landscape-mode' determines the orientation of the printing
  222. ;; on the page: nil means `portrait' mode, non-nil means `landscape' mode.
  223. ;; There is no oblique mode yet, though this is easy to do in ps.
  224. ;;
  225. ;; In landscape mode, the text is NOT scaled: you may print 70 lines in
  226. ;; portrait mode and only 50 lines in landscape mode. The margins represent
  227. ;; margins in the printed paper: the top margin is the margin between the top
  228. ;; of the page and the printed header, whatever the orientation is.
  229. ;;
  230. ;; The variable `ps-number-of-columns' determines the number of columns both in
  231. ;; landscape and portrait mode.
  232. ;; You can use:
  233. ;; - (the standard) one column portrait mode.
  234. ;; - (my favorite) two columns landscape mode (which spares trees).
  235. ;; but also:
  236. ;; - one column landscape mode for files with very long lines.
  237. ;; - multi-column portrait or landscape mode.
  238. ;;
  239. ;; The variable `ps-print-upside-down' determines other orientation for
  240. ;; printing page: nil means `normal' printing, non-nil means `upside-down'
  241. ;; printing (that is, the page is rotated by 180 grades). The default value is
  242. ;; nil (`normal' printing).
  243. ;;
  244. ;; The `upside-down' orientation can be used in portrait or landscape mode.
  245. ;;
  246. ;; The variable `ps-selected-pages' specifies which pages to print. If it's
  247. ;; nil, all pages are printed. If it's a list, the list element may be an
  248. ;; integer or a cons cell (FROM . TO) designating FROM page to TO page; any
  249. ;; invalid element is ignored, that is, an integer lesser than one or if FROM
  250. ;; is greater than TO. Otherwise, it's treated as nil. The default value is
  251. ;; nil (print all pages). After ps-print processing `ps-selected-pages' is set
  252. ;; to nil. But the latest `ps-selected-pages' is saved in
  253. ;; `ps-last-selected-pages' (see it for documentation). So you can restore the
  254. ;; latest selected pages by using `ps-last-selected-pages' or by calling
  255. ;; `ps-restore-selected-pages' command (see it for documentation).
  256. ;;
  257. ;; The variable `ps-even-or-odd-pages' specifies if it prints even/odd pages.
  258. ;;
  259. ;; Valid values are:
  260. ;;
  261. ;; nil print all pages.
  262. ;;
  263. ;; even-page print only even pages.
  264. ;;
  265. ;; odd-page print only odd pages.
  266. ;;
  267. ;; even-sheet print only even sheets.
  268. ;;
  269. ;; odd-sheet print only odd sheets.
  270. ;;
  271. ;; Any other value is treated as nil. The default value is nil.
  272. ;;
  273. ;; See `ps-even-or-odd-pages' for more detailed documentation.
  274. ;;
  275. ;;
  276. ;; Horizontal layout
  277. ;; -----------------
  278. ;;
  279. ;; The horizontal layout is determined by the variables
  280. ;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
  281. ;; as follows:
  282. ;;
  283. ;; ------------------------------------------
  284. ;; | | | | | | | |
  285. ;; | lm | text | ic | text | ic | text | rm |
  286. ;; | | | | | | | |
  287. ;; ------------------------------------------
  288. ;;
  289. ;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
  290. ;; Usually, lm = rm > 0 and ic = lm
  291. ;; If (ic < 0), the text of adjacent columns can overlap.
  292. ;;
  293. ;;
  294. ;; Vertical layout
  295. ;; ---------------
  296. ;;
  297. ;; The vertical layout is determined by the variables
  298. ;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset' `ps-footer-offset'
  299. ;; as follows:
  300. ;;
  301. ;; |--------| |--------| |--------| |--------|
  302. ;; | tm | | tm | | tm | | tm |
  303. ;; |--------| |--------| |--------| |--------|
  304. ;; | header | | | | header | | |
  305. ;; |--------| | | |--------| | |
  306. ;; | ho | | | | ho | | |
  307. ;; |--------| | | |--------| | |
  308. ;; | | | | | | | |
  309. ;; | text | or | text | or | text | or | text |
  310. ;; | | | | | | | |
  311. ;; | | |--------| |--------| | |
  312. ;; | | | fo | | fo | | |
  313. ;; | | |--------| |--------| | |
  314. ;; | | | footer | | footer | | |
  315. ;; |--------| |--------| |--------| |--------|
  316. ;; | bm | | bm | | bm | | bm |
  317. ;; |--------| |--------| |--------| |--------|
  318. ;;
  319. ;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
  320. ;; If `ps-print-footer' is nil, `ps-footer-offset' is not relevant.
  321. ;; The margins represent margins in the printed paper:
  322. ;; the top margin is the margin between the top of the page and the printed
  323. ;; header, whatever the orientation is;
  324. ;; the bottom margin is the margin between the bottom of the page and the
  325. ;; printed footer, whatever the orientation is.
  326. ;;
  327. ;;
  328. ;; Headers & Footers
  329. ;; -----------------
  330. ;;
  331. ;; ps-print can print headers at the top of each column or at the top of each
  332. ;; page; the default headers contain the following four items: on the left, the
  333. ;; name of the buffer and, if the buffer is visiting a file, the file's
  334. ;; directory; on the right, the page number and date of printing. The default
  335. ;; headers look something like this:
  336. ;;
  337. ;; ps-print.el 1/21
  338. ;; /home/jct/emacs-lisp/ps/new 94/12/31
  339. ;;
  340. ;; When printing on duplex printers, left and right are reversed so that the
  341. ;; page numbers are toward the outside (cf. `ps-spool-duplex').
  342. ;;
  343. ;; Headers are configurable:
  344. ;; To turn them off completely, set `ps-print-header' to nil.
  345. ;; To turn off the header's gaudy framing box,
  346. ;; set `ps-print-header-frame' to nil.
  347. ;;
  348. ;; The variable `ps-header-frame-alist' specifies header frame properties
  349. ;; alist. Valid frame properties are:
  350. ;;
  351. ;; fore-color Specify the foreground frame color.
  352. ;; It should be a float number between 0.0 (black color)
  353. ;; and 1.0 (white color), a string which is a color name,
  354. ;; or a list of 3 float numbers which corresponds to the
  355. ;; Red Green Blue color scale, each float number between
  356. ;; 0.0 (dark color) and 1.0 (bright color).
  357. ;; The default is 0 ("black").
  358. ;;
  359. ;; back-color Specify the background frame color (similar to
  360. ;; fore-color). The default is 0.9 ("gray90").
  361. ;;
  362. ;; shadow-color Specify the shadow color (similar to fore-color).
  363. ;; The default is 0 ("black").
  364. ;;
  365. ;; border-color Specify the border color (similar to fore-color).
  366. ;; The default is 0 ("black").
  367. ;;
  368. ;; border-width Specify the border width.
  369. ;; The default is 0.4.
  370. ;;
  371. ;; Any other property is ignored.
  372. ;;
  373. ;; Don't change this alist directly, instead use customization, or `ps-value',
  374. ;; `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
  375. ;;
  376. ;; To print only one header at the top of each page, set
  377. ;; `ps-print-only-one-header' to t.
  378. ;;
  379. ;; To switch headers, set `ps-switch-header' to:
  380. ;;
  381. ;; nil Never switch headers.
  382. ;;
  383. ;; t Always switch headers.
  384. ;;
  385. ;; duplex Switch headers only when duplexing is on, that is, when
  386. ;; `ps-spool-duplex' is non-nil (see Duplex Printers).
  387. ;;
  388. ;; Any other value is treated as t. The default value is `duplex'.
  389. ;;
  390. ;; The font family and size of text in the header are determined by the
  391. ;; variables `ps-header-font-family', `ps-header-font-size' and
  392. ;; `ps-header-title-font-size' (see below).
  393. ;;
  394. ;; The variable `ps-header-line-pad' determines the portion of a header title
  395. ;; line height to insert between the header frame and the text it contains,
  396. ;; both in the vertical and horizontal directions: .5 means half a line.
  397. ;;
  398. ;; Page numbers are printed in `n/m' format, indicating page n of m pages; to
  399. ;; omit the total page count and just print the page number, set
  400. ;; `ps-show-n-of-n' to nil.
  401. ;;
  402. ;; The amount of information in the header can be changed by changing the
  403. ;; number of lines. To show less, set `ps-header-lines' to 1, and the header
  404. ;; will show only the buffer name and page number. To show more, set
  405. ;; `ps-header-lines' to 3, and the header will show the time of printing below
  406. ;; the date.
  407. ;;
  408. ;; To change the content of the headers, change the variables `ps-left-header'
  409. ;; and `ps-right-header'.
  410. ;; These variables are lists, specifying top-to-bottom the text to display on
  411. ;; the left or right side of the header. Each element of the list should be a
  412. ;; string or a symbol. Strings are inserted directly into the PostScript
  413. ;; arrays, and should contain the PostScript string delimiters '(' and ')'.
  414. ;;
  415. ;; Symbols in the header format lists can either represent functions or
  416. ;; variables. Functions are called, and should return a string to show in the
  417. ;; header. Variables should contain strings to display in the header. In
  418. ;; either case, function or variable, the PostScript string delimiters are
  419. ;; added by ps-print, and should not be part of the returned value.
  420. ;;
  421. ;; Here's an example: say we want the left header to display the text
  422. ;;
  423. ;; Moe
  424. ;; Larry
  425. ;; Curly
  426. ;;
  427. ;; where we have a function to return "Moe"
  428. ;;
  429. ;; (defun moe-func ()
  430. ;; "Moe")
  431. ;;
  432. ;; a variable specifying "Larry"
  433. ;;
  434. ;; (setq larry-var "Larry")
  435. ;;
  436. ;; and a literal for "Curly". Here's how `ps-left-header' should be set:
  437. ;;
  438. ;; (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
  439. ;;
  440. ;; Note that Curly has the PostScript string delimiters inside his quotes --
  441. ;; those aren't misplaced lisp delimiters!
  442. ;;
  443. ;; Without them, PostScript would attempt to call the undefined function Curly,
  444. ;; which would result in a PostScript error.
  445. ;;
  446. ;; Since most printers don't report PostScript errors except by aborting the
  447. ;; print job, this kind of error can be hard to track down.
  448. ;;
  449. ;; Consider yourself warned!
  450. ;;
  451. ;; ps-print also print footers. The footer variables are: `ps-print-footer',
  452. ;; `ps-footer-offset', `ps-print-footer-frame', `ps-footer-font-family',
  453. ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
  454. ;; `ps-left-footer', `ps-right-footer' and `ps-footer-frame-alist'. These
  455. ;; variables are similar to those one that control headers.
  456. ;;
  457. ;; The variables `ps-print-only-one-header' and `ps-switch-header' also control
  458. ;; the footer (The same way that control header).
  459. ;;
  460. ;; As a footer example, if you want to have a centered page number in the
  461. ;; footer but without headers, set:
  462. ;;
  463. ;; (setq ps-print-header nil
  464. ;; ps-print-footer t
  465. ;; ps-print-footer-frame nil
  466. ;; ps-footer-lines 1
  467. ;; ps-right-footer nil
  468. ;; ps-left-footer
  469. ;; (list (concat "{pagenumberstring dup stringwidth pop"
  470. ;; " 2 div PrintWidth 2 div exch sub 0 rmoveto}")))
  471. ;;
  472. ;;
  473. ;; PostScript Prologue Header
  474. ;; --------------------------
  475. ;;
  476. ;; It is possible to add PostScript prologue header comments besides that
  477. ;; ps-print generates by setting the variable `ps-print-prologue-header'.
  478. ;;
  479. ;; `ps-print-prologue-header' may be a string or a symbol function which
  480. ;; returns a string. Note that this string is inserted on PostScript prologue
  481. ;; header section which is used to define some document characteristic through
  482. ;; PostScript special comments, like "%%Requirements: jog\n".
  483. ;;
  484. ;; By default `ps-print-prologue-header' is nil.
  485. ;;
  486. ;; ps-print always inserts the %%Requirements: comment, so if you need to
  487. ;; insert more requirements put them first in `ps-print-prologue-header' using
  488. ;; the "%%+" comment. For example, if you need to set numcopies to 3 and jog
  489. ;; on requirements and set %%LanguageLevel: to 2, do:
  490. ;;
  491. ;; (setq ps-print-prologue-header
  492. ;; "%%+ numcopies(3) jog\n%%LanguageLevel: 2\n")
  493. ;;
  494. ;; The duplex requirement is inserted by ps-print (see section Duplex
  495. ;; Printers).
  496. ;;
  497. ;; Do not forget to terminate the string with "\n".
  498. ;;
  499. ;; For more information about PostScript document comments, see:
  500. ;; PostScript Language Reference Manual (2nd edition)
  501. ;; Adobe Systems Incorporated
  502. ;; Appendix G: Document Structuring Conventions -- Version 3.0
  503. ;;
  504. ;; It is also possible to add an user defined PostScript prologue code before
  505. ;; all generated prologue code by setting the variable
  506. ;; `ps-user-defined-prologue'.
  507. ;;
  508. ;; `ps-user-defined-prologue' may be a string or a symbol function which
  509. ;; returns a string. Note that this string is inserted after `ps-adobe-tag'
  510. ;; and PostScript prologue comments, and before ps-print PostScript prologue
  511. ;; code section. That is, this string is inserted after error handler
  512. ;; initialization and before ps-print settings.
  513. ;;
  514. ;; By default `ps-user-defined-prologue' is nil.
  515. ;;
  516. ;; It's strongly recommended only insert PostScript code and/or comments
  517. ;; specific for your printing system particularities. For example, some
  518. ;; special initialization that only your printing system needs.
  519. ;;
  520. ;; Do not insert code for duplex printing, n-up printing or error handler,
  521. ;; ps-print handles this in a suitable way.
  522. ;;
  523. ;; For more information about PostScript, see:
  524. ;; PostScript Language Reference Manual (2nd edition)
  525. ;; Adobe Systems Incorporated
  526. ;;
  527. ;; As an example for `ps-user-defined-prologue' setting:
  528. ;;
  529. ;; ;; Setting for HP PostScript printer
  530. ;; (setq ps-user-defined-prologue
  531. ;; (concat "<</DeferredMediaSelection true /PageSize [612 792] "
  532. ;; "/MediaPosition 2 /MediaType (Plain)>> setpagedevice"))
  533. ;;
  534. ;;
  535. ;; PostScript Error Handler
  536. ;; ------------------------
  537. ;;
  538. ;; ps-print instruments generated PostScript code with an error handler.
  539. ;;
  540. ;; The variable `ps-error-handler-message' specifies where the error handler
  541. ;; message should be sent.
  542. ;;
  543. ;; Valid values are:
  544. ;;
  545. ;; none catch the error and *DON'T* send any message.
  546. ;;
  547. ;; paper catch the error and print on paper the error message.
  548. ;; This is the default value.
  549. ;;
  550. ;; system catch the error and send back the error message to
  551. ;; printing system. This is useful only if printing
  552. ;; system send back an email reporting the error, or if
  553. ;; there is some other alternative way to report back the
  554. ;; error from the system to you.
  555. ;;
  556. ;; paper-and-system catch the error, print on paper the error message and
  557. ;; send back the error message to printing system.
  558. ;;
  559. ;; Any other value is treated as `paper'.
  560. ;;
  561. ;;
  562. ;; Duplex Printers
  563. ;; ---------------
  564. ;;
  565. ;; If you have a duplex-capable printer (one that prints both sides of the
  566. ;; paper), set `ps-spool-duplex' to t.
  567. ;; ps-print will insert blank pages to make sure each buffer starts on the
  568. ;; correct side of the paper.
  569. ;;
  570. ;; The variable `ps-spool-config' specifies who is the responsible for setting
  571. ;; duplex and page size. Valid values are:
  572. ;;
  573. ;; lpr-switches duplex and page size are configured by `ps-lpr-switches'.
  574. ;; Don't forget to set `ps-lpr-switches' to select duplex
  575. ;; printing for your printer.
  576. ;;
  577. ;; setpagedevice duplex and page size are configured by ps-print using the
  578. ;; setpagedevice PostScript operator.
  579. ;;
  580. ;; nil duplex and page size are configured by ps-print *not* using
  581. ;; the setpagedevice PostScript operator.
  582. ;;
  583. ;; Any other value is treated as nil.
  584. ;;
  585. ;; The default value is `lpr-switches'.
  586. ;;
  587. ;; WARNING: The setpagedevice PostScript operator affects ghostview utility
  588. ;; when viewing file generated using landscape. Also on some
  589. ;; printers, setpagedevice affects zebra stripes; on other printers,
  590. ;; setpagedevice affects the left margin.
  591. ;; Besides all that, if your printer does not have the paper size
  592. ;; specified by setpagedevice, your printing will be aborted.
  593. ;; So, if you need to use setpagedevice, set `ps-spool-config' to
  594. ;; `setpagedevice', generate a test file and send it to your printer;
  595. ;; if the printed file isn't ok, set `ps-spool-config' to nil.
  596. ;;
  597. ;; The variable `ps-spool-tumble' specifies how the page images on opposite
  598. ;; sides of a sheet are oriented with respect to each other. If
  599. ;; `ps-spool-tumble' is nil, produces output suitable for binding on the left
  600. ;; or right. If `ps-spool-tumble' is non-nil, produces output suitable for
  601. ;; binding at the top or bottom. It has effect only when `ps-spool-duplex' is
  602. ;; non-nil. The default value is nil.
  603. ;;
  604. ;; Some printer system prints a header page and forces the first page be
  605. ;; printed on header page back, when using duplex. If your printer system has
  606. ;; this behavior, set variable `ps-banner-page-when-duplexing' to t.
  607. ;;
  608. ;; When `ps-banner-page-when-duplexing' is non-nil, it prints a blank page as
  609. ;; the very first printed page. So, it behaves as the very first character of
  610. ;; buffer (or region) is ^L (\014).
  611. ;;
  612. ;; The default for `ps-banner-page-when-duplexing' is nil (*don't* skip the
  613. ;; very first page).
  614. ;;
  615. ;;
  616. ;; N-up Printing
  617. ;; -------------
  618. ;;
  619. ;; The variable `ps-n-up-printing' specifies the number of pages per sheet of
  620. ;; paper. The value specified must be between 1 and 100. The default is 1.
  621. ;;
  622. ;; NOTE: some PostScript printer may crash printing if `ps-n-up-printing' is
  623. ;; set to a high value (for example, 23). If this happens, set a lower value.
  624. ;;
  625. ;; The variable `ps-n-up-margin' specifies the margin in points between the
  626. ;; sheet border and the n-up printing. The default is 1 cm (or 0.3937 inches,
  627. ;; or 28.35 points).
  628. ;;
  629. ;; If variable `ps-n-up-border-p' is non-nil a border is drawn around each
  630. ;; page. The default is t.
  631. ;;
  632. ;; The variable `ps-n-up-filling' specifies how page matrix is filled on each
  633. ;; sheet of paper. Following are the valid values for `ps-n-up-filling' with a
  634. ;; filling example using a 3x4 page matrix:
  635. ;;
  636. ;; left-top 1 2 3 4 left-bottom 9 10 11 12
  637. ;; 5 6 7 8 5 6 7 8
  638. ;; 9 10 11 12 1 2 3 4
  639. ;;
  640. ;; right-top 4 3 2 1 right-bottom 12 11 10 9
  641. ;; 8 7 6 5 8 7 6 5
  642. ;; 12 11 10 9 4 3 2 1
  643. ;;
  644. ;; top-left 1 4 7 10 bottom-left 3 6 9 12
  645. ;; 2 5 8 11 2 5 8 11
  646. ;; 3 6 9 12 1 4 7 10
  647. ;;
  648. ;; top-right 10 7 4 1 bottom-right 12 9 6 3
  649. ;; 11 8 5 2 11 8 5 2
  650. ;; 12 9 6 3 10 7 4 1
  651. ;;
  652. ;; Any other value is treated as `left-top'.
  653. ;;
  654. ;; The default value is left-top.
  655. ;;
  656. ;;
  657. ;; Control And 8-bit Characters
  658. ;; ----------------------------
  659. ;;
  660. ;; The variable `ps-print-control-characters' specifies whether you want to see
  661. ;; a printable form for control and 8-bit characters, that is, instead of
  662. ;; sending, for example, a ^D (\004) to printer, it is sent the string "^D".
  663. ;;
  664. ;; Valid values for `ps-print-control-characters' are:
  665. ;;
  666. ;; 8-bit This is the value to use when you want an ASCII encoding of
  667. ;; any control or non-ASCII character. Control characters are
  668. ;; encoded as "^D", and non-ASCII characters have an
  669. ;; octal encoding.
  670. ;;
  671. ;; control-8-bit This is the value to use when you want an ASCII encoding of
  672. ;; any control character, whether it is 7 or 8-bit.
  673. ;; European 8-bits accented characters are printed according
  674. ;; the current font.
  675. ;;
  676. ;; control Only ASCII control characters have an ASCII encoding.
  677. ;; European 8-bits accented characters are printed according
  678. ;; the current font.
  679. ;;
  680. ;; nil No ASCII encoding. Any character is printed according the
  681. ;; current font.
  682. ;;
  683. ;; Any other value is treated as nil.
  684. ;;
  685. ;; The default is `control-8-bit'.
  686. ;;
  687. ;; Characters TAB, NEWLINE and FORMFEED are always treated by ps-print engine.
  688. ;;
  689. ;;
  690. ;; Printing Multi-byte Buffer
  691. ;; --------------------------
  692. ;;
  693. ;; See ps-mule.el for documentation.
  694. ;;
  695. ;;
  696. ;; Line Number
  697. ;; -----------
  698. ;;
  699. ;; The variable `ps-line-number' specifies whether to number each line;
  700. ;; non-nil means do so. The default is nil (don't number each line).
  701. ;;
  702. ;; The variable `ps-line-number-color' specifies the color for line number.
  703. ;; See `ps-zebra-color' for documentation. The default is "black" (or 0.0, or
  704. ;; '(0.0 0.0 0.0)).
  705. ;;
  706. ;; The variable `ps-line-number-font' specifies the font for line number.
  707. ;; The default is "Times-Italic".
  708. ;;
  709. ;; The variable `ps-line-number-font-size' specifies the font size in points
  710. ;; for line number. See `ps-font-size' for documentation. The default is 6.
  711. ;;
  712. ;; The variable `ps-line-number-step' specifies the interval that line number
  713. ;; is printed. For example, if `ps-line-number-step' is set to 2, the printing
  714. ;; will look like:
  715. ;;
  716. ;; 1 one line
  717. ;; one line
  718. ;; 3 one line
  719. ;; one line
  720. ;; 5 one line
  721. ;; one line
  722. ;; ...
  723. ;;
  724. ;; Valid values are:
  725. ;;
  726. ;; integer an integer that specifies the interval that line number is
  727. ;; printed. If it's lesser than or equal to zero, it's used the
  728. ;; value 1.
  729. ;;
  730. ;; `zebra' specifies that only the line number of the first line in a
  731. ;; zebra stripe is to be printed.
  732. ;;
  733. ;; Any other value is treated as `zebra'.
  734. ;; The default value is 1, so each line number is printed.
  735. ;;
  736. ;; The variable `ps-line-number-start' specifies the starting point in the
  737. ;; interval given by `ps-line-number-step'. For example, if
  738. ;; `ps-line-number-step' is set to 3 and `ps-line-number-start' is set to 3,
  739. ;; the printing will look like:
  740. ;;
  741. ;; one line
  742. ;; one line
  743. ;; 3 one line
  744. ;; one line
  745. ;; one line
  746. ;; 6 one line
  747. ;; one line
  748. ;; one line
  749. ;; 9 one line
  750. ;; one line
  751. ;; ...
  752. ;;
  753. ;; The values for `ps-line-number-start':
  754. ;;
  755. ;; * If `ps-line-number-step' is an integer, must be between 1 and the value
  756. ;; of `ps-line-number-step' inclusive.
  757. ;;
  758. ;; * If `ps-line-number-step' is set to `zebra', must be between 1 and the
  759. ;; value of `ps-zebra-stripe-height' inclusive.
  760. ;;
  761. ;; The default value is 1, so the line number of the first line of each
  762. ;; interval is printed.
  763. ;;
  764. ;;
  765. ;; Zebra Stripes
  766. ;; -------------
  767. ;;
  768. ;; Zebra stripes are a kind of background that appear "underneath" the text and
  769. ;; can make the text easier to read. They look like this:
  770. ;;
  771. ;; XXXXXXXXXXXXXXXXXXXXXXXX
  772. ;; XXXXXXXXXXXXXXXXXXXXXXXX
  773. ;; XXXXXXXXXXXXXXXXXXXXXXXX
  774. ;;
  775. ;;
  776. ;;
  777. ;; XXXXXXXXXXXXXXXXXXXXXXXX
  778. ;; XXXXXXXXXXXXXXXXXXXXXXXX
  779. ;; XXXXXXXXXXXXXXXXXXXXXXXX
  780. ;;
  781. ;; The blocks of X's represent rectangles filled with a light gray color.
  782. ;; Each rectangle extends all the way across the page.
  783. ;;
  784. ;; The height, in lines, of each rectangle is controlled by the variable
  785. ;; `ps-zebra-stripe-height', which is 3 by default. The distance between
  786. ;; stripes equals the height of a stripe.
  787. ;;
  788. ;; The variable `ps-zebra-stripes' controls whether to print zebra stripes.
  789. ;; Non-nil means yes, nil means no. The default is nil.
  790. ;;
  791. ;; The variable `ps-zebra-color' controls the zebra stripes gray scale or RGB
  792. ;; color. It should be a float number between 0.0 (black color) and 1.0 (white
  793. ;; color), a string which is a color name, or a list of 3 numbers which
  794. ;; corresponds to the Red Green Blue color scale.
  795. ;; The default is 0.95 (or "gray95", or '(0.95 0.95 0.95)).
  796. ;;
  797. ;; The variable `ps-zebra-stripe-follow' specifies how zebra stripes continue
  798. ;; on next page. Visually, valid values are (the character `+' at right of
  799. ;; each column indicates that a line is printed):
  800. ;;
  801. ;; `nil' `follow' `full' `full-follow'
  802. ;; Current Page -------- ----------- --------- ----------------
  803. ;; 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
  804. ;; 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
  805. ;; 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
  806. ;; 4 + 4 + 4 + 4 +
  807. ;; 5 + 5 + 5 + 5 +
  808. ;; 6 + 6 + 6 + 6 +
  809. ;; 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
  810. ;; 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
  811. ;; 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
  812. ;; 10 + 10 +
  813. ;; 11 + 11 +
  814. ;; -------- ----------- --------- ----------------
  815. ;; Next Page -------- ----------- --------- ----------------
  816. ;; 12 XXXXX + 12 + 10 XXXXXX + 10 +
  817. ;; 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
  818. ;; 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
  819. ;; 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
  820. ;; 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
  821. ;; 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
  822. ;; 18 XXXXX + 18 + 16 XXXXXX + 16 +
  823. ;; 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
  824. ;; 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
  825. ;; 21 + 21 XXXXXXXX +
  826. ;; 22 + 22 +
  827. ;; -------- ----------- --------- ----------------
  828. ;;
  829. ;; Any other value is treated as nil.
  830. ;;
  831. ;; See also section How Ps-Print Has A Text And/Or Image On Background.
  832. ;;
  833. ;;
  834. ;; Hooks
  835. ;; -----
  836. ;;
  837. ;; ps-print has the following hook variables:
  838. ;;
  839. ;; `ps-print-hook'
  840. ;; It is evaluated once before any printing process. This is the right
  841. ;; place to initialize ps-print global data.
  842. ;; For an example, see section Adding a New Font Family.
  843. ;;
  844. ;; `ps-print-begin-sheet-hook'
  845. ;; It is evaluated on each beginning of sheet of paper.
  846. ;; If `ps-n-up-printing' is equal to 1, `ps-print-begin-page-hook' is never
  847. ;; evaluated.
  848. ;;
  849. ;; `ps-print-begin-page-hook'
  850. ;; It is evaluated on each beginning of page, except in the beginning of
  851. ;; page that `ps-print-begin-sheet-hook' is evaluated.
  852. ;;
  853. ;; `ps-print-begin-column-hook'
  854. ;; It is evaluated on each beginning of column, except in the beginning of
  855. ;; column that `ps-print-begin-page-hook' is evaluated or that
  856. ;; `ps-print-begin-sheet-hook' is evaluated.
  857. ;;
  858. ;;
  859. ;; Font Managing
  860. ;; -------------
  861. ;;
  862. ;; ps-print now knows rather precisely some fonts: the variable
  863. ;; `ps-font-info-database' contains information for a list of font families
  864. ;; (currently mainly `Courier' `Helvetica' `Times' `Palatino'
  865. ;; `Helvetica-Narrow' `NewCenturySchlbk'). Each font family contains the font
  866. ;; names for standard, bold, italic and bold-italic characters, a reference
  867. ;; size (usually 10) and the corresponding line height, width of a space and
  868. ;; average character width.
  869. ;;
  870. ;; The variable `ps-font-family' determines which font family is to be used for
  871. ;; ordinary text. If its value does not correspond to a known font family, an
  872. ;; error message is printed into the `*Messages*' buffer, which lists the
  873. ;; currently available font families.
  874. ;;
  875. ;; The variable `ps-font-size' determines the size (in points) of the font for
  876. ;; ordinary text, when generating PostScript. Its value is a float or a cons
  877. ;; of floats which has the following form:
  878. ;;
  879. ;; (LANDSCAPE-SIZE . PORTRAIT-SIZE)
  880. ;;
  881. ;; Similarly, the variable `ps-header-font-family' determines which font family
  882. ;; is to be used for text in the header.
  883. ;;
  884. ;; The variable `ps-header-font-size' determines the font size, in points, for
  885. ;; text in the header (similar to `ps-font-size').
  886. ;;
  887. ;; The variable `ps-header-title-font-size' determines the font size, in
  888. ;; points, for the top line of text in the header (similar to `ps-font-size').
  889. ;;
  890. ;; The variable `ps-line-spacing' determines the line spacing, in points, for
  891. ;; ordinary text, when generating PostScript (similar to `ps-font-size'). The
  892. ;; default value is 0 (zero = no line spacing).
  893. ;;
  894. ;; The variable `ps-paragraph-spacing' determines the paragraph spacing, in
  895. ;; points, for ordinary text, when generating PostScript (similar to
  896. ;; `ps-font-size'). The default value is 0 (zero = no paragraph spacing).
  897. ;;
  898. ;; To get all lines with some spacing set both `ps-line-spacing' and
  899. ;; `ps-paragraph-spacing' variables.
  900. ;;
  901. ;; The variable `ps-paragraph-regexp' specifies the paragraph delimiter. It
  902. ;; should be a regexp or nil. The default value is "[ \t]*$", that is, an
  903. ;; empty line or a line containing only spaces and tabs.
  904. ;;
  905. ;; The variable `ps-begin-cut-regexp' and `ps-end-cut-regexp' specify the start
  906. ;; and end of a region to cut out when printing.
  907. ;;
  908. ;; As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may
  909. ;; be set to "^Local Variables:" and "^End:", respectively, in order to leave
  910. ;; out some special printing instructions from the actual print. Special
  911. ;; printing instructions may be appended to the end of the file just like any
  912. ;; other buffer-local variables. See section "Local Variables in Files" on
  913. ;; Emacs manual for more information.
  914. ;;
  915. ;; Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together
  916. ;; what actually gets printed. Both variables may be set to nil in which case
  917. ;; no cutting occurs. By default, both variables are set to nil.
  918. ;;
  919. ;;
  920. ;; Adding a New Font Family
  921. ;; ------------------------
  922. ;;
  923. ;; To use a new font family, you MUST first teach ps-print this font, i.e., add
  924. ;; its information to `ps-font-info-database', otherwise ps-print cannot
  925. ;; correctly place line and page breaks.
  926. ;;
  927. ;; For example, assuming `Helvetica' is unknown, you first need to do the
  928. ;; following ONLY ONCE:
  929. ;;
  930. ;; - create a new buffer
  931. ;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
  932. ;; - open this file and find the line:
  933. ;; `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
  934. ;; - delete the leading `%' (which is the PostScript comment character)
  935. ;; - replace in this line `Courier' by the new font (say `Helvetica') to get
  936. ;; the line:
  937. ;; `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
  938. ;; - send this file to the printer (or to ghostscript).
  939. ;; You should read the following on the output page:
  940. ;;
  941. ;; For Helvetica 10 point, the line height is 11.56, the space width is 2.78
  942. ;; and a crude estimate of average character width is 5.09243
  943. ;;
  944. ;; - Add these values to the `ps-font-info-database':
  945. ;; (setq ps-font-info-database
  946. ;; (append
  947. ;; '((Helvetica ; the family key
  948. ;; (fonts (normal . "Helvetica")
  949. ;; (bold . "Helvetica-Bold")
  950. ;; (italic . "Helvetica-Oblique")
  951. ;; (bold-italic . "Helvetica-BoldOblique"))
  952. ;; (size . 10.0)
  953. ;; (line-height . 11.56)
  954. ;; (space-width . 2.78)
  955. ;; (avg-char-width . 5.09243)))
  956. ;; ps-font-info-database))
  957. ;; - Now you can use this font family with any size:
  958. ;; (setq ps-font-family 'Helvetica)
  959. ;; - if you want to use this family in another emacs session, you must put into
  960. ;; your `~/.emacs':
  961. ;; (require 'ps-print)
  962. ;; (setq ps-font-info-database (append ...)))
  963. ;; if you don't want to load ps-print, you have to copy the whole value:
  964. ;; (setq ps-font-info-database '(<your stuff> <the standard stuff>))
  965. ;; or, use `ps-print-hook' (see section Hooks):
  966. ;; (add-hook 'ps-print-hook
  967. ;; (lambda ()
  968. ;; (or (assq 'Helvetica ps-font-info-database)
  969. ;; (setq ps-font-info-database (append ...)))))
  970. ;;
  971. ;; You can create new `mixed' font families like:
  972. ;; (my-mixed-family
  973. ;; (fonts (normal . "Courier-Bold")
  974. ;; (bold . "Helvetica")
  975. ;; (italic . "ZapfChancery-MediumItalic")
  976. ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
  977. ;; (w3-table-hack-x-face . "LineDrawNormal"))
  978. ;; (size . 10.0)
  979. ;; (line-height . 10.55)
  980. ;; (space-width . 6.0)
  981. ;; (avg-char-width . 6.0))
  982. ;;
  983. ;; Now you can use your new font family with any size:
  984. ;; (setq ps-font-family 'my-mixed-family)
  985. ;;
  986. ;; Note that on above example the `w3-table-hack-x-face' entry refers to a face
  987. ;; symbol, so when printing this face it'll be used the font `LineDrawNormal'.
  988. ;; If the face `w3-table-hack-x-face' is remapped to use bold and/or italic
  989. ;; attribute, the corresponding entry (bold, italic or bold-italic) will be
  990. ;; used instead of `w3-table-hack-x-face' entry.
  991. ;;
  992. ;; Note also that the font family entry order is irrelevant, so the above
  993. ;; example could also be written:
  994. ;; (my-mixed-family
  995. ;; (size . 10.0)
  996. ;; (fonts (w3-table-hack-x-face . "LineDrawNormal")
  997. ;; (bold . "Helvetica")
  998. ;; (bold-italic . "NewCenturySchlbk-BoldItalic")
  999. ;; (italic . "ZapfChancery-MediumItalic")
  1000. ;; (normal . "Courier-Bold"))
  1001. ;; (avg-char-width . 6.0)
  1002. ;; (space-width . 6.0)
  1003. ;; (line-height . 10.55))
  1004. ;;
  1005. ;; Despite the note above, it is recommended that some convention about
  1006. ;; entry order be used.
  1007. ;;
  1008. ;; You can get information on all the fonts resident in YOUR printer
  1009. ;; by uncommenting the line:
  1010. ;; % 3 cm 20 cm moveto ReportAllFontInfo showpage
  1011. ;;
  1012. ;; The PostScript file should be sent to YOUR PostScript printer.
  1013. ;; If you send it to ghostscript or to another PostScript printer, you may get
  1014. ;; slightly different results.
  1015. ;; Anyway, as ghostscript fonts are autoload, you won't get much font info.
  1016. ;;
  1017. ;; Note also that ps-print DOESN'T download any font to your printer, instead
  1018. ;; it uses the fonts resident in your printer.
  1019. ;;
  1020. ;;
  1021. ;; How Ps-Print Deals With Faces
  1022. ;; -----------------------------
  1023. ;;
  1024. ;; The ps-print-*-with-faces commands attempt to determine which faces should
  1025. ;; be printed in bold or italic, but their guesses aren't always right. For
  1026. ;; example, you might want to map colors into faces so that blue faces print in
  1027. ;; bold, and red faces in italic.
  1028. ;;
  1029. ;; It is possible to force ps-print to consider specific faces bold, italic or
  1030. ;; underline, no matter what font they are displayed in, by setting the
  1031. ;; variables `ps-bold-faces', `ps-italic-faces' and `ps-underlined-faces'.
  1032. ;; These variables contain lists of faces that ps-print should consider bold,
  1033. ;; italic or underline; to set them, put code like the following into your
  1034. ;; .emacs file:
  1035. ;;
  1036. ;; (setq ps-bold-faces '(my-blue-face))
  1037. ;; (setq ps-italic-faces '(my-red-face))
  1038. ;; (setq ps-underlined-faces '(my-green-face))
  1039. ;;
  1040. ;; Faces like bold-italic that are both bold and italic should go in *both*
  1041. ;; lists.
  1042. ;;
  1043. ;; ps-print keeps internal lists of which fonts are bold and which are italic;
  1044. ;; these lists are built the first time you invoke ps-print.
  1045. ;; For the sake of efficiency, the lists are built only once; the same lists
  1046. ;; are referred in later invocations of ps-print.
  1047. ;;
  1048. ;; Because these lists are built only once, it's possible for them to get out
  1049. ;; of sync, if a face changes, or if new faces are added. To get the lists
  1050. ;; back in sync, you can set the variable `ps-build-face-reference' to t, and
  1051. ;; the lists will be rebuilt the next time ps-print is invoked. If you need
  1052. ;; that the lists always be rebuilt when ps-print is invoked, set the variable
  1053. ;; `ps-always-build-face-reference' to t.
  1054. ;;
  1055. ;; If you need to print without worrying about face background color, set the
  1056. ;; variable `ps-use-face-background' which specifies if face background should
  1057. ;; be used. Valid values are:
  1058. ;;
  1059. ;; t always use face background color.
  1060. ;; nil never use face background color.
  1061. ;; (face...) list of faces whose background color will be used.
  1062. ;;
  1063. ;; Any other value will be treated as t.
  1064. ;; The default value is nil.
  1065. ;;
  1066. ;;
  1067. ;; How Ps-Print Deals With Color
  1068. ;; -----------------------------
  1069. ;;
  1070. ;; ps-print detects faces with foreground and background colors defined and
  1071. ;; embeds color information in the PostScript image.
  1072. ;; The default foreground and background colors are defined by the variables
  1073. ;; `ps-default-fg' and `ps-default-bg'.
  1074. ;; On black/white printers, colors are displayed in gray scale.
  1075. ;; To turn off color output, set `ps-print-color-p' to nil.
  1076. ;; You can also set `ps-print-color-p' to 'black-white to have a better looking
  1077. ;; on black/white printers. See also `ps-black-white-faces' for documentation.
  1078. ;;
  1079. ;; ps-print also detects if the text foreground and background colors are
  1080. ;; equals when `ps-fg-validate-p' is non-nil. In this case, if these colors
  1081. ;; are used, no text will appear. You can use `ps-fg-list' to give a list of
  1082. ;; foreground colors to be used when text foreground and background colors are
  1083. ;; equals. It'll be used the first foreground color in `ps-fg-list' which is
  1084. ;; different from the background color. If `ps-fg-list' is nil, the default
  1085. ;; foreground color is used.
  1086. ;;
  1087. ;;
  1088. ;; How Ps-Print Maps Faces
  1089. ;; -----------------------
  1090. ;;
  1091. ;; As ps-print uses PostScript to print buffers, it is possible to have other
  1092. ;; attributes associated with faces. So the new attributes used by ps-print
  1093. ;; are:
  1094. ;;
  1095. ;; strikeout - like underline, but the line is in middle of text.
  1096. ;; overline - like underline, but the line is over the text.
  1097. ;; shadow - text will have a shadow.
  1098. ;; box - text will be surrounded by a box.
  1099. ;; outline - print characters as hollow outlines.
  1100. ;;
  1101. ;; See the documentation for `ps-extend-face'.
  1102. ;;
  1103. ;; Let's, for example, remap `font-lock-keyword-face' to another foreground
  1104. ;; color and bold attribute:
  1105. ;;
  1106. ;; (ps-extend-face '(font-lock-keyword-face "RoyalBlue" nil bold) 'MERGE)
  1107. ;;
  1108. ;; If you want to use a new face, define it first with `defface', and then call
  1109. ;; `ps-extend-face' to specify how to print it.
  1110. ;;
  1111. ;;
  1112. ;; How Ps-Print Has A Text And/Or Image On Background
  1113. ;; --------------------------------------------------
  1114. ;;
  1115. ;; ps-print can print texts and/or EPS PostScript images on background; it is
  1116. ;; possible to define the following text attributes: font name, font size,
  1117. ;; initial position, angle, gray scale and pages to print.
  1118. ;;
  1119. ;; It has the following EPS PostScript images attributes: file name containing
  1120. ;; the image, initial position, X and Y scales, angle and pages to print.
  1121. ;;
  1122. ;; See documentation for `ps-print-background-text' and
  1123. ;; `ps-print-background-image'.
  1124. ;;
  1125. ;; For example, if we wish to print text "preliminary" on all pages and text
  1126. ;; "special" on page 5 and from page 11 to page 17, we could specify:
  1127. ;;
  1128. ;; (setq ps-print-background-text
  1129. ;; '(("preliminary")
  1130. ;; ("special"
  1131. ;; "LeftMargin" "BottomMargin PrintHeight add" ; X and Y position
  1132. ;; ; (upper left corner)
  1133. ;; nil nil nil
  1134. ;; "PrintHeight neg PrintPageWidth atan" ; angle
  1135. ;; 5 (11 . 17)) ; page list
  1136. ;; ))
  1137. ;;
  1138. ;; Similarly, we could print image "~/images/EPS-image1.ps" on all pages and
  1139. ;; image "~/images/EPS-image2.ps" on page 5 and from page 11 to page 17, we
  1140. ;; specify:
  1141. ;;
  1142. ;; (setq ps-print-background-image
  1143. ;; '(("~/images/EPS-image1.ps"
  1144. ;; "LeftMargin" "BottomMargin") ; X and Y position (lower left corner)
  1145. ;; ("~/images/EPS-image2.ps"
  1146. ;; "LeftMargin" "BottomMargin PrintHeight 2 div add" ; X and Y pos.
  1147. ;; ; (upper left corner)
  1148. ;; nil nil nil
  1149. ;; 5 (11 . 17)) ; page list
  1150. ;; ))
  1151. ;;
  1152. ;; If it is not possible to read (or does not exist) an image file, that file
  1153. ;; is ignored.
  1154. ;;
  1155. ;; The printing order is:
  1156. ;;
  1157. ;; 1. Print background color
  1158. ;; 2. Print zebra stripes
  1159. ;; 3. Print background texts that it should be on all pages
  1160. ;; 4. Print background images that it should be on all pages
  1161. ;; 5. Print background texts only for current page (if any)
  1162. ;; 6. Print background images only for current page (if any)
  1163. ;; 7. Print header
  1164. ;; 8. Print buffer text (with faces, if specified) and line number
  1165. ;;
  1166. ;;
  1167. ;; Utilities
  1168. ;; ---------
  1169. ;;
  1170. ;; Some tools are provided to help you customize your font setup.
  1171. ;;
  1172. ;; `ps-setup' returns (some part of) the current setup.
  1173. ;;
  1174. ;; To avoid wrapping too many lines, you may want to adjust the left and right
  1175. ;; margins and the font size. On UN*X systems, do:
  1176. ;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
  1177. ;; to determine the longest lines of your file.
  1178. ;; Then, the command `ps-line-lengths' will give you the correspondence between
  1179. ;; a line length (number of characters) and the maximum font size which doesn't
  1180. ;; wrap such a line with the current ps-print setup.
  1181. ;;
  1182. ;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display the
  1183. ;; correspondence between a number of pages and the maximum font size which
  1184. ;; allow the number of lines of the current buffer or of its current region to
  1185. ;; fit in this number of pages.
  1186. ;;
  1187. ;; NOTE: line folding is not taken into account in this process and could
  1188. ;; change the results.
  1189. ;;
  1190. ;; The command `ps-print-customize' activates a customization buffer for
  1191. ;; ps-print options.
  1192. ;;
  1193. ;;
  1194. ;; New since version 1.5
  1195. ;; ---------------------
  1196. ;;
  1197. ;; Color output capability.
  1198. ;; Automatic detection of font attributes (bold, italic).
  1199. ;; Configurable headers with page numbers.
  1200. ;; Slightly faster.
  1201. ;; Support for different paper sizes.
  1202. ;; Better conformance to PostScript Document Structure Conventions.
  1203. ;;
  1204. ;;
  1205. ;; New since version 2.8
  1206. ;; ---------------------
  1207. ;;
  1208. ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
  1209. ;;
  1210. ;; 2007-10-27
  1211. ;; `ps-fg-validate-p', `ps-fg-list'
  1212. ;;
  1213. ;; 2004-02-29
  1214. ;; `ps-time-stamp-yyyy-mm-dd', `ps-time-stamp-iso8601'
  1215. ;;
  1216. ;; 2001-06-19
  1217. ;; `ps-time-stamp-locale-default'
  1218. ;;
  1219. ;; 2001-05-30
  1220. ;; Handle before-string and after-string overlay properties.
  1221. ;;
  1222. ;; 2001-04-07
  1223. ;; `ps-line-number-color', `ps-print-footer', `ps-footer-offset',
  1224. ;; `ps-print-footer-frame', `ps-footer-font-family',
  1225. ;; `ps-footer-font-size', `ps-footer-line-pad', `ps-footer-lines',
  1226. ;; `ps-left-footer', `ps-right-footer', `ps-footer-frame-alist' and
  1227. ;; `ps-header-frame-alist'.
  1228. ;;
  1229. ;; 2001-03-28
  1230. ;; `ps-line-spacing', `ps-paragraph-spacing', `ps-paragraph-regexp',
  1231. ;; `ps-begin-cut-regexp' and `ps-end-cut-regexp'.
  1232. ;;
  1233. ;; 2000-11-22
  1234. ;; `ps-line-number-font', `ps-line-number-font-size' and
  1235. ;; `ps-end-with-control-d'.
  1236. ;;
  1237. ;; 2000-08-21
  1238. ;; `ps-even-or-odd-pages'
  1239. ;;
  1240. ;; 2000-06-17
  1241. ;; `ps-manual-feed', `ps-warn-paper-type', `ps-print-upside-down',
  1242. ;; `ps-selected-pages', `ps-last-selected-pages',
  1243. ;; `ps-restore-selected-pages', `ps-switch-header',
  1244. ;; `ps-line-number-step', `ps-line-number-start',
  1245. ;; `ps-zebra-stripe-follow' and `ps-use-face-background'.
  1246. ;;
  1247. ;; 2000-03-10
  1248. ;; PostScript error handler.
  1249. ;; `ps-user-defined-prologue' and `ps-error-handler-message'.
  1250. ;;
  1251. ;; 1999-12-11
  1252. ;; `ps-print-customize'.
  1253. ;;
  1254. ;; 1999-07-03
  1255. ;; Better customization.
  1256. ;; `ps-banner-page-when-duplexing' and `ps-zebra-color'.
  1257. ;;
  1258. ;; 1999-05-13
  1259. ;; N-up printing.
  1260. ;; Hook: `ps-print-begin-sheet-hook'.
  1261. ;;
  1262. ;; [kenichi] 1999-05-09 Ken'ichi Handa <handa@m17n.org>
  1263. ;;
  1264. ;; `ps-print-region-function'
  1265. ;;
  1266. ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
  1267. ;;
  1268. ;; 1999-03-01
  1269. ;; PostScript tumble and setpagedevice.
  1270. ;;
  1271. ;; 1998-09-22
  1272. ;; PostScript prologue header comment insertion.
  1273. ;; Skip invisible text better.
  1274. ;;
  1275. ;; [kenichi] 1998-08-19 Ken'ichi Handa <handa@m17n.org>
  1276. ;;
  1277. ;; Multi-byte buffer handling.
  1278. ;;
  1279. ;; [vinicius] Vinicius Jose Latorre <viniciusjl@ig.com.br>
  1280. ;;
  1281. ;; 1998-03-06
  1282. ;; Skip invisible text.
  1283. ;;
  1284. ;; 1997-11-30
  1285. ;; Hooks: `ps-print-hook', `ps-print-begin-page-hook' and
  1286. ;; `ps-print-begin-column-hook'.
  1287. ;; Put one header per page over the columns.
  1288. ;; Better database font management.
  1289. ;; Better control characters handling.
  1290. ;;
  1291. ;; 1997-11-21
  1292. ;; Dynamic evaluation at print time of `ps-lpr-switches'.
  1293. ;; Handle control characters.
  1294. ;; Face remapping.
  1295. ;; New face attributes.
  1296. ;; Line number.
  1297. ;; Zebra stripes.
  1298. ;; Text and/or image on background.
  1299. ;;
  1300. ;; [jack] 1996-05-17 Jacques Duthen <duthen@cegelec-red.fr>
  1301. ;;
  1302. ;; Font family and float size for text and header.
  1303. ;; Landscape mode.
  1304. ;; Multiple columns.
  1305. ;; Tools for page setup.
  1306. ;;
  1307. ;;
  1308. ;; Known bugs and limitations of ps-print
  1309. ;; --------------------------------------
  1310. ;;
  1311. ;; Although color printing will work in XEmacs 19.12, it doesn't work well; in
  1312. ;; particular, bold or italic fonts don't print in the right background color.
  1313. ;;
  1314. ;; Invisible properties aren't correctly ignored in XEmacs 19.12.
  1315. ;;
  1316. ;; Automatic font-attribute detection doesn't work well, especially with
  1317. ;; hilit19 and older versions of get-create-face. Users having problems with
  1318. ;; auto-font detection should use the lists `ps-italic-faces', `ps-bold-faces'
  1319. ;; and `ps-underlined-faces' and/or turn off automatic detection by setting
  1320. ;; `ps-auto-font-detect' to nil.
  1321. ;;
  1322. ;; Automatic font-attribute detection doesn't work with XEmacs 19.12 in tty
  1323. ;; mode; use the lists `ps-italic-faces', `ps-bold-faces' and
  1324. ;; `ps-underlined-faces' instead.
  1325. ;;
  1326. ;; Still too slow; could use some hand-optimization.
  1327. ;;
  1328. ;; Default background color isn't working.
  1329. ;;
  1330. ;; Faces are always treated as opaque.
  1331. ;;
  1332. ;; Epoch, Lucid and Emacs 22 not supported. At all.
  1333. ;;
  1334. ;; Fixed-pitch fonts work better for line folding, but are not required.
  1335. ;;
  1336. ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care of folding
  1337. ;; lines.
  1338. ;;
  1339. ;;
  1340. ;; Things to change
  1341. ;; ----------------
  1342. ;;
  1343. ;; Avoid page break inside a paragraph.
  1344. ;;
  1345. ;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
  1346. ;;
  1347. ;; Improve the memory management for big files (hard?).
  1348. ;;
  1349. ;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care of folding
  1350. ;; lines.
  1351. ;;
  1352. ;;
  1353. ;; Acknowledgments
  1354. ;; ---------------
  1355. ;;
  1356. ;; Thanks to Eduard Wiebe <usenet@pusto.de> for fixing face
  1357. ;; background/foreground extraction.
  1358. ;;
  1359. ;; Thanks to Friedrich Delgado Friedrichs <friedel@nomaden.org> for new label
  1360. ;; printer page sizes.
  1361. ;;
  1362. ;; Thanks to Michael Piotrowski <mxp@dynalabs.de> for improving the DSC
  1363. ;; compliance of the generated PostScript.
  1364. ;;
  1365. ;; Thanks to Adam Doppelt <adoppelt@avogadro.com> for face mapping suggestion
  1366. ;; for black/white PostScript printers.
  1367. ;;
  1368. ;; Thanks to Toni Ronkko <tronkko@hytti.uku.fi> for line and paragraph spacing,
  1369. ;; region to cut out when printing and footer suggestions.
  1370. ;;
  1371. ;; Thanks to Pavel Janik ml <Pavel@Janik.cz> for documentation correction.
  1372. ;;
  1373. ;; Thanks to Corinne Ilvedson <cilvedson@draper.com> for line number font size
  1374. ;; suggestion.
  1375. ;;
  1376. ;; Thanks to Gord Wait <Gord_Wait@spectrumsignal.com> for
  1377. ;; `ps-user-defined-prologue' example setting for HP PostScript printer.
  1378. ;;
  1379. ;; Thanks to Paul Furnanz <pfurnanz@synopsys.com> for XEmacs compatibility
  1380. ;; suggestion for `ps-postscript-code-directory' variable.
  1381. ;;
  1382. ;; Thanks to David X Callaway <dxc@xprt.net> for helping debugging PostScript
  1383. ;; level 1 compatibility.
  1384. ;;
  1385. ;; Thanks to Colin Marquardt <colin.marquardt@usa.alcatel.com> for:
  1386. ;; - upside-down, line number step, line number start and zebra stripe
  1387. ;; follow suggestions.
  1388. ;; - `ps-time-stamp-yyyy-mm-dd' and `ps-time-stamp-iso8601' suggestion.
  1389. ;; - and for XEmacs beta-tests.
  1390. ;;
  1391. ;; Thanks to Klaus Berndl <klaus.berndl@sdm.de> for user defined PostScript
  1392. ;; prologue code suggestion, for odd/even printing suggestion and for
  1393. ;; `ps-prologue-file' enhancement.
  1394. ;;
  1395. ;; Thanks to Ken'ichi Handa <handa@m17n.org> for multi-byte buffer handling.
  1396. ;;
  1397. ;; Thanks to Matthew O Persico <Matthew.Persico@lazard.com> for line number on
  1398. ;; empty columns.
  1399. ;;
  1400. ;; Thanks to Theodore Jump <tjump@cais.com> for adjust PostScript code order on
  1401. ;; last page.
  1402. ;;
  1403. ;; Thanks to Roland Ducournau <ducour@lirmm.fr> for
  1404. ;; `ps-print-control-characters' variable documentation.
  1405. ;;
  1406. ;; Thanks to Marcus G Daniels <marcus@cathcart.sysc.pdx.edu> for a better
  1407. ;; database font management.
  1408. ;;
  1409. ;; Thanks to Martin Boyer <gamin@videotron.ca> for some ideas on putting one
  1410. ;; header per page over the columns and correct line numbers when printing a
  1411. ;; region.
  1412. ;;
  1413. ;; Thanks to Steven L Baur <steve@miranova.com> for dynamic evaluation at
  1414. ;; print time of `ps-lpr-switches'.
  1415. ;;
  1416. ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for handling control characters
  1417. ;; (his code was severely modified, but the main idea was kept).
  1418. ;;
  1419. ;; Thanks to some suggestions on:
  1420. ;; * Face color map: Marco Melgazzi <marco@techie.com>
  1421. ;; * XEmacs compatibility: William J. Henney <will@astrosmo.unam.mx>
  1422. ;; * Check `ps-paper-type': Sudhakar Frederick <sfrederi@asc.corp.mot.com>
  1423. ;;
  1424. ;; Thanks to Jacques Duthen <duthen@cegelec-red.fr> (Jack) for version 3.4 I
  1425. ;; started from. [vinicius]
  1426. ;;
  1427. ;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from. [jack]
  1428. ;;
  1429. ;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for color and
  1430. ;; the invisible property.
  1431. ;;
  1432. ;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing the
  1433. ;; initial port to Emacs 19. His code is no longer part of ps-print, but his
  1434. ;; work is still appreciated.
  1435. ;;
  1436. ;; Thanks to Remi Houdaille and Michel Train <michel@metasoft.fdn.org> for
  1437. ;; adding underline support. Their code also is no longer part of ps-print,
  1438. ;; but their efforts are not forgotten.
  1439. ;;
  1440. ;; Thanks also to all of you who mailed code to add features to ps-print;
  1441. ;; although I didn't use your code, I still appreciate your sharing it with me.
  1442. ;;
  1443. ;; Thanks to all who mailed comments, encouragement, and criticism.
  1444. ;; Thanks also to all who responded to my survey; I had too many responses to
  1445. ;; reply to them all, but I greatly appreciate your interest.
  1446. ;;
  1447. ;; Jim
  1448. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1449. ;;; Code:
  1450. (require 'lpr)
  1451. (if (featurep 'xemacs)
  1452. (or (featurep 'lisp-float-type)
  1453. (error "`ps-print' requires floating point support"))
  1454. (unless (and (boundp 'emacs-major-version)
  1455. (>= emacs-major-version 23))
  1456. (error "`ps-print' only supports Emacs 23 and higher")))
  1457. (defconst ps-windows-system
  1458. (memq system-type '(ms-dos windows-nt)))
  1459. (defconst ps-lp-system
  1460. (memq system-type '(usg-unix-v hpux irix)))
  1461. ;; Load XEmacs/Emacs definitions
  1462. (require 'ps-def)
  1463. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  1464. ;; User Variables:
  1465. ;;; Interface to the command system
  1466. (defgroup postscript nil
  1467. "Support for printing and PostScript."
  1468. :tag "PostScript"
  1469. :version "20"
  1470. :group 'external)
  1471. (defgroup ps-print nil
  1472. "PostScript generator for Emacs."
  1473. :link '(emacs-library-link :tag "Source Lisp File" "ps-print.el")
  1474. :prefix "ps-"
  1475. :version "20"
  1476. :group 'wp
  1477. :group 'postscript)
  1478. (defgroup ps-print-horizontal nil
  1479. "Horizontal page layout."
  1480. :prefix "ps-"
  1481. :tag "Horizontal"
  1482. :version "20"
  1483. :group 'ps-print)
  1484. (defgroup ps-print-vertical nil
  1485. "Vertical page layout."
  1486. :prefix "ps-"
  1487. :tag "Vertical"
  1488. :version "20"
  1489. :group 'ps-print)
  1490. (defgroup ps-print-headers nil
  1491. "Headers & footers layout."
  1492. :prefix "ps-"
  1493. :tag "Header & Footer"
  1494. :version "20"
  1495. :group 'ps-print)
  1496. (defgroup ps-print-font nil
  1497. "Fonts customization."
  1498. :prefix "ps-"
  1499. :tag "Font"
  1500. :version "20"
  1501. :group 'ps-print)
  1502. (defgroup ps-print-color nil
  1503. "Color customization."
  1504. :prefix "ps-"
  1505. :tag "Color"
  1506. :version "20"
  1507. :group 'ps-print)
  1508. (defgroup ps-print-face nil
  1509. "Faces customization."
  1510. :prefix "ps-"
  1511. :tag "PS Faces"
  1512. :version "20"
  1513. :group 'ps-print
  1514. :group 'faces)
  1515. (defgroup ps-print-n-up nil
  1516. "N-up customization."
  1517. :prefix "ps-"
  1518. :tag "N-Up"
  1519. :version "20"
  1520. :group 'ps-print)
  1521. (defgroup ps-print-zebra nil
  1522. "Zebra customization."
  1523. :prefix "ps-"
  1524. :tag "Zebra"
  1525. :version "20"
  1526. :group 'ps-print)
  1527. (defgroup ps-print-background nil
  1528. "Background customization."
  1529. :prefix "ps-"
  1530. :tag "Background"
  1531. :version "20"
  1532. :group 'ps-print)
  1533. (defgroup ps-print-printer '((lpr custom-group))
  1534. "Printer customization."
  1535. :prefix "ps-"
  1536. :tag "Printer"
  1537. :version "20"
  1538. :group 'ps-print)
  1539. (defgroup ps-print-page nil
  1540. "Page customization."
  1541. :prefix "ps-"
  1542. :tag "Page"
  1543. :version "20"
  1544. :group 'ps-print)
  1545. (defgroup ps-print-miscellany nil
  1546. "Miscellany customization."
  1547. :prefix "ps-"
  1548. :tag "Miscellany"
  1549. :version "20"
  1550. :group 'ps-print)
  1551. (defcustom ps-error-handler-message 'paper
  1552. "Specify where the error handler message should be sent.
  1553. Valid values are:
  1554. `none' catch the error and *DON'T* send any message.
  1555. `paper' catch the error and print on paper the error message.
  1556. `system' catch the error and send back the error message to
  1557. printing system. This is useful only if printing system
  1558. send back an email reporting the error, or if there is
  1559. some other alternative way to report back the error from
  1560. the system to you.
  1561. `paper-and-system' catch the error, print on paper the error message and
  1562. send back the error message to printing system.
  1563. Any other value is treated as `paper'."
  1564. :type '(choice :menu-tag "Error Handler Message"
  1565. :tag "Error Handler Message"
  1566. (const none) (const paper)
  1567. (const system) (const paper-and-system))
  1568. :version "20"
  1569. :group 'ps-print-miscellany)
  1570. (defcustom ps-user-defined-prologue nil
  1571. "User defined PostScript prologue code inserted before all prologue code.
  1572. `ps-user-defined-prologue' may be a string or a symbol function which returns a
  1573. string. Note that this string is inserted after `ps-adobe-tag' and PostScript
  1574. prologue comments, and before ps-print PostScript prologue code section. That
  1575. is, this string is inserted after error handler initialization and before
  1576. ps-print settings.
  1577. It's strongly recommended only insert PostScript code and/or comments specific
  1578. for your printing system particularities. For example, some special
  1579. initialization that only your printing system needs.
  1580. Do not insert code for duplex printing, n-up printing or error handler,
  1581. ps-print handles this in a suitable way.
  1582. For more information about PostScript, see:
  1583. PostScript Language Reference Manual (2nd edition)
  1584. Adobe Systems Incorporated
  1585. As an example for `ps-user-defined-prologue' setting:
  1586. ;; Setting for HP PostScript printer
  1587. (setq ps-user-defined-prologue
  1588. (concat \"<</DeferredMediaSelection true /PageSize [612 792] \"
  1589. \"/MediaPosition 2 /MediaType (Plain)>> setpagedevice\"))"
  1590. :type '(choice :menu-tag "User Defined Prologue"
  1591. :tag "User Defined Prologue"
  1592. (const :tag "none" nil) string symbol)
  1593. :version "20"
  1594. :group 'ps-print-miscellany)
  1595. (defcustom ps-print-prologue-header nil
  1596. "PostScript prologue header comments besides that ps-print generates.
  1597. `ps-print-prologue-header' may be a string or a symbol function which returns a
  1598. string. Note that this string is inserted on PostScript prologue header
  1599. section which is used to define some document characteristic through PostScript
  1600. special comments, like \"%%Requirements: jog\\n\".
  1601. ps-print always inserts the %%Requirements: comment, so if you need to insert
  1602. more requirements put them first in `ps-print-prologue-header' using the
  1603. \"%%+\" comment. For example, if you need to set numcopies to 3 and jog on
  1604. requirements and set %%LanguageLevel: to 2, do:
  1605. (setq ps-print-prologue-header
  1606. \"%%+ numcopies(3) jog\\n%%LanguageLevel: 2\\n\")
  1607. The duplex requirement is inserted by ps-print (see `ps-spool-duplex').
  1608. Do not forget to terminate the string with \"\\n\".
  1609. For more information about PostScript document comments, see:
  1610. PostScript Language Reference Manual (2nd edition)
  1611. Adobe Systems Incorporated
  1612. Appendix G: Document Structuring Conventions -- Version 3.0"
  1613. :type '(choice :menu-tag "Prologue Header"
  1614. :tag "Prologue Header"
  1615. (const :tag "none" nil) string symbol)
  1616. :version "20"
  1617. :group 'ps-print-miscellany)
  1618. (defcustom ps-printer-name (and (boundp 'printer-name)
  1619. (symbol-value 'printer-name))
  1620. "The name of a local printer for printing PostScript files.
  1621. On Unix-like systems, a string value should be a name understood by lpr's -P
  1622. option; a value of nil means use the value of `printer-name' instead.
  1623. On MS-DOS and MS-Windows systems, a string value is taken as the name of the
  1624. printer device or port to which PostScript files are written, provided
  1625. `ps-lpr-command' is \"\". By default it is the same as `printer-name'; typical
  1626. non-default settings would be \"LPT1\" to \"LPT3\" for parallel printers, or
  1627. \"COM1\" to \"COM4\" or \"AUX\" for serial printers, or \"\\\\hostname\\printer\"
  1628. for a shared network printer. You can also set it to a name of a file, in
  1629. which case the output gets appended to that file. \(Note that `ps-print'
  1630. package already has facilities for printing to a file, so you might as well use
  1631. them instead of changing the setting of this variable.\) If you want to
  1632. silently discard the printed output, set this to \"NUL\".
  1633. Set to t, if the utility given by `ps-lpr-command' needs an empty printer name.
  1634. Any other value is treated as t, that is, an empty printer name.
  1635. See also `ps-printer-name-option' for documentation."
  1636. :type '(choice :menu-tag "Printer Name"
  1637. :tag "Printer Name"
  1638. (const :tag "Same as printer-name" nil)
  1639. (const :tag "No Printer Name" t)
  1640. (file :tag "Print to file")
  1641. (string :tag "Pipe to ps-lpr-command"))
  1642. :version "20"
  1643. :group 'ps-print-printer)
  1644. (defcustom ps-printer-name-option
  1645. (cond (ps-windows-system
  1646. "/D:")
  1647. (ps-lp-system
  1648. "-d")
  1649. (t
  1650. "-P" ))
  1651. "Option for `ps-printer-name' variable (see it).
  1652. On Unix-like systems, if `lpr' is in use, this should be the string
  1653. \"-P\"; if `lp' is in use, this should be the string \"-d\".
  1654. On MS-DOS and MS-Windows systems, if `print' is in use, this should be
  1655. the string \"/D:\".
  1656. For any other printing utility, see its documentation.
  1657. Set this to \"\" or nil, if the utility given by `ps-lpr-command'
  1658. needs an empty printer name option--that is, pass the printer name
  1659. with no special option preceding it.
  1660. Any value that is not a string is treated as nil.
  1661. This variable is used only when `ps-printer-name' is a non-empty string."
  1662. :type '(choice :menu-tag "Printer Name Option"
  1663. :tag "Printer Name Option"
  1664. (const :tag "None" nil)
  1665. (string :tag "Option"))
  1666. :version "21.1"
  1667. :group 'ps-print-printer)
  1668. (defcustom ps-lpr-command lpr-command
  1669. "Name of program for printing a PostScript file.
  1670. On MS-DOS and MS-Windows systems, if the value is an empty string then Emacs
  1671. will write directly to the printer port named by `ps-printer-name'. The
  1672. programs `print' and `nprint' (the standard print programs on Windows NT and
  1673. Novell Netware respectively) are handled specially, using `ps-printer-name' as
  1674. the destination for output; any other program is treated like `lpr' except that
  1675. an explicit filename is given as the last argument."
  1676. :type 'string
  1677. :version "20"
  1678. :group 'ps-print-printer)
  1679. (defcustom ps-lpr-switches lpr-switches
  1680. "List of extra switches to pass to `ps-lpr-command'.
  1681. The list element can be:
  1682. string it should be an option for `ps-lpr-command' (which see).
  1683. For example: \"-o Duplex=DuplexNoTumble\"
  1684. symbol it can be a function or variable symbol. If it's a function
  1685. symbol, it should be a function with no argument. The result
  1686. of the function or the variable value should be a string or a
  1687. list of strings.
  1688. list the header should be a symbol function and the tail is the
  1689. arguments for this function. This function should return a
  1690. string or a list of strings.
  1691. Any other value is silently ignored.
  1692. It is recommended to set `ps-printer-name' (which see) instead of including an
  1693. explicit switch on this list.
  1694. See `ps-lpr-command'."
  1695. :type '(repeat :tag "PostScript lpr Switches"
  1696. (choice :menu-tag "PostScript lpr Switch"
  1697. :tag "PostScript lpr Switch"
  1698. string symbol (repeat sexp)))
  1699. :version "20"
  1700. :group 'ps-print-printer)
  1701. (defcustom ps-print-region-function nil
  1702. "Specify a function to print the region on a PostScript printer.
  1703. See definition of `call-process-region' for calling conventions. The fourth
  1704. and the sixth arguments are both nil."
  1705. :type '(choice (const nil) function)
  1706. :version "20"
  1707. :group 'ps-print-printer)
  1708. (defcustom ps-manual-feed nil
  1709. "Non-nil means the printer will manually feed paper.
  1710. If it's nil, automatic feeding takes place."
  1711. :type 'boolean
  1712. :version "20"
  1713. :group 'ps-print-printer)
  1714. (defcustom ps-end-with-control-d (and ps-windows-system t)
  1715. "Non-nil means insert C-d at end of PostScript file generated."
  1716. :version "21.1"
  1717. :type 'boolean
  1718. :version "20"
  1719. :group 'ps-print-printer)
  1720. ;;; Page layout
  1721. ;; All page dimensions are in PostScript points.
  1722. ;; 1 inch == 2.54 cm == 72 points
  1723. ;; 1 cm == (/ 1 2.54) inch == (/ 72 2.54) points
  1724. ;; Letter 8.5 inch x 11.0 inch
  1725. ;; Legal 8.5 inch x 14.0 inch
  1726. ;; A4 8.26 inch x 11.69 inch = 21.0 cm x 29.7 cm
  1727. ;; LetterSmall 7.68 inch x 10.16 inch
  1728. ;; Tabloid 11.0 inch x 17.0 inch
  1729. ;; Ledger 17.0 inch x 11.0 inch
  1730. ;; Statement 5.5 inch x 8.5 inch
  1731. ;; Executive 7.5 inch x 10.0 inch
  1732. ;; A3 11.69 inch x 16.5 inch = 29.7 cm x 42.0 cm
  1733. ;; A4Small 7.47 inch x 10.85 inch
  1734. ;; B4 10.125 inch x 14.33 inch
  1735. ;; B5 7.16 inch x 10.125 inch
  1736. ;;;###autoload
  1737. (defcustom ps-page-dimensions-database
  1738. (purecopy
  1739. (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4")
  1740. (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3")
  1741. (list 'letter (* 72 8.5) (* 72 11.0) "Letter")
  1742. (list 'legal (* 72 8.5) (* 72 14.0) "Legal")
  1743. (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall")
  1744. (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid")
  1745. (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger")
  1746. (list 'statement (* 72 5.5) (* 72 8.5) "Statement")
  1747. (list 'executive (* 72 7.5) (* 72 10.0) "Executive")
  1748. (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small")
  1749. (list 'b4 (* 72 10.125) (* 72 14.33) "B4")
  1750. (list 'b5 (* 72 7.16) (* 72 10.125) "B5")
  1751. ;; page sizes for label printer
  1752. ;; NOTE: the page sizes below don't have n-up > 1.
  1753. '(addresslarge 236.0 99.0 "AddressLarge")
  1754. '(addresssmall 236.0 68.0 "AddressSmall")
  1755. '(cuthanging13 90.0 222.0 "CutHanging13")
  1756. '(cuthanging15 90.0 114.0 "CutHanging15")
  1757. '(diskette 181.0 136.0 "Diskette")
  1758. '(eurofilefolder 139.0 112.0 "EuropeanFilefolder")
  1759. '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow")
  1760. '(eurofolderwide 526.0 136.0 "EuroFolderWide")
  1761. '(euronamebadge 189.0 108.0 "EuroNameBadge")
  1762. '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge")
  1763. '(filefolder 230.0 37.0 "FileFolder")
  1764. '(jewelry 76.0 136.0 "Jewelry")
  1765. '(mediabadge 180.0 136.0 "MediaBadge")
  1766. '(multipurpose 126.0 68.0 "MultiPurpose")
  1767. '(retaillabel 90.0 104.0 "RetailLabel")
  1768. '(shipping 271.0 136.0 "Shipping")
  1769. '(slide35mm 26.0 104.0 "Slide35mm")
  1770. '(spine8mm 187.0 26.0 "Spine8mm")
  1771. '(topcoated 425.19685 136.0 "TopCoatedPaper")
  1772. '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150")
  1773. '(vhsface 205.0 127.0 "VHSFace")
  1774. '(vhsspine 400.0 50.0 "VHSSpine")
  1775. '(zipdisk 156.0 136.0 "ZipDisk")))
  1776. "List associating a symbolic paper type to its width, height and doc media.
  1777. See `ps-paper-type'."
  1778. :type '(repeat (list :tag "Paper Type"
  1779. (symbol :tag "Symbol Name")
  1780. (number :tag "Width in points")
  1781. (number :tag "Height in points")
  1782. (string :tag "Media")))
  1783. :version "20"
  1784. :group 'ps-print-page)
  1785. ;;;###autoload
  1786. (defcustom ps-paper-type 'letter
  1787. "Specify the size of paper to format for.
  1788. Should be one of the paper types defined in `ps-page-dimensions-database', for
  1789. example `letter', `legal' or `a4'."
  1790. :type '(symbol :validate (lambda (wid)
  1791. (if (assq (widget-value wid)
  1792. ps-page-dimensions-database)
  1793. nil
  1794. (widget-put wid :error "Unknown paper size")
  1795. wid)))
  1796. :version "20"
  1797. :group 'ps-print-page)
  1798. (defcustom ps-warn-paper-type t
  1799. "Non-nil means give an error if paper size is not equal to `ps-paper-type'.
  1800. It's used when `ps-spool-config' is set to `setpagedevice'."
  1801. :type 'boolean
  1802. :version "20"
  1803. :group 'ps-print-page)
  1804. (defcustom ps-landscape-mode nil
  1805. "Non-nil means print in landscape mode."
  1806. :type 'boolean
  1807. :version "20"
  1808. :group 'ps-print-page)
  1809. (defcustom ps-print-upside-down nil
  1810. "Non-nil means print upside-down (that is, rotated by 180 degrees)."
  1811. :type 'boolean
  1812. :version "21.1"
  1813. :group 'ps-print-page)
  1814. (defcustom ps-selected-pages nil
  1815. "Specify which pages to print.
  1816. If nil, print all pages.
  1817. If a list, the lists element may be an integer or a cons cell (FROM . TO)
  1818. designating FROM page to TO page; any invalid element is ignored, that is, an
  1819. integer lesser than one or if FROM is greater than TO.
  1820. Otherwise, it's treated as nil.
  1821. After ps-print processing `ps-selected-pages' is set to nil. But the
  1822. latest `ps-selected-pages' is saved in `ps-last-selected-pages' (which
  1823. see). So you can restore the latest selected pages by using
  1824. `ps-last-selected-pages' or with the `ps-restore-selected-pages'
  1825. command (which see).
  1826. See also `ps-even-or-odd-pages'."
  1827. :type '(repeat :tag "Selected Pages"
  1828. (radio :tag "Page"
  1829. (integer :tag "Number")
  1830. (cons :tag "Range"
  1831. (integer :tag "From")
  1832. (integer :tag "To"))))
  1833. :version "20"
  1834. :group 'ps-print-page)
  1835. (defcustom ps-even-or-odd-pages nil
  1836. "Specify if it prints even/odd pages.
  1837. Valid values are:
  1838. nil print all pages.
  1839. `even-page' print only even pages.
  1840. `odd-page' print only odd pages.
  1841. `even-sheet' print only even sheets.
  1842. That is, if `ps-n-up-printing' is 1, it behaves as `even-page';
  1843. but for values greater than 1, it'll print only the even sheet
  1844. of paper.
  1845. `odd-sheet' print only odd sheets.
  1846. That is, if `ps-n-up-printing' is 1, it behaves as `odd-page';
  1847. but for values greater than 1, it'll print only the odd sheet
  1848. of paper.
  1849. Any other value is treated as nil.
  1850. If you set `ps-selected-pages' (see it for documentation), first the pages are
  1851. filtered by `ps-selected-pages' and then by `ps-even-or-odd-pages'. For
  1852. example, if we have:
  1853. (setq ps-selected-pages '(1 4 (6 . 10) (12 . 16) 20))
  1854. Combining with `ps-even-or-odd-pages' and `ps-n-up-printing', we have:
  1855. `ps-n-up-printing' = 1:
  1856. `ps-even-or-odd-pages' PAGES PRINTED
  1857. nil 1, 4, 6, 7, 8, 9, 10, 12, 13, 14, 15, 16, 20
  1858. even-page 4, 6, 8, 10, 12, 14, 16, 20
  1859. odd-page 1, 7, 9, 13, 15
  1860. even-sheet 4, 6, 8, 10, 12, 14, 16, 20
  1861. odd-sheet 1, 7, 9, 13, 15
  1862. `ps-n-up-printing' = 2:
  1863. `ps-even-or-odd-pages' PAGES PRINTED
  1864. nil 1/4, 6/7, 8/9, 10/12, 13/14, 15/16, 20
  1865. even-page 4/6, 8/10, 12/14, 16/20
  1866. odd-page 1/7, 9/13, 15
  1867. even-sheet 6/7, 10/12, 15/16
  1868. odd-sheet 1/4, 8/9, 13/14, 20
  1869. So even-page/odd-page are about page parity and even-sheet/odd-sheet are about
  1870. sheet parity."
  1871. :type '(choice :menu-tag "Print Even/Odd Pages"
  1872. :tag "Print Even/Odd Pages"
  1873. (const :tag "All Pages" nil)
  1874. (const :tag "Only Even Pages" even-page)
  1875. (const :tag "Only Odd Pages" odd-page)
  1876. (const :tag "Only Even Sheets" even-sheet)
  1877. (const :tag "Only Odd Sheets" odd-sheet))
  1878. :version "20"
  1879. :group 'ps-print-page)
  1880. (defcustom ps-print-control-characters 'control-8-bit
  1881. "Specify the printable form for control and 8-bit characters.
  1882. That is, instead of sending, for example, a ^D (\\004) to printer,
  1883. it is sent the string \"^D\".
  1884. Valid values are:
  1885. `8-bit' This is the value to use when you want an ASCII encoding of
  1886. any control or non-ASCII character. Control characters are
  1887. encoded as \"^D\", and non-ASCII characters have an
  1888. octal encoding.
  1889. `control-8-bit' This is the value to use when you want an ASCII encoding of
  1890. any control character, whether it is 7 or 8-bit.
  1891. European 8-bits accented characters are printed according
  1892. the current font.
  1893. `control' Only ASCII control characters have an ASCII encoding.
  1894. European 8-bits accented characters are printed according
  1895. the current font.
  1896. nil No ASCII encoding. Any character is printed according the
  1897. current font.
  1898. Any other value is treated as nil."
  1899. :type '(choice :menu-tag "Control Char"
  1900. :tag "Control Char"
  1901. (const 8-bit) (const control-8-bit)
  1902. (const control) (const :tag "nil" nil))
  1903. :version "20"
  1904. :group 'ps-print-miscellany)
  1905. (defcustom ps-n-up-printing 1
  1906. "Specify the number of pages per sheet paper."
  1907. :type '(integer
  1908. :tag "N Up Printing"
  1909. :validate
  1910. (lambda (wid)
  1911. (if (and (< 0 (widget-value wid))
  1912. (<= (widget-value wid) 100))
  1913. nil
  1914. (widget-put
  1915. wid :error
  1916. "Number of pages per sheet paper must be between 1 and 100.")
  1917. wid)))
  1918. :version "20"
  1919. :group 'ps-print-n-up)
  1920. (defcustom ps-n-up-margin (/ (* 72 1.0) 2.54) ; 1 cm
  1921. "Specify the margin in points between the sheet border and n-up printing."
  1922. :type 'number
  1923. :version "20"
  1924. :group 'ps-print-n-up)
  1925. (defcustom ps-n-up-border-p t
  1926. "Non-nil means a border is drawn around each page."
  1927. :type 'boolean
  1928. :version "20"
  1929. :group 'ps-print-n-up)
  1930. (defcustom ps-n-up-filling 'left-top
  1931. "Specify how page matrix is filled on each sheet of paper.
  1932. Following are the valid values for `ps-n-up-filling' with a filling example
  1933. using a 3x4 page matrix:
  1934. `left-top' 1 2 3 4 `left-bottom' 9 10 11 12
  1935. 5 6 7 8 5 6 7 8
  1936. 9 10 11 12 1 2 3 4
  1937. `right-top' 4 3 2 1 `right-bottom' 12 11 10 9
  1938. 8 7 6 5 8 7 6 5
  1939. 12 11 10 9 4 3 2 1
  1940. `top-left' 1 4 7 10 `bottom-left' 3 6 9 12
  1941. 2 5 8 11 2 5 8 11
  1942. 3 6 9 12 1 4 7 10
  1943. `top-right' 10 7 4 1 `bottom-right' 12 9 6 3
  1944. 11 8 5 2 11 8 5 2
  1945. 12 9 6 3 10 7 4 1
  1946. Any other value is treated as `left-top'."
  1947. :type '(choice :menu-tag "N-Up Filling"
  1948. :tag "N-Up Filling"
  1949. (const left-top) (const left-bottom)
  1950. (const right-top) (const right-bottom)
  1951. (const top-left) (const bottom-left)
  1952. (const top-right) (const bottom-right))
  1953. :version "20"
  1954. :group 'ps-print-n-up)
  1955. (defcustom ps-number-of-columns (if ps-landscape-mode 2 1)
  1956. "Specify the number of columns."
  1957. :type 'number
  1958. :version "20"
  1959. :group 'ps-print-miscellany)
  1960. (defcustom ps-zebra-stripes nil
  1961. "Non-nil means print zebra stripes.
  1962. See also documentation for `ps-zebra-stripe-height' and `ps-zebra-color'."
  1963. :type 'boolean
  1964. :version "20"
  1965. :group 'ps-print-zebra)
  1966. (defcustom ps-zebra-stripe-height 3
  1967. "Number of zebra stripe lines.
  1968. See also documentation for `ps-zebra-stripes' and `ps-zebra-color'."
  1969. :type 'number
  1970. :version "20"
  1971. :group 'ps-print-zebra)
  1972. (defcustom ps-zebra-color 0.95
  1973. "Zebra stripe gray scale or RGB color.
  1974. See also documentation for `ps-zebra-stripes' and `ps-zebra-stripe-height'."
  1975. :type '(choice :menu-tag "Zebra Gray/Color"
  1976. :tag "Zebra Gray/Color"
  1977. (number :tag "Gray Scale" :value 0.95)
  1978. (string :tag "Color Name" :value "gray95")
  1979. (list :tag "RGB Color" :value (0.95 0.95 0.95)
  1980. (number :tag "Red")
  1981. (number :tag "Green")
  1982. (number :tag "Blue")))
  1983. :version "20"
  1984. :group 'ps-print-zebra)
  1985. (defcustom ps-zebra-stripe-follow nil
  1986. "Specify how zebra stripes continue on next page.
  1987. Visually, valid values are (the character `+' at right of each column indicates
  1988. that a line is printed):
  1989. `nil' `follow' `full' `full-follow'
  1990. Current Page -------- ----------- --------- ----------------
  1991. 1 XXXXX + 1 XXXXXXXX + 1 XXXXXX + 1 XXXXXXXXXXXXX +
  1992. 2 XXXXX + 2 XXXXXXXX + 2 XXXXXX + 2 XXXXXXXXXXXXX +
  1993. 3 XXXXX + 3 XXXXXXXX + 3 XXXXXX + 3 XXXXXXXXXXXXX +
  1994. 4 + 4 + 4 + 4 +
  1995. 5 + 5 + 5 + 5 +
  1996. 6 + 6 + 6 + 6 +
  1997. 7 XXXXX + 7 XXXXXXXX + 7 XXXXXX + 7 XXXXXXXXXXXXX +
  1998. 8 XXXXX + 8 XXXXXXXX + 8 XXXXXX + 8 XXXXXXXXXXXXX +
  1999. 9 XXXXX + 9 XXXXXXXX + 9 XXXXXX + 9 XXXXXXXXXXXXX +
  2000. 10 + 10 +
  2001. 11 + 11 +
  2002. -------- ----------- --------- ----------------
  2003. Next Page -------- ----------- --------- ----------------
  2004. 12 XXXXX + 12 + 10 XXXXXX + 10 +
  2005. 13 XXXXX + 13 XXXXXXXX + 11 XXXXXX + 11 +
  2006. 14 XXXXX + 14 XXXXXXXX + 12 XXXXXX + 12 +
  2007. 15 + 15 XXXXXXXX + 13 + 13 XXXXXXXXXXXXX +
  2008. 16 + 16 + 14 + 14 XXXXXXXXXXXXX +
  2009. 17 + 17 + 15 + 15 XXXXXXXXXXXXX +
  2010. 18 XXXXX + 18 + 16 XXXXXX + 16 +
  2011. 19 XXXXX + 19 XXXXXXXX + 17 XXXXXX + 17 +
  2012. 20 XXXXX + 20 XXXXXXXX + 18 XXXXXX + 18 +
  2013. 21 + 21 XXXXXXXX +
  2014. 22 + 22 +
  2015. -------- ----------- --------- ----------------
  2016. Any other value is treated as nil."
  2017. :type '(choice :menu-tag "Zebra Stripe Follow"
  2018. :tag "Zebra Stripe Follow"
  2019. (const :tag "Always Restart" nil)
  2020. (const :tag "Continue on Next Page" follow)
  2021. (const :tag "Print Only Full Stripe" full)
  2022. (const :tag "Continue on Full Stripe" full-follow))
  2023. :version "20"
  2024. :group 'ps-print-zebra)
  2025. (defcustom ps-line-number nil
  2026. "Non-nil means print line number."
  2027. :type 'boolean
  2028. :version "20"
  2029. :group 'ps-print-miscellany)
  2030. (defcustom ps-line-number-step 1
  2031. "Specify the interval that line number is printed.
  2032. For example, `ps-line-number-step' is set to 2, the printing will look like:
  2033. 1 one line
  2034. one line
  2035. 3 one line
  2036. one line
  2037. 5 one line
  2038. one line
  2039. ...
  2040. Valid values are:
  2041. integer an integer that specifies the interval that line number is
  2042. printed. If it's lesser than or equal to zero, it's used the
  2043. value 1.
  2044. `zebra' specifies that only the line number of the first line in a
  2045. zebra stripe is to be printed.
  2046. Any other value is treated as `zebra'."
  2047. :type '(choice :menu-tag "Line Number Step"
  2048. :tag "Line Number Step"
  2049. (integer :tag "Step Interval")
  2050. (const :tag "Synchronize Zebra" zebra))
  2051. :version "20"
  2052. :group 'ps-print-miscellany)
  2053. (defcustom ps-line-number-start 1
  2054. "Specify the starting point in the interval given by `ps-line-number-step'.
  2055. For example, if `ps-line-number-step' is set to 3 and `ps-line-number-start' is
  2056. set to 3, the printing will look like:
  2057. one line
  2058. one line
  2059. 3 one line
  2060. one line
  2061. one line
  2062. 6 one line
  2063. one line
  2064. one line
  2065. 9 one line
  2066. one line
  2067. ...
  2068. The values for `ps-line-number-start':
  2069. * If `ps-line-number-step' is an integer, must be between 1 and the value of
  2070. `ps-line-number-step' inclusive.
  2071. * If `ps-line-number-step' is set to `zebra', must be between 1 and the
  2072. value of `ps-zebra-strip-height' inclusive. Use this combination if you
  2073. wish that line number be relative to zebra stripes."
  2074. :type '(integer :tag "Start Step Interval")
  2075. :version "20"
  2076. :group 'ps-print-miscellany)
  2077. (defcustom ps-print-background-image nil
  2078. "EPS image list to be printed on background.
  2079. The elements are:
  2080. (FILENAME X Y XSCALE YSCALE ROTATION PAGES...)
  2081. FILENAME is a file name which contains an EPS image or some PostScript
  2082. programming like EPS.
  2083. FILENAME is ignored, if it doesn't exist or is read protected.
  2084. X and Y are relative positions on paper to put the image.
  2085. If X and Y are nil, the image is centered on paper.
  2086. XSCALE and YSCALE are scale factor to be applied to image before printing.
  2087. If XSCALE and YSCALE are nil, the original size is used.
  2088. ROTATION is the image rotation angle; if nil, the default is 0.
  2089. PAGES designates the page to print background image.
  2090. PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
  2091. page.
  2092. If PAGES is nil, print background image on all pages.
  2093. X, Y, XSCALE, YSCALE and ROTATION may be a floating point number, an integer
  2094. number or a string. If it is a string, the string should contain PostScript
  2095. programming that returns a float or integer value.
  2096. For example, if you wish to print an EPS image on all pages do:
  2097. '((\"~/images/EPS-image.ps\"))"
  2098. :type '(repeat
  2099. (list
  2100. (file :tag "EPS File")
  2101. (choice :tag "X" (const :tag "default" nil) number string)
  2102. (choice :tag "Y" (const :tag "default" nil) number string)
  2103. (choice :tag "X Scale" (const :tag "default" nil) number string)
  2104. (choice :tag "Y Scale" (const :tag "default" nil) number string)
  2105. (choice :tag "Rotation" (const :tag "default" nil) number string)
  2106. (repeat :tag "Pages" :inline t
  2107. (radio (integer :tag "Page")
  2108. (cons :tag "Range"
  2109. (integer :tag "From")
  2110. (integer :tag "To"))))))
  2111. :version "20"
  2112. :group 'ps-print-background)
  2113. (defcustom ps-print-background-text nil
  2114. "Text list to be printed on background.
  2115. The elements are:
  2116. (STRING X Y FONT FONTSIZE GRAY ROTATION PAGES...)
  2117. STRING is the text to be printed on background.
  2118. X and Y are positions on paper to put the text.
  2119. If X and Y are nil, the text is positioned at lower left corner.
  2120. FONT is a font name to be used on printing the text.
  2121. If nil, \"Times-Roman\" is used.
  2122. FONTSIZE is font size to be used, if nil, 200 is used.
  2123. GRAY is the text gray factor (should be very light like 0.8).
  2124. If nil, the default is 0.85.
  2125. ROTATION is the text rotation angle; if nil, the angle is given by the diagonal
  2126. from lower left corner to upper right corner.
  2127. PAGES designates the page to print background text.
  2128. PAGES may be a number or a cons cell (FROM . TO) designating FROM page to TO
  2129. page.
  2130. If PAGES is nil, print background text on all pages.
  2131. X, Y, FONTSIZE, GRAY and ROTATION may be a floating point number, an integer
  2132. number or a string. If it is a string, the string should contain PostScript
  2133. programming that returns a float or integer value.
  2134. For example, if you wish to print text \"Preliminary\" on all pages do:
  2135. '((\"Preliminary\"))"
  2136. :type '(repeat
  2137. (list
  2138. (string :tag "Text")
  2139. (choice :tag "X" (const :tag "default" nil) number string)
  2140. (choice :tag "Y" (const :tag "default" nil) number string)
  2141. (choice :tag "Font" (const :tag "default" nil) string)
  2142. (choice :tag "Fontsize" (const :tag "default" nil) number string)
  2143. (choice :tag "Gray" (const :tag "default" nil) number string)
  2144. (choice :tag "Rotation" (const :tag "default" nil) number string)
  2145. (repeat :tag "Pages" :inline t
  2146. (radio (integer :tag "Page")
  2147. (cons :tag "Range"
  2148. (integer :tag "From")
  2149. (integer :tag "To"))))))
  2150. :version "20"
  2151. :group 'ps-print-background)
  2152. ;;; Horizontal layout
  2153. ;; ------------------------------------------
  2154. ;; | | | | | | | |
  2155. ;; | lm | text | ic | text | ic | text | rm |
  2156. ;; | | | | | | | |
  2157. ;; ------------------------------------------
  2158. (defcustom ps-left-margin (/ (* 72 2.0) 2.54) ; 2 cm
  2159. "Left margin in points (1/72 inch)."
  2160. :type 'number
  2161. :version "20"
  2162. :group 'ps-print-horizontal)
  2163. (defcustom ps-right-margin (/ (* 72 2.0) 2.54) ; 2 cm
  2164. "Right margin in points (1/72 inch)."
  2165. :type 'number
  2166. :version "20"
  2167. :group 'ps-print-horizontal)
  2168. (defcustom ps-inter-column (/ (* 72 2.0) 2.54) ; 2 cm
  2169. "Horizontal space between columns in points (1/72 inch)."
  2170. :type 'number
  2171. :version "20"
  2172. :group 'ps-print-horizontal)
  2173. ;;; Vertical layout
  2174. ;; |--------|
  2175. ;; | tm |
  2176. ;; |--------|
  2177. ;; | header |
  2178. ;; |--------|
  2179. ;; | ho |
  2180. ;; |--------|
  2181. ;; | text |
  2182. ;; |--------|
  2183. ;; | bm |
  2184. ;; |--------|
  2185. (defcustom ps-bottom-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
  2186. "Bottom margin in points (1/72 inch)."
  2187. :type 'number
  2188. :version "20"
  2189. :group 'ps-print-vertical)
  2190. (defcustom ps-top-margin (/ (* 72 1.5) 2.54) ; 1.5 cm
  2191. "Top margin in points (1/72 inch)."
  2192. :type 'number
  2193. :version "20"
  2194. :group 'ps-print-vertical)
  2195. (defcustom ps-header-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
  2196. "Vertical space in points (1/72 inch) between the main text and the header."
  2197. :type 'number
  2198. :version "20"
  2199. :group 'ps-print-vertical)
  2200. (defcustom ps-header-line-pad 0.15
  2201. "Portion of a header title line height to insert.
  2202. The insertion is done between the header frame and the text it contains,
  2203. both in the vertical and horizontal directions."
  2204. :type 'number
  2205. :version "20"
  2206. :group 'ps-print-vertical)
  2207. (defcustom ps-footer-offset (/ (* 72 1.0) 2.54) ; 1.0 cm
  2208. "Vertical space in points (1/72 inch) between the main text and the footer."
  2209. :type 'number
  2210. :version "20"
  2211. :group 'ps-print-vertical)
  2212. (defcustom ps-footer-line-pad 0.15
  2213. "Portion of a footer title line height to insert.
  2214. The insertion is done between the footer frame and the text it contains,
  2215. both in the vertical and horizontal directions."
  2216. :type 'number
  2217. :version "20"
  2218. :group 'ps-print-vertical)
  2219. ;;; Header/Footer setup
  2220. (defcustom ps-print-header t
  2221. "Non-nil means print a header at the top of each page.
  2222. By default, the header displays the buffer name, page number, and, if the
  2223. buffer is visiting a file, the file's directory. Headers are customizable by
  2224. changing variables `ps-left-header' and `ps-right-header'."
  2225. :type 'boolean
  2226. :version "20"
  2227. :group 'ps-print-headers)
  2228. (defcustom ps-print-header-frame t
  2229. "Non-nil means draw a gaudy frame around the header."
  2230. :type 'boolean
  2231. :version "20"
  2232. :group 'ps-print-headers)
  2233. (defcustom ps-header-frame-alist
  2234. '((fore-color . 0.0)
  2235. (back-color . 0.9)
  2236. (border-width . 0.4)
  2237. (border-color . 0.0)
  2238. (shadow-color . 0.0))
  2239. "Specify header frame properties alist.
  2240. Valid frame properties are:
  2241. `fore-color' Specify the foreground frame color.
  2242. It should be a float number between 0.0 (black color)
  2243. and 1.0 (white color), a string which is a color name,
  2244. or a list of 3 float numbers which corresponds to the
  2245. Red Green Blue color scale, each float number between
  2246. 0.0 (dark color) and 1.0 (bright color).
  2247. `back-color' Specify the background frame color (similar to
  2248. `fore-color').
  2249. `shadow-color' Specify the shadow color (similar to `fore-color').
  2250. `border-color' Specify the border color (similar to `fore-color').
  2251. `border-width' Specify the border width.
  2252. Any other property is ignored.
  2253. Don't change this alist directly, instead use customization, or `ps-value',
  2254. `ps-get', `ps-put' and `ps-del' functions (see them for documentation)."
  2255. :version "21.1"
  2256. :type '(repeat
  2257. (choice :menu-tag "Header Frame Element"
  2258. :tag ""
  2259. (cons :tag "Foreground Color" :format "%v"
  2260. (const :format "" fore-color)
  2261. (choice :menu-tag "Foreground Color"
  2262. :tag "Foreground Color"
  2263. (number :tag "Gray Scale" :value 0.0)
  2264. (string :tag "Color Name" :value "black")
  2265. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2266. (number :tag "Red")
  2267. (number :tag "Green")
  2268. (number :tag "Blue"))))
  2269. (cons :tag "Background Color" :format "%v"
  2270. (const :format "" back-color)
  2271. (choice :menu-tag "Background Color"
  2272. :tag "Background Color"
  2273. (number :tag "Gray Scale" :value 0.9)
  2274. (string :tag "Color Name" :value "gray90")
  2275. (list :tag "RGB Color" :value (0.9 0.9 0.9)
  2276. (number :tag "Red")
  2277. (number :tag "Green")
  2278. (number :tag "Blue"))))
  2279. (cons :tag "Border Width" :format "%v"
  2280. (const :format "" border-width)
  2281. (number :tag "Border Width" :value 0.4))
  2282. (cons :tag "Border Color" :format "%v"
  2283. (const :format "" border-color)
  2284. (choice :menu-tag "Border Color"
  2285. :tag "Border Color"
  2286. (number :tag "Gray Scale" :value 0.0)
  2287. (string :tag "Color Name" :value "black")
  2288. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2289. (number :tag "Red")
  2290. (number :tag "Green")
  2291. (number :tag "Blue"))))
  2292. (cons :tag "Shadow Color" :format "%v"
  2293. (const :format "" shadow-color)
  2294. (choice :menu-tag "Shadow Color"
  2295. :tag "Shadow Color"
  2296. (number :tag "Gray Scale" :value 0.0)
  2297. (string :tag "Color Name" :value "black")
  2298. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2299. (number :tag "Red")
  2300. (number :tag "Green")
  2301. (number :tag "Blue"))))))
  2302. :version "20"
  2303. :group 'ps-print-headers)
  2304. (defcustom ps-header-lines 2
  2305. "Number of lines to display in page header, when generating PostScript."
  2306. :type 'integer
  2307. :version "20"
  2308. :group 'ps-print-headers)
  2309. (defcustom ps-print-footer nil
  2310. "Non-nil means print a footer at the bottom of each page.
  2311. By default, the footer displays page number.
  2312. Footers are customizable by changing variables `ps-left-footer' and
  2313. `ps-right-footer'."
  2314. :type 'boolean
  2315. :version "21.1"
  2316. :group 'ps-print-headers)
  2317. (defcustom ps-print-footer-frame t
  2318. "Non-nil means draw a gaudy frame around the footer."
  2319. :type 'boolean
  2320. :version "21.1"
  2321. :group 'ps-print-headers)
  2322. (defcustom ps-footer-frame-alist
  2323. '((fore-color . 0.0)
  2324. (back-color . 0.9)
  2325. (border-width . 0.4)
  2326. (border-color . 0.0)
  2327. (shadow-color . 0.0))
  2328. "Specify footer frame properties alist.
  2329. Don't change this alist directly, instead use customization, or `ps-value',
  2330. `ps-get', `ps-put' and `ps-del' functions (see them for documentation).
  2331. See also `ps-header-frame-alist' for documentation."
  2332. :type '(repeat
  2333. (choice :menu-tag "Header Frame Element"
  2334. :tag ""
  2335. (cons :tag "Foreground Color" :format "%v"
  2336. (const :format "" fore-color)
  2337. (choice :menu-tag "Foreground Color"
  2338. :tag "Foreground Color"
  2339. (number :tag "Gray Scale" :value 0.0)
  2340. (string :tag "Color Name" :value "black")
  2341. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2342. (number :tag "Red")
  2343. (number :tag "Green")
  2344. (number :tag "Blue"))))
  2345. (cons :tag "Background Color" :format "%v"
  2346. (const :format "" back-color)
  2347. (choice :menu-tag "Background Color"
  2348. :tag "Background Color"
  2349. (number :tag "Gray Scale" :value 0.9)
  2350. (string :tag "Color Name" :value "gray90")
  2351. (list :tag "RGB Color" :value (0.9 0.9 0.9)
  2352. (number :tag "Red")
  2353. (number :tag "Green")
  2354. (number :tag "Blue"))))
  2355. (cons :tag "Border Width" :format "%v"
  2356. (const :format "" border-width)
  2357. (number :tag "Border Width" :value 0.4))
  2358. (cons :tag "Border Color" :format "%v"
  2359. (const :format "" border-color)
  2360. (choice :menu-tag "Border Color"
  2361. :tag "Border Color"
  2362. (number :tag "Gray Scale" :value 0.0)
  2363. (string :tag "Color Name" :value "black")
  2364. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2365. (number :tag "Red")
  2366. (number :tag "Green")
  2367. (number :tag "Blue"))))
  2368. (cons :tag "Shadow Color" :format "%v"
  2369. (const :format "" shadow-color)
  2370. (choice :menu-tag "Shadow Color"
  2371. :tag "Shadow Color"
  2372. (number :tag "Gray Scale" :value 0.0)
  2373. (string :tag "Color Name" :value "black")
  2374. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2375. (number :tag "Red")
  2376. (number :tag "Green")
  2377. (number :tag "Blue"))))))
  2378. :version "21.1"
  2379. :group 'ps-print-headers)
  2380. (defcustom ps-footer-lines 2
  2381. "Number of lines to display in page footer, when generating PostScript."
  2382. :type 'integer
  2383. :version "21.1"
  2384. :group 'ps-print-headers)
  2385. (defcustom ps-print-only-one-header nil
  2386. "Non-nil means print only one header/footer at the top/bottom of each page.
  2387. This is useful when printing more than one column, so it is possible to have
  2388. only one header/footer over all columns or one header/footer per column.
  2389. See also `ps-print-header' and `ps-print-footer'."
  2390. :type 'boolean
  2391. :version "20"
  2392. :group 'ps-print-headers)
  2393. (defcustom ps-switch-header 'duplex
  2394. "Specify if headers/footers are switched or not.
  2395. Valid values are:
  2396. nil Never switch headers/footers.
  2397. t Always switch headers/footers.
  2398. duplex Switch headers/footers only when duplexing is on, that is, when
  2399. `ps-spool-duplex' is non-nil.
  2400. Any other value is treated as t.
  2401. See also `ps-print-header' and `ps-print-footer'."
  2402. :type '(choice :menu-tag "Switch Header/Footer"
  2403. :tag "Switch Header/Footer"
  2404. (const :tag "Never Switch" nil)
  2405. (const :tag "Always Switch" t)
  2406. (const :tag "Switch When Duplexing" duplex))
  2407. :version "20"
  2408. :group 'ps-print-headers)
  2409. (defcustom ps-show-n-of-n t
  2410. "Non-nil means show page numbers as N/M, meaning page N of M.
  2411. NOTE: page numbers are displayed as part of headers,
  2412. see variable `ps-print-header'."
  2413. :type 'boolean
  2414. :version "20"
  2415. :group 'ps-print-headers)
  2416. (defcustom ps-spool-config
  2417. (if ps-windows-system
  2418. nil
  2419. 'lpr-switches)
  2420. "Specify who is responsible for setting duplex and page size.
  2421. Valid values are:
  2422. `lpr-switches' duplex and page size are configured by `ps-lpr-switches'.
  2423. Don't forget to set `ps-lpr-switches' to select duplex
  2424. printing for your printer.
  2425. `setpagedevice' duplex and page size are configured by ps-print using the
  2426. setpagedevice PostScript operator.
  2427. nil duplex and page size are configured by ps-print *not* using
  2428. the setpagedevice PostScript operator.
  2429. Any other value is treated as nil.
  2430. WARNING: The setpagedevice PostScript operator affects ghostview utility when
  2431. viewing file generated using landscape. Also on some printers,
  2432. setpagedevice affects zebra stripes; on other printers, setpagedevice
  2433. affects the left margin.
  2434. Besides all that, if your printer does not have the paper size
  2435. specified by setpagedevice, your printing will be aborted.
  2436. So, if you need to use setpagedevice, set `ps-spool-config' to
  2437. `setpagedevice', generate a test file and send it to your printer; if
  2438. the printed file isn't OK, set `ps-spool-config' to nil."
  2439. :type '(choice :menu-tag "Spool Config"
  2440. :tag "Spool Config"
  2441. (const lpr-switches) (const setpagedevice)
  2442. (const :tag "nil" nil))
  2443. :version "20"
  2444. :group 'ps-print-headers)
  2445. (defcustom ps-spool-duplex nil ; Not many people have duplex printers,
  2446. ; so default to nil.
  2447. "Non-nil generates PostScript for a two-sided printer.
  2448. For a duplex printer, the `ps-spool-*' and `ps-print-*' commands will insert
  2449. blank pages as needed between print jobs so that the next buffer printed will
  2450. start on the right page. Also, if headers are turned on, the headers will be
  2451. reversed on duplex printers so that the page numbers fall to the left on
  2452. even-numbered pages.
  2453. See also `ps-spool-tumble'."
  2454. :type 'boolean
  2455. :version "20"
  2456. :group 'ps-print-headers)
  2457. (defcustom ps-spool-tumble nil
  2458. "Specify how the page images on opposite sides of a sheet are oriented.
  2459. If `ps-spool-tumble' is nil, produces output suitable for binding on the left
  2460. or right. If `ps-spool-tumble' is non-nil, produces output suitable for
  2461. binding at the top or bottom.
  2462. It has effect only when `ps-spool-duplex' is non-nil."
  2463. :type 'boolean
  2464. :version "20"
  2465. :group 'ps-print-headers)
  2466. ;;; Fonts
  2467. (defcustom ps-font-info-database
  2468. '((Courier ; the family key
  2469. (fonts (normal . "Courier")
  2470. (bold . "Courier-Bold")
  2471. (italic . "Courier-Oblique")
  2472. (bold-italic . "Courier-BoldOblique"))
  2473. (size . 10.0)
  2474. (line-height . 10.55)
  2475. (space-width . 6.0)
  2476. (avg-char-width . 6.0))
  2477. (Helvetica ; the family key
  2478. (fonts (normal . "Helvetica")
  2479. (bold . "Helvetica-Bold")
  2480. (italic . "Helvetica-Oblique")
  2481. (bold-italic . "Helvetica-BoldOblique"))
  2482. (size . 10.0)
  2483. (line-height . 11.56)
  2484. (space-width . 2.78)
  2485. (avg-char-width . 5.09243))
  2486. (Times
  2487. (fonts (normal . "Times-Roman")
  2488. (bold . "Times-Bold")
  2489. (italic . "Times-Italic")
  2490. (bold-italic . "Times-BoldItalic"))
  2491. (size . 10.0)
  2492. (line-height . 11.0)
  2493. (space-width . 2.5)
  2494. (avg-char-width . 4.71432))
  2495. (Palatino
  2496. (fonts (normal . "Palatino-Roman")
  2497. (bold . "Palatino-Bold")
  2498. (italic . "Palatino-Italic")
  2499. (bold-italic . "Palatino-BoldItalic"))
  2500. (size . 10.0)
  2501. (line-height . 12.1)
  2502. (space-width . 2.5)
  2503. (avg-char-width . 5.08676))
  2504. (Helvetica-Narrow
  2505. (fonts (normal . "Helvetica-Narrow")
  2506. (bold . "Helvetica-Narrow-Bold")
  2507. (italic . "Helvetica-Narrow-Oblique")
  2508. (bold-italic . "Helvetica-Narrow-BoldOblique"))
  2509. (size . 10.0)
  2510. (line-height . 11.56)
  2511. (space-width . 2.2796)
  2512. (avg-char-width . 4.17579))
  2513. (NewCenturySchlbk
  2514. (fonts (normal . "NewCenturySchlbk-Roman")
  2515. (bold . "NewCenturySchlbk-Bold")
  2516. (italic . "NewCenturySchlbk-Italic")
  2517. (bold-italic . "NewCenturySchlbk-BoldItalic"))
  2518. (size . 10.0)
  2519. (line-height . 12.15)
  2520. (space-width . 2.78)
  2521. (avg-char-width . 5.31162))
  2522. ;; got no bold for the next ones
  2523. (AvantGarde-Book
  2524. (fonts (normal . "AvantGarde-Book")
  2525. (italic . "AvantGarde-BookOblique"))
  2526. (size . 10.0)
  2527. (line-height . 11.77)
  2528. (space-width . 2.77)
  2529. (avg-char-width . 5.45189))
  2530. (AvantGarde-Demi
  2531. (fonts (normal . "AvantGarde-Demi")
  2532. (italic . "AvantGarde-DemiOblique"))
  2533. (size . 10.0)
  2534. (line-height . 12.72)
  2535. (space-width . 2.8)
  2536. (avg-char-width . 5.51351))
  2537. (Bookman-Demi
  2538. (fonts (normal . "Bookman-Demi")
  2539. (italic . "Bookman-DemiItalic"))
  2540. (size . 10.0)
  2541. (line-height . 11.77)
  2542. (space-width . 3.4)
  2543. (avg-char-width . 6.05946))
  2544. (Bookman-Light
  2545. (fonts (normal . "Bookman-Light")
  2546. (italic . "Bookman-LightItalic"))
  2547. (size . 10.0)
  2548. (line-height . 11.79)
  2549. (space-width . 3.2)
  2550. (avg-char-width . 5.67027))
  2551. ;; got no bold and no italic for the next ones
  2552. (Symbol
  2553. (fonts (normal . "Symbol"))
  2554. (size . 10.0)
  2555. (line-height . 13.03)
  2556. (space-width . 2.5)
  2557. (avg-char-width . 3.24324))
  2558. (Zapf-Dingbats
  2559. (fonts (normal . "Zapf-Dingbats"))
  2560. (size . 10.0)
  2561. (line-height . 9.63)
  2562. (space-width . 2.78)
  2563. (avg-char-width . 2.78))
  2564. (ZapfChancery-MediumItalic
  2565. (fonts (normal . "ZapfChancery-MediumItalic"))
  2566. (size . 10.0)
  2567. (line-height . 11.45)
  2568. (space-width . 2.2)
  2569. (avg-char-width . 4.10811))
  2570. ;; We keep this wrong entry name (but with correct font name) for
  2571. ;; backward compatibility.
  2572. (Zapf-Chancery-MediumItalic
  2573. (fonts (normal . "ZapfChancery-MediumItalic"))
  2574. (size . 10.0)
  2575. (line-height . 11.45)
  2576. (space-width . 2.2)
  2577. (avg-char-width . 4.10811))
  2578. )
  2579. "Font info database.
  2580. Each element comprises: font family (the key), name, bold, italic, bold-italic,
  2581. reference size, line height, space width, average character width.
  2582. To get the info for another specific font (say Helvetica), do the following:
  2583. - create a new buffer
  2584. - generate the PostScript image to a file (C-u M-x ps-print-buffer)
  2585. - open this file and delete the leading `%' (which is the PostScript comment
  2586. character) from the line
  2587. `% 3 cm 20 cm moveto 10/Courier ReportFontInfo showpage'
  2588. to get the line
  2589. `3 cm 20 cm moveto 10/Helvetica ReportFontInfo showpage'
  2590. - add the values to `ps-font-info-database'.
  2591. You can get all the fonts of YOUR printer using `ReportAllFontInfo'.
  2592. Note also that ps-print DOESN'T download any font to your printer, instead it
  2593. uses the fonts resident in your printer."
  2594. :type '(repeat
  2595. (list :tag "Font Definition"
  2596. (symbol :tag "Font Family")
  2597. (cons :format "%v"
  2598. (const :format "" fonts)
  2599. (repeat :tag "Faces"
  2600. (cons (choice :menu-tag "Font Weight/Slant"
  2601. :tag "Font Weight/Slant"
  2602. (const normal)
  2603. (const bold)
  2604. (const italic)
  2605. (const bold-italic)
  2606. (symbol :tag "Face"))
  2607. (string :tag "Font Name"))))
  2608. (cons :format "%v"
  2609. (const :format "" size)
  2610. (number :tag "Reference Size"))
  2611. (cons :format "%v"
  2612. (const :format "" line-height)
  2613. (number :tag "Line Height"))
  2614. (cons :format "%v"
  2615. (const :format "" space-width)
  2616. (number :tag "Space Width"))
  2617. (cons :format "%v"
  2618. (const :format "" avg-char-width)
  2619. (number :tag "Average Character Width"))))
  2620. :version "20"
  2621. :group 'ps-print-font)
  2622. (defcustom ps-font-family 'Courier
  2623. "Font family name for ordinary text, when generating PostScript."
  2624. :type 'symbol
  2625. :version "20"
  2626. :group 'ps-print-font)
  2627. (defcustom ps-font-size '(7 . 8.5)
  2628. "Font size, in points, for ordinary text, when generating PostScript.
  2629. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
  2630. :type '(choice :menu-tag "Ordinary Text Font Size"
  2631. :tag "Ordinary Text Font Size"
  2632. (number :tag "Text Size")
  2633. (cons :tag "Landscape/Portrait"
  2634. (number :tag "Landscape Text Size")
  2635. (number :tag "Portrait Text Size")))
  2636. :version "20"
  2637. :group 'ps-print-font)
  2638. (defcustom ps-header-font-family 'Helvetica
  2639. "Font family name for text in the header, when generating PostScript."
  2640. :type 'symbol
  2641. :version "20"
  2642. :group 'ps-print-font)
  2643. (defcustom ps-header-font-size '(10 . 12)
  2644. "Font size, in points, for text in the header, when generating PostScript.
  2645. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
  2646. :type '(choice :menu-tag "Header Font Size"
  2647. :tag "Header Font Size"
  2648. (number :tag "Header Size")
  2649. (cons :tag "Landscape/Portrait"
  2650. (number :tag "Landscape Header Size")
  2651. (number :tag "Portrait Header Size")))
  2652. :version "20"
  2653. :group 'ps-print-font)
  2654. (defcustom ps-header-title-font-size '(12 . 14)
  2655. "Font size, in points, for the top line of text in header, in PostScript.
  2656. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
  2657. :type '(choice :menu-tag "Header Title Font Size"
  2658. :tag "Header Title Font Size"
  2659. (number :tag "Header Title Size")
  2660. (cons :tag "Landscape/Portrait"
  2661. (number :tag "Landscape Header Title Size")
  2662. (number :tag "Portrait Header Title Size")))
  2663. :version "20"
  2664. :group 'ps-print-font)
  2665. (defcustom ps-footer-font-family 'Helvetica
  2666. "Font family name for text in the footer, when generating PostScript."
  2667. :type 'symbol
  2668. :version "21.1"
  2669. :group 'ps-print-font)
  2670. (defcustom ps-footer-font-size '(10 . 12)
  2671. "Font size, in points, for text in the footer, when generating PostScript.
  2672. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
  2673. :type '(choice :menu-tag "Footer Font Size"
  2674. :tag "Footer Font Size"
  2675. (number :tag "Footer Size")
  2676. (cons :tag "Landscape/Portrait"
  2677. (number :tag "Landscape Footer Size")
  2678. (number :tag "Portrait Footer Size")))
  2679. :version "21.1"
  2680. :group 'ps-print-font)
  2681. (defcustom ps-line-number-color "black"
  2682. "Specify color for line-number, when generating PostScript."
  2683. :type '(choice :menu-tag "Line Number Color"
  2684. :tag "Line Number Color"
  2685. (number :tag "Gray Scale" :value 0)
  2686. (string :tag "Color Name" :value "black")
  2687. (list :tag "RGB Color" :value (0 0 0)
  2688. (number :tag "Red")
  2689. (number :tag "Green")
  2690. (number :tag "Blue")))
  2691. :version "21.1"
  2692. :group 'ps-print-font
  2693. :group 'ps-print-miscellany)
  2694. (defcustom ps-line-number-font "Times-Italic"
  2695. "Font for line-number, when generating PostScript."
  2696. :type 'string
  2697. :version "20"
  2698. :group 'ps-print-font
  2699. :group 'ps-print-miscellany)
  2700. (defcustom ps-line-number-font-size 6
  2701. "Font size, in points, for line number, when generating PostScript.
  2702. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE)."
  2703. :type '(choice :menu-tag "Line Number Font Size"
  2704. :tag "Line Number Font Size"
  2705. (number :tag "Font Size")
  2706. (cons :tag "Landscape/Portrait"
  2707. (number :tag "Landscape Font Size")
  2708. (number :tag "Portrait Font Size")))
  2709. :version "20"
  2710. :group 'ps-print-font
  2711. :group 'ps-print-miscellany)
  2712. ;;; Colors
  2713. ;; Printing color requires x-color-values.
  2714. ;; XEmacs change: Need autoload for the "Options->Printing->Color Printing"
  2715. ;; widget to work.
  2716. ;;;###autoload
  2717. (defcustom ps-print-color-p
  2718. (or (fboundp 'x-color-values) ; Emacs
  2719. (fboundp 'color-instance-rgb-components))
  2720. ; XEmacs
  2721. "Specify how buffer's text color is printed.
  2722. Valid values are:
  2723. nil Do not print colors.
  2724. t Print colors.
  2725. black-white Print colors on black/white printer.
  2726. See also `ps-black-white-faces'.
  2727. Any other value is treated as t."
  2728. :type '(choice :menu-tag "Print Color"
  2729. :tag "Print Color"
  2730. (const :tag "Do NOT Print Color" nil)
  2731. (const :tag "Print Always Color" t)
  2732. (const :tag "Print Black/White Color" black-white))
  2733. :version "20"
  2734. :group 'ps-print-color)
  2735. (defcustom ps-default-fg nil
  2736. "RGB values of the default foreground color.
  2737. The `ps-default-fg' variable contains the default foreground color used by
  2738. ps-print, that is, if there is a face in a text that doesn't have a foreground
  2739. color, the `ps-default-fg' color should be used.
  2740. Valid values are:
  2741. t The foreground color of Emacs session will be used.
  2742. frame-parameter The foreground-color frame parameter will be used.
  2743. NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
  2744. indicate the gray color.
  2745. COLOR-NAME It's a string which contains the color name. For example:
  2746. \"yellow\".
  2747. LIST It's a list of RGB values, that is a list of three real values
  2748. of the form:
  2749. (RED GREEN BLUE)
  2750. Where RED, GREEN and BLUE are reals between 0.0 (no color) and
  2751. 1.0 (full color).
  2752. Any other value is ignored and black color will be used.
  2753. This variable is used only when `ps-print-color-p' (which see) is neither nil
  2754. nor black-white."
  2755. :type '(choice :menu-tag "Default Foreground Gray/Color"
  2756. :tag "Default Foreground Gray/Color"
  2757. (const :tag "Session Foreground" t)
  2758. (const :tag "Frame Foreground" frame-parameter)
  2759. (number :tag "Gray Scale" :value 0.0)
  2760. (string :tag "Color Name" :value "black")
  2761. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2762. (number :tag "Red")
  2763. (number :tag "Green")
  2764. (number :tag "Blue")))
  2765. :version "20"
  2766. :group 'ps-print-color)
  2767. (defcustom ps-default-bg nil
  2768. "RGB values of the default background color.
  2769. The `ps-default-bg' variable contains the default background color used by
  2770. ps-print, that is, if there is a face in a text that doesn't have a background
  2771. color, the `ps-default-bg' color should be used.
  2772. Valid values are:
  2773. t The background color of Emacs session will be used.
  2774. frame-parameter The background-color frame parameter will be used.
  2775. NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
  2776. indicate the gray color.
  2777. COLOR-NAME It's a string which contains the color name. For example:
  2778. \"yellow\".
  2779. LIST It's a list of RGB values, that is a list of three real values
  2780. of the form:
  2781. (RED GREEN BLUE)
  2782. Where RED, GREEN and BLUE are reals between 0.0 (no color) and
  2783. 1.0 (full color).
  2784. Any other value is ignored and white color will be used.
  2785. This variable is used only when `ps-print-color-p' (which see) is neither nil
  2786. nor black-white.
  2787. See also `ps-use-face-background'."
  2788. :type '(choice :menu-tag "Default Background Gray/Color"
  2789. :tag "Default Background Gray/Color"
  2790. (const :tag "Session Background" t)
  2791. (const :tag "Frame Background" frame-parameter)
  2792. (number :tag "Gray Scale" :value 1.0)
  2793. (string :tag "Color Name" :value "white")
  2794. (list :tag "RGB Color" :value (1.0 1.0 1.0)
  2795. (number :tag "Red")
  2796. (number :tag "Green")
  2797. (number :tag "Blue")))
  2798. :version "20"
  2799. :group 'ps-print-color)
  2800. (defcustom ps-fg-list nil
  2801. "Specify foreground color list.
  2802. This list is used to chose a text foreground color which is different than the
  2803. background color. It'll be used the first foreground color in `ps-fg-list'
  2804. which is different from the background color.
  2805. If this list is nil, the default foreground color is used. See
  2806. `ps-default-fg'.
  2807. The list element valid values are:
  2808. NUMBER It's a real value between 0.0 (black) and 1.0 (white) that
  2809. indicate the gray color.
  2810. COLOR-NAME It's a string which contains the color name. For example:
  2811. \"yellow\".
  2812. LIST It's a list of RGB values, that is a list of three real values
  2813. of the form:
  2814. (RED GREEN BLUE)
  2815. Where RED, GREEN and BLUE are reals between 0.0 (no color) and
  2816. 1.0 (full color).
  2817. Any other value is ignored and black color will be used.
  2818. This variable is used only when `ps-fg-validate-p' (which see) is non-nil and
  2819. when `ps-print-color-p' (which see) is neither nil nor black-white."
  2820. :type '(repeat
  2821. (choice :menu-tag "Foreground Gray/Color"
  2822. :tag "Foreground Gray/Color"
  2823. (number :tag "Gray Scale" :value 0.0)
  2824. (string :tag "Color Name" :value "black")
  2825. (list :tag "RGB Color" :value (0.0 0.0 0.0)
  2826. (number :tag "Red")
  2827. (number :tag "Green")
  2828. (number :tag "Blue"))))
  2829. :version "22"
  2830. :group 'ps-print-color)
  2831. (defcustom ps-fg-validate-p t
  2832. "Non-nil means validate if foreground color is different than background.
  2833. If text foreground and background colors are equals, no text will appear.
  2834. See also `ps-fg-list'."
  2835. :type 'boolean
  2836. :version "22"
  2837. :group 'ps-print-color)
  2838. (defcustom ps-auto-font-detect t
  2839. "Non-nil means automatically detect bold/italic/underline face attributes.
  2840. If nil, we rely solely on the lists `ps-bold-faces', `ps-italic-faces', and
  2841. `ps-underlined-faces'."
  2842. :type 'boolean
  2843. :version "20"
  2844. :group 'ps-print-font)
  2845. (defcustom ps-black-white-faces
  2846. '((font-lock-builtin-face "black" nil bold )
  2847. (font-lock-comment-face "gray20" nil italic)
  2848. (font-lock-constant-face "black" nil bold )
  2849. (font-lock-function-name-face "black" nil bold )
  2850. (font-lock-keyword-face "black" nil bold )
  2851. (font-lock-string-face "black" nil italic)
  2852. (font-lock-type-face "black" nil italic)
  2853. (font-lock-variable-name-face "black" nil bold italic)
  2854. (font-lock-warning-face "black" nil bold italic))
  2855. "Specify list of face attributes to print colors on black/white printers.
  2856. The list elements are the same as defined on `ps-extend-face' (which see).
  2857. This variable is used only when `ps-print-color-p' is set to `black-white'."
  2858. :version "21.1"
  2859. :type '(repeat
  2860. (list :tag "Face Specification"
  2861. (face :tag "Face Symbol")
  2862. (choice :menu-tag "Foreground Color"
  2863. :tag "Foreground Color"
  2864. (const :tag "Black" nil)
  2865. (string :tag "Color Name"))
  2866. (choice :menu-tag "Background Color"
  2867. :tag "Background Color"
  2868. (const :tag "None" nil)
  2869. (string :tag "Color Name"))
  2870. (repeat :inline t
  2871. (choice :menu-tag "Attribute"
  2872. (const bold)
  2873. (const italic)
  2874. (const underline)
  2875. (const strikeout)
  2876. (const overline)
  2877. (const shadow)
  2878. (const box)
  2879. (const outline)))))
  2880. :version "20"
  2881. :group 'ps-print-face)
  2882. (defcustom ps-bold-faces
  2883. (unless ps-print-color-p
  2884. '(font-lock-function-name-face
  2885. font-lock-builtin-face
  2886. font-lock-variable-name-face
  2887. font-lock-keyword-face
  2888. font-lock-warning-face))
  2889. "A list of the \(non-bold\) faces that should be printed in bold font.
  2890. This applies to generating PostScript."
  2891. :type '(repeat face)
  2892. :version "20"
  2893. :group 'ps-print-face)
  2894. (defcustom ps-italic-faces
  2895. (unless ps-print-color-p
  2896. '(font-lock-variable-name-face
  2897. font-lock-type-face
  2898. font-lock-string-face
  2899. font-lock-comment-face
  2900. font-lock-warning-face))
  2901. "A list of the \(non-italic\) faces that should be printed in italic font.
  2902. This applies to generating PostScript."
  2903. :type '(repeat face)
  2904. :version "20"
  2905. :group 'ps-print-face)
  2906. (defcustom ps-underlined-faces
  2907. (unless ps-print-color-p
  2908. '(font-lock-function-name-face
  2909. font-lock-constant-face
  2910. font-lock-warning-face))
  2911. "A list of the \(non-underlined\) faces that should be printed underlined.
  2912. This applies to generating PostScript."
  2913. :type '(repeat face)
  2914. :version "20"
  2915. :group 'ps-print-face)
  2916. (defcustom ps-use-face-background nil
  2917. "Specify if face background should be used.
  2918. Valid values are:
  2919. t always use face background color.
  2920. nil never use face background color.
  2921. (face...) list of faces whose background color will be used.
  2922. Any other value will be treated as t."
  2923. :type '(choice :menu-tag "Use Face Background"
  2924. :tag "Use Face Background"
  2925. (const :tag "Always Use Face Background" t)
  2926. (const :tag "Never Use Face Background" nil)
  2927. (repeat :menu-tag "Face Background List"
  2928. :tag "Face Background List"
  2929. face))
  2930. :version "20"
  2931. :group 'ps-print-face)
  2932. (defcustom ps-left-header
  2933. (list 'ps-get-buffer-name 'ps-header-dirpart)
  2934. "The items to display (each on a line) on the left part of the page header.
  2935. This applies to generating PostScript.
  2936. The value should be a list of strings and symbols, each representing an entry
  2937. in the PostScript array HeaderLinesLeft.
  2938. Strings are inserted unchanged into the array; those representing
  2939. PostScript string literals should be delimited with PostScript string
  2940. delimiters '(' and ')'.
  2941. For symbols with bound functions, the function is called and should return a
  2942. string to be inserted into the array. For symbols with bound values, the value
  2943. should be a string to be inserted into the array. In either case, function or
  2944. variable, the string value has PostScript string delimiters added to it.
  2945. If symbols are unbounded, they are silently ignored."
  2946. :type '(repeat (choice :menu-tag "Left Header"
  2947. :tag "Left Header"
  2948. string symbol))
  2949. :version "20"
  2950. :group 'ps-print-headers)
  2951. (defcustom ps-right-header
  2952. (list "/pagenumberstring load"
  2953. 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
  2954. "The items to display (each on a line) on the right part of the page header.
  2955. This applies to generating PostScript.
  2956. See the variable `ps-left-header' for a description of the format of this
  2957. variable.
  2958. There are the following basic functions implemented:
  2959. `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
  2960. as, for example, \"06/18/01\".
  2961. `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
  2962. `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
  2963. `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
  2964. date).
  2965. `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
  2966. You can also create your own time stamp function by using `format-time-string'
  2967. \(which see)."
  2968. :type '(repeat (choice :menu-tag "Right Header"
  2969. :tag "Right Header"
  2970. string symbol))
  2971. :version "20"
  2972. :group 'ps-print-headers)
  2973. (defcustom ps-left-footer
  2974. (list 'ps-get-buffer-name 'ps-header-dirpart)
  2975. "The items to display (each on a line) on the left part of the page footer.
  2976. This applies to generating PostScript.
  2977. The value should be a list of strings and symbols, each representing an entry
  2978. in the PostScript array FooterLinesLeft.
  2979. Strings are inserted unchanged into the array; those representing PostScript
  2980. string literals should be delimited with PostScript string delimiters '(' and
  2981. ')'.
  2982. For symbols with bound functions, the function is called and should return a
  2983. string to be inserted into the array. For symbols with bound values, the value
  2984. should be a string to be inserted into the array. In either case, function or
  2985. variable, the string value has PostScript string delimiters added to it.
  2986. If symbols are unbounded, they are silently ignored."
  2987. :type '(repeat (choice :menu-tag "Left Footer"
  2988. :tag "Left Footer"
  2989. string symbol))
  2990. :version "21.1"
  2991. :group 'ps-print-headers)
  2992. (defcustom ps-right-footer
  2993. (list "/pagenumberstring load"
  2994. 'ps-time-stamp-locale-default 'ps-time-stamp-hh:mm:ss)
  2995. "The items to display (each on a line) on the right part of the page footer.
  2996. This applies to generating PostScript.
  2997. See the variable `ps-left-footer' for a description of the format of this
  2998. variable.
  2999. There are the following basic functions implemented:
  3000. `ps-time-stamp-locale-default' Return the locale's \"preferred\" date
  3001. as, for example, \"06/18/01\".
  3002. `ps-time-stamp-hh:mm:ss' Return time as \"17:28:31\".
  3003. `ps-time-stamp-mon-dd-yyyy' Return date as \"Jun 18 2001\".
  3004. `ps-time-stamp-yyyy-mm-dd' Return date as \"2001-06-18\" (ISO
  3005. date).
  3006. `ps-time-stamp-iso8601' Alias for `ps-time-stamp-yyyy-mm-dd'.
  3007. You can also create your own time stamp function by using `format-time-string'
  3008. \(which see)."
  3009. :type '(repeat (choice :menu-tag "Right Footer"
  3010. :tag "Right Footer"
  3011. string symbol))
  3012. :version "21.1"
  3013. :group 'ps-print-headers)
  3014. (defcustom ps-razzle-dazzle t
  3015. "Non-nil means report progress while formatting buffer."
  3016. :type 'boolean
  3017. :version "20"
  3018. :group 'ps-print-miscellany)
  3019. (defcustom ps-adobe-tag "%!PS-Adobe-3.0\n"
  3020. "Contains the header line identifying the output as PostScript.
  3021. By default, `ps-adobe-tag' contains the standard identifier. Some printers
  3022. require slightly different versions of this line."
  3023. :type 'string
  3024. :version "20"
  3025. :group 'ps-print-miscellany)
  3026. (defcustom ps-build-face-reference t
  3027. "Non-nil means build the reference face lists.
  3028. ps-print sets this value to nil after it builds its internal reference lists of
  3029. bold and italic faces. By setting its value back to t, you can force ps-print
  3030. to rebuild the lists the next time you invoke one of the ...-with-faces
  3031. commands.
  3032. You should set this value back to t after you change the attributes of any
  3033. face, or create new faces. Most users shouldn't have to worry about its
  3034. setting, though."
  3035. :type 'boolean
  3036. :version "20"
  3037. :group 'ps-print-face)
  3038. (defcustom ps-always-build-face-reference nil
  3039. "Non-nil means always rebuild the reference face lists.
  3040. If this variable is non-nil, ps-print will rebuild its internal reference lists
  3041. of bold and italic faces *every* time one of the ...-with-faces commands is
  3042. called. Most users shouldn't need to set this variable."
  3043. :type 'boolean
  3044. :version "20"
  3045. :group 'ps-print-face)
  3046. (defcustom ps-banner-page-when-duplexing nil
  3047. "Non-nil means the very first page is skipped.
  3048. It's like the very first character of buffer (or region) is ^L (\\014)."
  3049. :type 'boolean
  3050. :version "20"
  3051. :group 'ps-print-headers)
  3052. (defcustom ps-postscript-code-directory
  3053. (or (if (featurep 'xemacs)
  3054. (cond ((fboundp 'locate-data-directory) ; XEmacs
  3055. (funcall 'locate-data-directory "ps-print"))
  3056. ((boundp 'data-directory) ; XEmacs
  3057. (symbol-value 'data-directory))
  3058. (t ; don't know what to do
  3059. nil))
  3060. data-directory) ; Emacs
  3061. (error "`ps-postscript-code-directory' isn't set properly"))
  3062. "Directory where it's located the PostScript prologue file used by ps-print.
  3063. By default, this directory is the same as in the variable `data-directory'."
  3064. :type 'directory
  3065. :version "20"
  3066. :group 'ps-print-miscellany)
  3067. (defcustom ps-line-spacing 0
  3068. "Specify line spacing, in points, for ordinary text.
  3069. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
  3070. See also `ps-paragraph-spacing' and `ps-paragraph-regexp'.
  3071. To get all lines with some spacing set both `ps-line-spacing' and
  3072. `ps-paragraph-spacing' variables."
  3073. :type '(choice :menu-tag "Line Spacing For Ordinary Text"
  3074. :tag "Line Spacing For Ordinary Text"
  3075. (number :tag "Line Spacing")
  3076. (cons :tag "Landscape/Portrait"
  3077. (number :tag "Landscape Line Spacing")
  3078. (number :tag "Portrait Line Spacing")))
  3079. :version "21.1"
  3080. :group 'ps-print-miscellany)
  3081. (defcustom ps-paragraph-spacing 0
  3082. "Specify paragraph spacing, in points, for ordinary text.
  3083. Either a float or a cons of floats (LANDSCAPE-SIZE . PORTRAIT-SIZE).
  3084. See also `ps-line-spacing' and `ps-paragraph-regexp'.
  3085. To get all lines with some spacing set both `ps-line-spacing' and
  3086. `ps-paragraph-spacing' variables."
  3087. :type '(choice :menu-tag "Paragraph Spacing For Ordinary Text"
  3088. :tag "Paragraph Spacing For Ordinary Text"
  3089. (number :tag "Paragraph Spacing")
  3090. (cons :tag "Landscape/Portrait"
  3091. (number :tag "Landscape Paragraph Spacing")
  3092. (number :tag "Portrait Paragraph Spacing")))
  3093. :version "21.1"
  3094. :group 'ps-print-miscellany)
  3095. (defcustom ps-paragraph-regexp "[ \t]*$"
  3096. "Specify paragraph delimiter.
  3097. It should be a regexp or nil.
  3098. See also `ps-paragraph-spacing'."
  3099. :type '(choice :menu-tag "Paragraph Delimiter"
  3100. (const :tag "No Delimiter" nil)
  3101. (regexp :tag "Delimiter Regexp"))
  3102. :version "21.1"
  3103. :group 'ps-print-miscellany)
  3104. (defcustom ps-begin-cut-regexp nil
  3105. "Specify regexp which is start of a region to cut out when printing.
  3106. As an example, variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' may be
  3107. set to \"^Local Variables:\" and \"^End:\", respectively, in order to leave out
  3108. some special printing instructions from the actual print. Special printing
  3109. instructions may be appended to the end of the file just like any other
  3110. buffer-local variables. See section \"Local Variables in Files\" on Emacs
  3111. manual for more information.
  3112. Variables `ps-begin-cut-regexp' and `ps-end-cut-regexp' control together what
  3113. actually gets printed. Both variables may be set to nil in which case no
  3114. cutting occurs."
  3115. :type '(choice (const :tag "No Delimiter" nil)
  3116. (regexp :tag "Delimiter Regexp"))
  3117. :version "21.1"
  3118. :group 'ps-print-miscellany)
  3119. (defcustom ps-end-cut-regexp nil
  3120. "Specify regexp which is end of the region to cut out when printing.
  3121. See `ps-begin-cut-regexp' for more information."
  3122. :type '(choice (const :tag "No Delimiter" nil)
  3123. (regexp :tag "Delimiter Regexp"))
  3124. :version "21.1"
  3125. :group 'ps-print-miscellany)
  3126. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3127. ;; Selected Pages
  3128. (defvar ps-last-selected-pages nil
  3129. "Latest `ps-selected-pages' value.")
  3130. (defun ps-restore-selected-pages ()
  3131. "Restore latest `ps-selected-pages' value."
  3132. (interactive)
  3133. (setq ps-selected-pages ps-last-selected-pages))
  3134. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3135. ;; Customization
  3136. ;;;###autoload
  3137. (defun ps-print-customize ()
  3138. "Customization of ps-print group."
  3139. (interactive)
  3140. (customize-group 'ps-print))
  3141. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3142. ;; User commands
  3143. ;;;###autoload
  3144. (defun ps-print-buffer (&optional filename)
  3145. "Generate and print a PostScript image of the buffer.
  3146. Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
  3147. user for a file name, and saves the PostScript image in that file instead of
  3148. sending it to the printer.
  3149. Noninteractively, the argument FILENAME is treated as follows: if it is nil,
  3150. send the image to the printer. If FILENAME is a string, save the PostScript
  3151. image in a file with that name."
  3152. (interactive (list (ps-print-preprint current-prefix-arg)))
  3153. (ps-print-without-faces (point-min) (point-max) filename))
  3154. ;;;###autoload
  3155. (defun ps-print-buffer-with-faces (&optional filename)
  3156. "Generate and print a PostScript image of the buffer.
  3157. Like `ps-print-buffer', but includes font, color, and underline information in
  3158. the generated image. This command works only if you are using a window system,
  3159. so it has a way to determine color values."
  3160. (interactive (list (ps-print-preprint current-prefix-arg)))
  3161. (ps-print-with-faces (point-min) (point-max) filename))
  3162. ;;;###autoload
  3163. (defun ps-print-region (from to &optional filename)
  3164. "Generate and print a PostScript image of the region.
  3165. Like `ps-print-buffer', but prints just the current region."
  3166. (interactive (ps-print-preprint-region current-prefix-arg))
  3167. (ps-print-without-faces from to filename t))
  3168. ;;;###autoload
  3169. (defun ps-print-region-with-faces (from to &optional filename)
  3170. "Generate and print a PostScript image of the region.
  3171. Like `ps-print-region', but includes font, color, and underline information in
  3172. the generated image. This command works only if you are using a window system,
  3173. so it has a way to determine color values."
  3174. (interactive (ps-print-preprint-region current-prefix-arg))
  3175. (ps-print-with-faces from to filename t))
  3176. ;;;###autoload
  3177. (defun ps-spool-buffer ()
  3178. "Generate and spool a PostScript image of the buffer.
  3179. Like `ps-print-buffer' except that the PostScript image is saved in a local
  3180. buffer to be sent to the printer later.
  3181. Use the command `ps-despool' to send the spooled images to the printer."
  3182. (interactive)
  3183. (ps-spool-without-faces (point-min) (point-max)))
  3184. ;;;###autoload
  3185. (defun ps-spool-buffer-with-faces ()
  3186. "Generate and spool a PostScript image of the buffer.
  3187. Like `ps-spool-buffer', but includes font, color, and underline information in
  3188. the generated image. This command works only if you are using a window system,
  3189. so it has a way to determine color values.
  3190. Use the command `ps-despool' to send the spooled images to the printer."
  3191. (interactive)
  3192. (ps-spool-with-faces (point-min) (point-max)))
  3193. ;;;###autoload
  3194. (defun ps-spool-region (from to)
  3195. "Generate a PostScript image of the region and spool locally.
  3196. Like `ps-spool-buffer', but spools just the current region.
  3197. Use the command `ps-despool' to send the spooled images to the printer."
  3198. (interactive "r")
  3199. (ps-spool-without-faces from to t))
  3200. ;;;###autoload
  3201. (defun ps-spool-region-with-faces (from to)
  3202. "Generate a PostScript image of the region and spool locally.
  3203. Like `ps-spool-region', but includes font, color, and underline information in
  3204. the generated image. This command works only if you are using a window system,
  3205. so it has a way to determine color values.
  3206. Use the command `ps-despool' to send the spooled images to the printer."
  3207. (interactive "r")
  3208. (ps-spool-with-faces from to t))
  3209. ;;;###autoload
  3210. (defun ps-despool (&optional filename)
  3211. "Send the spooled PostScript to the printer.
  3212. Interactively, when you use a prefix argument (\\[universal-argument]), the command prompts the
  3213. user for a file name, and saves the spooled PostScript image in that file
  3214. instead of sending it to the printer.
  3215. Noninteractively, the argument FILENAME is treated as follows: if it is nil,
  3216. send the image to the printer. If FILENAME is a string, save the PostScript
  3217. image in a file with that name."
  3218. (interactive (list (ps-print-preprint current-prefix-arg)))
  3219. (ps-do-despool filename))
  3220. ;;;###autoload
  3221. (defun ps-line-lengths ()
  3222. "Display the correspondence between a line length and a font size.
  3223. Done using the current ps-print setup.
  3224. Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
  3225. (interactive)
  3226. (ps-line-lengths-internal))
  3227. ;;;###autoload
  3228. (defun ps-nb-pages-buffer (nb-lines)
  3229. "Display number of pages to print this buffer, for various font heights.
  3230. The table depends on the current ps-print setup."
  3231. (interactive (ps-count-lines-preprint (point-min) (point-max)))
  3232. (ps-nb-pages nb-lines))
  3233. ;;;###autoload
  3234. (defun ps-nb-pages-region (nb-lines)
  3235. "Display number of pages to print the region, for various font heights.
  3236. The table depends on the current ps-print setup."
  3237. (interactive (ps-count-lines-preprint (mark) (point)))
  3238. (ps-nb-pages nb-lines))
  3239. (defvar ps-prefix-quote nil
  3240. "Used for `ps-print-quote' (which see).")
  3241. ;;;###autoload
  3242. (defun ps-setup ()
  3243. "Return the current PostScript-generation setup."
  3244. (let (ps-prefix-quote)
  3245. (mapconcat
  3246. #'ps-print-quote
  3247. (list
  3248. (concat "\n;;; (" (if (featurep 'xemacs) "XEmacs" "Emacs")
  3249. ") ps-print version " ps-print-version "\n")
  3250. ";; internal vars"
  3251. (ps-comment-string "emacs-version " emacs-version)
  3252. (ps-comment-string "ps-windows-system " ps-windows-system)
  3253. (ps-comment-string "ps-lp-system " ps-lp-system)
  3254. nil
  3255. '(25 . ps-print-color-p)
  3256. '(25 . ps-lpr-command)
  3257. '(25 . ps-lpr-switches)
  3258. '(25 . ps-printer-name)
  3259. '(25 . ps-printer-name-option)
  3260. '(25 . ps-print-region-function)
  3261. '(25 . ps-manual-feed)
  3262. '(25 . ps-end-with-control-d)
  3263. nil
  3264. '(23 . ps-paper-type)
  3265. '(23 . ps-warn-paper-type)
  3266. '(23 . ps-landscape-mode)
  3267. '(23 . ps-print-upside-down)
  3268. '(23 . ps-number-of-columns)
  3269. nil
  3270. '(23 . ps-zebra-stripes)
  3271. '(23 . ps-zebra-stripe-height)
  3272. '(23 . ps-zebra-stripe-follow)
  3273. '(23 . ps-zebra-color)
  3274. '(23 . ps-line-number)
  3275. '(23 . ps-line-number-step)
  3276. '(23 . ps-line-number-start)
  3277. nil
  3278. '(17 . ps-razzle-dazzle)
  3279. '(17 . ps-default-bg)
  3280. '(17 . ps-default-fg)
  3281. '(17 . ps-fg-validate-p)
  3282. '(17 . ps-fg-list)
  3283. nil
  3284. '(23 . ps-use-face-background)
  3285. nil
  3286. '(28 . ps-print-control-characters)
  3287. nil
  3288. '(26 . ps-print-background-image)
  3289. nil
  3290. '(25 . ps-print-background-text)
  3291. nil
  3292. '(29 . ps-error-handler-message)
  3293. '(29 . ps-user-defined-prologue)
  3294. '(29 . ps-print-prologue-header)
  3295. '(29 . ps-postscript-code-directory)
  3296. '(29 . ps-adobe-tag)
  3297. nil
  3298. '(30 . ps-left-margin)
  3299. '(30 . ps-right-margin)
  3300. '(30 . ps-inter-column)
  3301. '(30 . ps-bottom-margin)
  3302. '(30 . ps-top-margin)
  3303. '(30 . ps-print-only-one-header)
  3304. '(30 . ps-switch-header)
  3305. '(30 . ps-print-header)
  3306. '(30 . ps-header-lines)
  3307. '(30 . ps-header-offset)
  3308. '(30 . ps-header-line-pad)
  3309. '(30 . ps-print-header-frame)
  3310. '(30 . ps-header-frame-alist)
  3311. '(30 . ps-print-footer)
  3312. '(30 . ps-footer-lines)
  3313. '(30 . ps-footer-offset)
  3314. '(30 . ps-footer-line-pad)
  3315. '(30 . ps-print-footer-frame)
  3316. '(30 . ps-footer-frame-alist)
  3317. '(30 . ps-show-n-of-n)
  3318. '(30 . ps-spool-config)
  3319. '(30 . ps-spool-duplex)
  3320. '(30 . ps-spool-tumble)
  3321. '(30 . ps-banner-page-when-duplexing)
  3322. '(30 . ps-left-header)
  3323. '(30 . ps-right-header)
  3324. '(30 . ps-left-footer)
  3325. '(30 . ps-right-footer)
  3326. nil
  3327. '(23 . ps-n-up-printing)
  3328. '(23 . ps-n-up-margin)
  3329. '(23 . ps-n-up-border-p)
  3330. '(23 . ps-n-up-filling)
  3331. nil
  3332. '(26 . ps-multibyte-buffer)
  3333. '(26 . ps-font-family)
  3334. '(26 . ps-font-size)
  3335. '(26 . ps-header-font-family)
  3336. '(26 . ps-header-font-size)
  3337. '(26 . ps-header-title-font-size)
  3338. '(26 . ps-footer-font-family)
  3339. '(26 . ps-footer-font-size)
  3340. '(26 . ps-line-number-color)
  3341. '(26 . ps-line-number-font)
  3342. '(26 . ps-line-number-font-size)
  3343. '(26 . ps-line-spacing)
  3344. '(26 . ps-paragraph-spacing)
  3345. '(26 . ps-paragraph-regexp)
  3346. '(26 . ps-begin-cut-regexp)
  3347. '(26 . ps-end-cut-regexp)
  3348. nil
  3349. '(23 . ps-even-or-odd-pages)
  3350. '(23 . ps-selected-pages)
  3351. '(23 . ps-last-selected-pages)
  3352. nil
  3353. '(31 . ps-build-face-reference)
  3354. '(31 . ps-always-build-face-reference)
  3355. nil
  3356. '(20 . ps-auto-font-detect)
  3357. '(20 . ps-bold-faces)
  3358. '(20 . ps-italic-faces)
  3359. '(20 . ps-underlined-faces)
  3360. '(20 . ps-black-white-faces)
  3361. " )\n
  3362. \;; The following customized variables have long lists and are seldom modified:
  3363. \;; ps-page-dimensions-database
  3364. \;; ps-font-info-database
  3365. \;;; ps-print - end of settings\n")
  3366. "\n")))
  3367. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3368. ;; Utility functions and variables:
  3369. (defun ps-print-quote (elt)
  3370. "Quote ELT for printing (used for showing settings).
  3371. If ELT is nil, return an empty string.
  3372. If ELT is string, return it.
  3373. Otherwise, ELT should be a cons (LEN . SYM) where SYM is a variable symbol and
  3374. LEN is the field length where SYM name will be inserted. The variable
  3375. `ps-prefix-quote' is used to form the string, if `ps-prefix-quote' is nil, it's
  3376. used \"(setq \" as prefix; otherwise, it's used \" \". So, the string
  3377. generated is:
  3378. * If `ps-prefix-quote' is nil:
  3379. \"(setq SYM-NAME SYM-VALUE\"
  3380. |<------->|
  3381. LEN
  3382. * If `ps-prefix-quote' is non-nil:
  3383. \" SYM-NAME SYM-VALUE\"
  3384. |<------->|
  3385. LEN
  3386. If `ps-prefix-quote' is nil, it's set to t after generating string."
  3387. (cond
  3388. ((stringp elt) elt)
  3389. ((and (consp elt) (integerp (car elt))
  3390. (symbolp (cdr elt)) (boundp (cdr elt)))
  3391. (let* ((col (car elt))
  3392. (sym (cdr elt))
  3393. (key (symbol-name sym))
  3394. (len (length key))
  3395. (val (symbol-value sym)))
  3396. (concat (if ps-prefix-quote
  3397. " "
  3398. (setq ps-prefix-quote t)
  3399. "(setq ")
  3400. key
  3401. (if (> col len)
  3402. (make-string (- col len) ?\s)
  3403. " ")
  3404. (ps-value-string val))))
  3405. (t "")
  3406. ))
  3407. (defun ps-value-string (val)
  3408. "Return a string representation of VAL. Used by `ps-print-quote'."
  3409. (cond ((null val)
  3410. "nil")
  3411. ((eq val t)
  3412. "t")
  3413. ((or (symbolp val) (listp val))
  3414. (format "'%S" val))
  3415. (t
  3416. (format "%S" val))))
  3417. (defun ps-comment-string (str value)
  3418. "Return a comment string like \";; STR = VALUE\"."
  3419. (format ";; %s = %s" str (ps-value-string value)))
  3420. (defun ps-value (alist-sym key)
  3421. "Return value from association list ALIST-SYM which car is `eq' to KEY."
  3422. (cdr (assq key (symbol-value alist-sym))))
  3423. (defun ps-get (alist-sym key)
  3424. "Return element from association list ALIST-SYM which car is `eq' to KEY."
  3425. (assq key (symbol-value alist-sym)))
  3426. (defun ps-put (alist-sym key value)
  3427. "Store element (KEY . VALUE) into association list ALIST-SYM.
  3428. If KEY already exists in ALIST-SYM, modify cdr to VALUE.
  3429. It can be retrieved with `(ps-get ALIST-SYM KEY)'."
  3430. (let ((elt: (assq key (symbol-value alist-sym)))) ; to avoid name conflict
  3431. (if elt:
  3432. (setcdr elt: value)
  3433. (setq elt: (cons key value))
  3434. (set alist-sym (cons elt: (symbol-value alist-sym))))
  3435. elt:))
  3436. (defun ps-del (alist-sym key)
  3437. "Delete by side effect element KEY from association list ALIST-SYM."
  3438. (let ((a:list: (symbol-value alist-sym)) ; to avoid name conflict
  3439. old)
  3440. (while a:list:
  3441. (if (eq key (car (car a:list:)))
  3442. (progn
  3443. (if old
  3444. (setcdr old (cdr a:list:))
  3445. (set alist-sym (cdr a:list:)))
  3446. (setq a:list: nil))
  3447. (setq old a:list:
  3448. a:list: (cdr a:list:)))))
  3449. (symbol-value alist-sym))
  3450. (defun ps-time-stamp-locale-default ()
  3451. "Return the locale's \"preferred\" date as, for example, \"06/18/01\"."
  3452. (format-time-string "%x"))
  3453. (defun ps-time-stamp-mon-dd-yyyy ()
  3454. "Return date as \"Jun 18 2001\"."
  3455. (format-time-string "%b %d %Y"))
  3456. (defun ps-time-stamp-yyyy-mm-dd ()
  3457. "Return date as \"2001-06-18\" (ISO date)."
  3458. (format-time-string "%Y-%m-%d"))
  3459. ;; Alias for `ps-time-stamp-yyyy-mm-dd' (which see).
  3460. (defalias 'ps-time-stamp-iso8601 'ps-time-stamp-yyyy-mm-dd)
  3461. (defun ps-time-stamp-hh:mm:ss ()
  3462. "Return time as \"17:28:31\"."
  3463. (format-time-string "%T"))
  3464. (defvar ps-print-color-scale 1.0)
  3465. (defun ps-color-scale (color)
  3466. ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
  3467. (mapcar #'(lambda (value) (/ value ps-print-color-scale))
  3468. (ps-color-values color)))
  3469. (defun ps-face-underlined-p (face)
  3470. (or (face-underline-p face)
  3471. (memq face ps-underlined-faces)))
  3472. (defun ps-prologue-file (filenumber)
  3473. "If prologue FILENUMBER exists and is readable, return contents as string.
  3474. Note: No major/minor-mode is activated and no local variables are evaluated for
  3475. FILENUMBER, but proper EOL-conversion and character interpretation is
  3476. done!"
  3477. (let ((filename (convert-standard-filename
  3478. (expand-file-name (format "ps-prin%d.ps" filenumber)
  3479. ps-postscript-code-directory))))
  3480. (if (and (file-exists-p filename)
  3481. (file-readable-p filename))
  3482. (with-temp-buffer
  3483. (insert-file-contents filename)
  3484. (buffer-string))
  3485. (error "ps-print PostScript prologue `%s' file was not found"
  3486. filename))))
  3487. (defvar ps-mark-code-directory nil)
  3488. (defvar ps-print-prologue-0 ""
  3489. "ps-print PostScript error handler.")
  3490. (defvar ps-print-prologue-1 ""
  3491. "ps-print PostScript prologue.")
  3492. ;; Start Editing Here:
  3493. (defvar ps-source-buffer nil)
  3494. (defvar ps-spool-buffer-name "*PostScript*")
  3495. (defvar ps-spool-buffer nil)
  3496. (defvar ps-output-head nil)
  3497. (defvar ps-output-tail nil)
  3498. (defvar ps-page-postscript 0) ; page number
  3499. (defvar ps-page-order 0) ; PostScript page counter
  3500. (defvar ps-page-sheet 0) ; sheet counter
  3501. (defvar ps-page-column 0) ; column counter
  3502. (defvar ps-page-printed 0) ; total pages printed
  3503. (defvar ps-page-n-up 0) ; n-up counter
  3504. (defvar ps-lines-printed 0) ; total lines printed
  3505. (defvar ps-showline-count 1) ; line number counter
  3506. (defvar ps-first-page nil)
  3507. (defvar ps-last-page nil)
  3508. (defvar ps-print-page-p t)
  3509. (defvar ps-control-or-escape-regexp nil)
  3510. (defvar ps-n-up-on nil)
  3511. (defvar ps-background-pages nil)
  3512. (defvar ps-background-all-pages nil)
  3513. (defvar ps-background-text-count 0)
  3514. (defvar ps-background-image-count 0)
  3515. (defvar ps-current-font 0)
  3516. (defvar ps-default-foreground nil)
  3517. (defvar ps-default-background nil)
  3518. (defvar ps-default-color nil)
  3519. (defvar ps-current-color nil)
  3520. (defvar ps-current-bg nil)
  3521. (defvar ps-foreground-list nil)
  3522. (defvar ps-zebra-stripe-full-p nil)
  3523. (defvar ps-razchunk 0)
  3524. (defvar ps-color-p nil)
  3525. ;; These values determine how much print-height to deduct when headers/footers
  3526. ;; are turned on. This is a pretty clumsy way of handling it, but it'll do for
  3527. ;; now.
  3528. (defvar ps-header-pad 0
  3529. "Vertical and horizontal space between the header frame and the text.
  3530. This is in units of points (1/72 inch).")
  3531. (defvar ps-footer-pad 0
  3532. "Vertical and horizontal space between the footer frame and the text.
  3533. This is in units of points (1/72 inch).")
  3534. ;; Define accessors to the dimensions list.
  3535. (defmacro ps-page-dimensions-get-width (dims) `(nth 0 ,dims))
  3536. (defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
  3537. (defmacro ps-page-dimensions-get-media (dims) `(nth 2 ,dims))
  3538. (defvar ps-landscape-page-height nil)
  3539. (defvar ps-print-width nil)
  3540. (defvar ps-print-height nil)
  3541. (defvar ps-height-remaining nil)
  3542. (defvar ps-width-remaining nil)
  3543. (defvar ps-font-size-internal nil)
  3544. (defvar ps-header-font-size-internal nil)
  3545. (defvar ps-header-title-font-size-internal nil)
  3546. (defvar ps-footer-font-size-internal nil)
  3547. (defvar ps-line-spacing-internal nil)
  3548. (defvar ps-paragraph-spacing-internal nil)
  3549. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3550. ;; Internal Variables
  3551. (defvar ps-black-white-faces-alist nil
  3552. "Alist of symbolic faces used for black/white PostScript printers.
  3553. An element of this list has the same form as `ps-print-face-extension-alist'
  3554. \(which see).
  3555. Don't change this list directly; instead,
  3556. use `ps-extend-face' and `ps-extend-face-list'.
  3557. See documentation for `ps-extend-face' for valid extension symbol.
  3558. See also documentation for `ps-print-color-p'.")
  3559. (defvar ps-print-face-extension-alist nil
  3560. "Alist of symbolic faces *WITH* extension features (box, outline, etc).
  3561. An element of this list has the following form:
  3562. (FACE . [BITS FG BG])
  3563. FACE is a symbol denoting a face name
  3564. BITS is a bit vector, where each bit correspond
  3565. to a feature (bold, underline, etc)
  3566. (see documentation for `ps-print-face-map-alist')
  3567. FG foreground color (string or nil)
  3568. BG background color (string or nil)
  3569. Don't change this list directly; instead,
  3570. use `ps-extend-face' and `ps-extend-face-list'.
  3571. See documentation for `ps-extend-face' for valid extension symbol.")
  3572. (defvar ps-print-face-alist nil
  3573. "Alist of symbolic faces *WITHOUT* extension features (box, outline, etc).
  3574. An element of this list has the same form as an element of
  3575. `ps-print-face-extension-alist'.
  3576. Don't change this list directly; this list is used by `ps-face-attributes',
  3577. `ps-map-face' and `ps-build-reference-face-lists'.")
  3578. (defconst ps-print-face-map-alist
  3579. '((bold . 1)
  3580. (italic . 2)
  3581. (underline . 4)
  3582. (strikeout . 8)
  3583. (overline . 16)
  3584. (shadow . 32)
  3585. (box . 64)
  3586. (outline . 128))
  3587. "Alist of all features and the corresponding bit mask.
  3588. Each symbol correspond to one bit in a bit vector.")
  3589. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3590. ;; Remapping Faces
  3591. ;;;###autoload
  3592. (defun ps-extend-face-list (face-extension-list &optional merge-p alist-sym)
  3593. "Extend face in ALIST-SYM.
  3594. If optional MERGE-P is non-nil, extensions in FACE-EXTENSION-LIST are merged
  3595. with face extension in ALIST-SYM; otherwise, overrides.
  3596. If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
  3597. otherwise, it should be an alist symbol.
  3598. The elements in FACE-EXTENSION-LIST are like those for `ps-extend-face'.
  3599. See `ps-extend-face' for documentation."
  3600. (while face-extension-list
  3601. (ps-extend-face (car face-extension-list) merge-p alist-sym)
  3602. (setq face-extension-list (cdr face-extension-list))))
  3603. ;;;###autoload
  3604. (defun ps-extend-face (face-extension &optional merge-p alist-sym)
  3605. "Extend face in ALIST-SYM.
  3606. If optional MERGE-P is non-nil, extensions in FACE-EXTENSION list are merged
  3607. with face extensions in ALIST-SYM; otherwise, overrides.
  3608. If optional ALIST-SYM is nil, `ps-print-face-extension-alist' is used;
  3609. otherwise, it should be an alist symbol.
  3610. The elements of FACE-EXTENSION list have the form:
  3611. (FACE-NAME FOREGROUND BACKGROUND EXTENSION...)
  3612. FACE-NAME is a face name symbol.
  3613. FOREGROUND and BACKGROUND may be nil or a string that denotes the
  3614. foreground and background colors respectively.
  3615. EXTENSION is one of the following symbols:
  3616. bold - use bold font.
  3617. italic - use italic font.
  3618. underline - put a line under text.
  3619. strikeout - like underline, but the line is in middle of text.
  3620. overline - like underline, but the line is over the text.
  3621. shadow - text will have a shadow.
  3622. box - text will be surrounded by a box.
  3623. outline - print characters as hollow outlines.
  3624. If EXTENSION is any other symbol, it is ignored."
  3625. (or alist-sym
  3626. (setq alist-sym 'ps-print-face-extension-alist))
  3627. (let* ((background (nth 2 face-extension))
  3628. (foreground (nth 1 face-extension))
  3629. (face-name (nth 0 face-extension))
  3630. (ps-face (cdr (assq face-name (symbol-value alist-sym))))
  3631. (face-vector (or ps-face (vector 0 nil nil)))
  3632. (face-bit (ps-extension-bit face-extension)))
  3633. ;; extend face
  3634. (aset face-vector 0 (if merge-p
  3635. (logior (aref face-vector 0) face-bit)
  3636. face-bit))
  3637. (and (or (not merge-p) (and foreground (stringp foreground)))
  3638. (aset face-vector 1 foreground))
  3639. (and (or (not merge-p) (and background (stringp background)))
  3640. (aset face-vector 2 background))
  3641. ;; if face does not exist, insert it
  3642. (or ps-face
  3643. (set alist-sym (cons (cons face-name face-vector)
  3644. (symbol-value alist-sym))))))
  3645. (defun ps-extension-bit (face-extension)
  3646. (let ((face-bit 0))
  3647. ;; map valid symbol extension to bit vector
  3648. (setq face-extension (cdr (cdr face-extension)))
  3649. (while (setq face-extension (cdr face-extension))
  3650. (setq face-bit (logior face-bit
  3651. (or (cdr (assq (car face-extension)
  3652. ps-print-face-map-alist))
  3653. 0))))
  3654. face-bit))
  3655. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3656. ;; Adapted from font-lock: (obsolete stuff)
  3657. ;; Originally face attributes were specified via `font-lock-face-attributes'.
  3658. ;; Users then changed the default face attributes by setting that variable.
  3659. ;; However, we try and be back-compatible and respect its value if set except
  3660. ;; for faces where M-x customize has been used to save changes for the face.
  3661. (defun ps-font-lock-face-attributes ()
  3662. (and (boundp 'font-lock-mode) (symbol-value 'font-lock-mode)
  3663. (boundp 'font-lock-face-attributes)
  3664. (let ((face-attributes (symbol-value 'font-lock-face-attributes)))
  3665. (while face-attributes
  3666. (let* ((face-attribute
  3667. (car (prog1 face-attributes
  3668. (setq face-attributes (cdr face-attributes)))))
  3669. (face (car face-attribute)))
  3670. ;; Rustle up a `defface' SPEC from a
  3671. ;; `font-lock-face-attributes' entry.
  3672. (unless (get face 'saved-face)
  3673. (let ((foreground (nth 1 face-attribute))
  3674. (background (nth 2 face-attribute))
  3675. (bold-p (nth 3 face-attribute))
  3676. (italic-p (nth 4 face-attribute))
  3677. (underline-p (nth 5 face-attribute))
  3678. face-spec)
  3679. (when foreground
  3680. (setq face-spec (cons ':foreground
  3681. (cons foreground face-spec))))
  3682. (when background
  3683. (setq face-spec (cons ':background
  3684. (cons background face-spec))))
  3685. (when bold-p
  3686. (setq face-spec (append '(:weight bold) face-spec)))
  3687. (when italic-p
  3688. (setq face-spec (append '(:slant italic) face-spec)))
  3689. (when underline-p
  3690. (setq face-spec (append '(:underline t) face-spec)))
  3691. (custom-declare-face face (list (list t face-spec)) nil)
  3692. )))))))
  3693. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3694. ;; Internal functions and variables
  3695. (defun ps-message-log-max ()
  3696. (and (not (string= (buffer-name) "*Messages*"))
  3697. (boundp 'message-log-max)
  3698. message-log-max))
  3699. (defvar ps-print-hook nil)
  3700. (defvar ps-print-begin-sheet-hook nil)
  3701. (defvar ps-print-begin-page-hook nil)
  3702. (defvar ps-print-begin-column-hook nil)
  3703. (defun ps-print-without-faces (from to &optional filename region-p)
  3704. (ps-spool-without-faces from to region-p)
  3705. (ps-do-despool filename))
  3706. (defun ps-spool-without-faces (from to &optional region-p)
  3707. (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
  3708. (run-hooks 'ps-print-hook)
  3709. (ps-printing-region region-p from to)
  3710. (ps-generate (current-buffer) from to 'ps-generate-postscript)))
  3711. (defun ps-print-with-faces (from to &optional filename region-p)
  3712. (ps-spool-with-faces from to region-p)
  3713. (ps-do-despool filename))
  3714. (defun ps-spool-with-faces (from to &optional region-p)
  3715. (let ((message-log-max (ps-message-log-max))) ; to print *Messages* buffer
  3716. (run-hooks 'ps-print-hook)
  3717. (ps-printing-region region-p from to)
  3718. (ps-generate (current-buffer) from to 'ps-generate-postscript-with-faces)))
  3719. (defun ps-count-lines-preprint (from to)
  3720. (or (and from to)
  3721. (error "The mark is not set now"))
  3722. (let ((message-log-max (ps-message-log-max))) ; to count lines of *Messages*
  3723. (list (count-lines from to))))
  3724. (defun ps-count-lines (from to)
  3725. (+ (count-lines from to)
  3726. (save-excursion
  3727. (goto-char to)
  3728. (if (= (current-column) 0) 1 0))))
  3729. (defvar ps-printing-region nil
  3730. "Variable used to indicate the region that ps-print is printing.
  3731. It is a cons, the car of which is the line number where the region begins, and
  3732. its cdr is the total number of lines in the buffer. Formatting functions can
  3733. use this information to print the original line number (and not the number of
  3734. lines printed), and to indicate in the header that the printout is of a partial
  3735. file.")
  3736. (defvar ps-printing-region-p nil
  3737. "Non-nil means ps-print is printing a region.")
  3738. (defun ps-printing-region (region-p from to)
  3739. (setq ps-printing-region-p region-p
  3740. ps-printing-region
  3741. (cons (if region-p
  3742. (ps-count-lines (point-min) (min from to))
  3743. 1)
  3744. (ps-count-lines (point-min) (point-max)))))
  3745. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3746. ;; Internal functions
  3747. (defsubst ps-font-alist (font-sym)
  3748. (get font-sym 'fonts))
  3749. (defun ps-font (font-sym font-type)
  3750. "Font family name for text of `font-type', when generating PostScript."
  3751. (let* ((font-list (ps-font-alist font-sym))
  3752. (normal-font (cdr (assq 'normal font-list))))
  3753. (while (and font-list (not (eq font-type (car (car font-list)))))
  3754. (setq font-list (cdr font-list)))
  3755. (or (cdr (car font-list)) normal-font)))
  3756. (defsubst ps-fonts (font-sym)
  3757. (mapcar 'cdr (ps-font-alist font-sym)))
  3758. (defsubst ps-font-number (font-sym font-type)
  3759. (or (ps-alist-position font-type (ps-font-alist font-sym))
  3760. 0))
  3761. (defsubst ps-line-height (font-sym)
  3762. "The height of a line, for generating PostScript.
  3763. This is the value that ps-print uses to determine the height,
  3764. y-dimension, of the lines of text it has printed, and thus affects the
  3765. point at which page-breaks are placed.
  3766. The line-height is *not* the same as the point size of the font."
  3767. (get font-sym 'line-height))
  3768. (defsubst ps-title-line-height (font-sym)
  3769. "The height of a `title' line, for generating PostScript.
  3770. This is the value that ps-print uses to determine the height,
  3771. y-dimension, of the lines of text it has printed, and thus affects the
  3772. point at which page-breaks are placed.
  3773. The title-line-height is *not* the same as the point size of the font."
  3774. (get font-sym 'title-line-height))
  3775. (defsubst ps-space-width (font-sym)
  3776. "The width of a space character, for generating PostScript.
  3777. This value is used in expanding tab characters."
  3778. (get font-sym 'space-width))
  3779. (defsubst ps-avg-char-width (font-sym)
  3780. "The average width, in points, of a character, for generating PostScript.
  3781. This is the value that ps-print uses to determine the length,
  3782. x-dimension, of the text it has printed, and thus affects the point at
  3783. which long lines wrap around."
  3784. (get font-sym 'avg-char-width))
  3785. (defun ps-line-lengths-internal ()
  3786. "Display the correspondence between a line length and a font size.
  3787. Done using the current ps-print setup.
  3788. Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
  3789. (let* ((ps-font-size-internal
  3790. (or ps-font-size-internal
  3791. (ps-get-font-size 'ps-font-size)))
  3792. (ps-header-font-size-internal
  3793. (or ps-header-font-size-internal
  3794. (ps-get-font-size 'ps-header-font-size)))
  3795. (ps-footer-font-size-internal
  3796. (or ps-footer-font-size-internal
  3797. (ps-get-font-size 'ps-footer-font-size)))
  3798. (ps-header-title-font-size-internal
  3799. (or ps-header-title-font-size-internal
  3800. (ps-get-font-size 'ps-header-title-font-size)))
  3801. (buf (get-buffer-create "*Line-lengths*"))
  3802. (ifs ps-font-size-internal) ; initial font size
  3803. (print-width (progn (ps-get-page-dimensions)
  3804. ps-print-width))
  3805. (icw (ps-avg-char-width 'ps-font-for-text)) ; initial character width
  3806. (ps-setup (ps-setup)) ; setup for the current buffer
  3807. (fs-min 5) ; minimum font size
  3808. cw-min ; minimum character width
  3809. nb-cpl-max ; maximum nb of characters per line
  3810. (fs-max 14) ; maximum font size
  3811. cw-max ; maximum character width
  3812. nb-cpl-min ; minimum nb of characters per line
  3813. fs ; current font size
  3814. cw ; current character width
  3815. nb-cpl ; current nb of characters per line
  3816. )
  3817. (setq cw-min (/ (* icw fs-min) ifs)
  3818. nb-cpl-max (floor (/ print-width cw-min))
  3819. cw-max (/ (* icw fs-max) ifs)
  3820. nb-cpl-min (floor (/ print-width cw-max))
  3821. nb-cpl nb-cpl-min)
  3822. (set-buffer buf)
  3823. (goto-char (point-max))
  3824. (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
  3825. (insert ps-setup
  3826. "\nnb char per line / font size\n")
  3827. (while (<= nb-cpl nb-cpl-max)
  3828. (setq cw (/ print-width (float nb-cpl))
  3829. fs (/ (* ifs cw) icw))
  3830. (insert (format "%16d %s\n" nb-cpl fs))
  3831. (setq nb-cpl (1+ nb-cpl)))
  3832. (insert "\n")
  3833. (display-buffer buf 'not-this-window)))
  3834. (defun ps-nb-pages (nb-lines)
  3835. "Display correspondence between font size and the number of pages.
  3836. The correspondence is based on having NB-LINES lines of text,
  3837. and on the current ps-print setup."
  3838. (let* ((ps-font-size-internal
  3839. (or ps-font-size-internal
  3840. (ps-get-font-size 'ps-font-size)))
  3841. (ps-header-font-size-internal
  3842. (or ps-header-font-size-internal
  3843. (ps-get-font-size 'ps-header-font-size)))
  3844. (ps-footer-font-size-internal
  3845. (or ps-footer-font-size-internal
  3846. (ps-get-font-size 'ps-footer-font-size)))
  3847. (ps-header-title-font-size-internal
  3848. (or ps-header-title-font-size-internal
  3849. (ps-get-font-size 'ps-header-title-font-size)))
  3850. (ps-line-spacing-internal
  3851. (or ps-line-spacing-internal
  3852. (ps-get-size ps-line-spacing "line spacing")))
  3853. (buf (get-buffer-create "*Nb-Pages*"))
  3854. (ils ps-line-spacing-internal) ; initial line spacing
  3855. (ifs ps-font-size-internal) ; initial font size
  3856. (page-height (progn (ps-get-page-dimensions)
  3857. ps-print-height))
  3858. (ilh (ps-line-height 'ps-font-for-text)) ; initial line height
  3859. (ps-setup (ps-setup)) ; setup for the current buffer
  3860. (fs-min 4) ; minimum font size
  3861. lh-min ; minimum line height
  3862. nb-lpp-max ; maximum nb of lines per page
  3863. nb-page-min ; minimum nb of pages
  3864. (fs-max 14) ; maximum font size
  3865. lh-max ; maximum line height
  3866. nb-lpp-min ; minimum nb of lines per page
  3867. nb-page-max ; maximum nb of pages
  3868. fs ; current font size
  3869. lh ; current line height
  3870. nb-lpp ; current nb of lines per page
  3871. nb-page ; current nb of pages
  3872. )
  3873. (setq lh-min (/ (- (* (+ ilh ils) fs-min) ils) ifs)
  3874. nb-lpp-max (floor (/ page-height lh-min))
  3875. nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
  3876. lh-max (/ (- (* (+ ilh ils) fs-max) ils) ifs)
  3877. nb-lpp-min (floor (/ page-height lh-max))
  3878. nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min))
  3879. nb-page nb-page-min)
  3880. (set-buffer buf)
  3881. (goto-char (point-max))
  3882. (or (bobp) (insert "\n" (make-string 75 ?\;) "\n"))
  3883. (insert ps-setup
  3884. (format "\nThere are %d lines.\n\n" nb-lines)
  3885. "nb page / font size\n")
  3886. (while (<= nb-page nb-page-max)
  3887. (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
  3888. lh (/ page-height nb-lpp)
  3889. fs (/ (* ifs lh) ilh))
  3890. (insert (format "%7d %s\n" nb-page fs))
  3891. (setq nb-page (1+ nb-page)))
  3892. (insert "\n")
  3893. (display-buffer buf 'not-this-window)))
  3894. ;; macros used in `ps-select-font'
  3895. (defmacro ps-lookup (key) `(cdr (assq ,key font-entry)))
  3896. (defmacro ps-size-scale (key) `(/ (* (ps-lookup ,key) font-size) size))
  3897. (defun ps-select-font (font-family sym font-size title-font-size)
  3898. (let ((font-entry (cdr (assq font-family ps-font-info-database))))
  3899. (or font-entry
  3900. (error "Don't have data to scale font %s. Known fonts families are %s"
  3901. font-family
  3902. (mapcar 'car ps-font-info-database)))
  3903. (let ((size (ps-lookup 'size)))
  3904. (put sym 'fonts (ps-lookup 'fonts))
  3905. (put sym 'space-width (ps-size-scale 'space-width))
  3906. (put sym 'avg-char-width (ps-size-scale 'avg-char-width))
  3907. (put sym 'line-height (ps-size-scale 'line-height))
  3908. (put sym 'title-line-height
  3909. (/ (* (ps-lookup 'line-height) title-font-size) size)))))
  3910. (defun ps-get-page-dimensions ()
  3911. (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
  3912. page-width page-height)
  3913. (cond
  3914. ((null page-dimensions)
  3915. (error "`ps-paper-type' must be one of:\n%s"
  3916. (mapcar 'car ps-page-dimensions-database)))
  3917. ((< ps-number-of-columns 1)
  3918. (error "The number of columns %d should be positive"
  3919. ps-number-of-columns)))
  3920. (ps-select-font ps-font-family 'ps-font-for-text
  3921. ps-font-size-internal ps-font-size-internal)
  3922. (ps-select-font ps-header-font-family 'ps-font-for-header
  3923. ps-header-font-size-internal
  3924. ps-header-title-font-size-internal)
  3925. (ps-select-font ps-footer-font-family 'ps-font-for-footer
  3926. ps-footer-font-size-internal ps-footer-font-size-internal)
  3927. (setq page-width (ps-page-dimensions-get-width page-dimensions)
  3928. page-height (ps-page-dimensions-get-height page-dimensions))
  3929. ;; Landscape mode
  3930. (if ps-landscape-mode
  3931. ;; exchange width and height
  3932. (setq page-width (prog1 page-height (setq page-height page-width))))
  3933. ;; It is used to get the lower right corner (only in landscape mode)
  3934. (setq ps-landscape-page-height page-height)
  3935. ;; | lm | text | ic | text | ic | text | rm |
  3936. ;; page-width == lm + n * pw + (n - 1) * ic + rm
  3937. ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
  3938. (setq ps-print-width (/ (- page-width
  3939. ps-left-margin ps-right-margin
  3940. (* (1- ps-number-of-columns) ps-inter-column))
  3941. ps-number-of-columns))
  3942. (if (<= ps-print-width 0)
  3943. (error "Bad horizontal layout:
  3944. page-width == %s
  3945. ps-left-margin == %s
  3946. ps-right-margin == %s
  3947. ps-inter-column == %s
  3948. ps-number-of-columns == %s
  3949. | lm | text | ic | text | ic | text | rm |
  3950. page-width == lm + n * print-width + (n - 1) * ic + rm
  3951. => print-width == %d !"
  3952. page-width
  3953. ps-left-margin
  3954. ps-right-margin
  3955. ps-inter-column
  3956. ps-number-of-columns
  3957. ps-print-width))
  3958. (setq ps-print-height
  3959. (- page-height ps-bottom-margin ps-top-margin))
  3960. (if (<= ps-print-height 0)
  3961. (error "Bad vertical layout:
  3962. ps-top-margin == %s
  3963. ps-bottom-margin == %s
  3964. page-height == bm + print-height + tm
  3965. => print-height == %d !"
  3966. ps-top-margin
  3967. ps-bottom-margin
  3968. ps-print-height))
  3969. ;; If headers are turned on, deduct the height of the header from the print
  3970. ;; height.
  3971. (if ps-print-header
  3972. (setq ps-header-pad (* ps-header-line-pad
  3973. (ps-title-line-height 'ps-font-for-header))
  3974. ps-print-height (- ps-print-height
  3975. ps-header-offset
  3976. ps-header-pad
  3977. (ps-title-line-height 'ps-font-for-header)
  3978. (* (ps-line-height 'ps-font-for-header)
  3979. (1- ps-header-lines))
  3980. ps-header-pad)))
  3981. (if (<= ps-print-height 0)
  3982. (error "Bad vertical layout (header):
  3983. ps-top-margin == %s
  3984. ps-bottom-margin == %s
  3985. ps-header-offset == %s
  3986. ps-header-pad == %s
  3987. header-height == %s
  3988. page-height == bm + print-height + tm - ho - hh
  3989. => print-height == %d !"
  3990. ps-top-margin
  3991. ps-bottom-margin
  3992. ps-header-offset
  3993. ps-header-pad
  3994. (+ ps-header-pad
  3995. (ps-title-line-height 'ps-font-for-header)
  3996. (* (ps-line-height 'ps-font-for-header)
  3997. (1- ps-header-lines))
  3998. ps-header-pad)
  3999. ps-print-height))
  4000. ;; If footers are turned on, deduct the height of the footer from the print
  4001. ;; height.
  4002. (if ps-print-footer
  4003. (setq ps-footer-pad (* ps-footer-line-pad
  4004. (ps-title-line-height 'ps-font-for-footer))
  4005. ps-print-height (- ps-print-height
  4006. ps-footer-offset
  4007. ps-footer-pad
  4008. (* (ps-line-height 'ps-font-for-footer)
  4009. (1- ps-footer-lines))
  4010. ps-footer-pad)))
  4011. (if (<= ps-print-height 0)
  4012. (error "Bad vertical layout (footer):
  4013. ps-top-margin == %s
  4014. ps-bottom-margin == %s
  4015. ps-footer-offset == %s
  4016. ps-footer-pad == %s
  4017. footer-height == %s
  4018. page-height == bm + print-height + tm - fo - fh
  4019. => print-height == %d !"
  4020. ps-top-margin
  4021. ps-bottom-margin
  4022. ps-footer-offset
  4023. ps-footer-pad
  4024. (+ ps-footer-pad
  4025. (* (ps-line-height 'ps-font-for-footer)
  4026. (1- ps-footer-lines))
  4027. ps-footer-pad)
  4028. ps-print-height))
  4029. ;; ps-zebra-stripe-follow is `full' or `full-follow'
  4030. (if ps-zebra-stripe-full-p
  4031. (let* ((line-height (ps-line-height 'ps-font-for-text))
  4032. (zebra (* (+ line-height ps-line-spacing-internal)
  4033. ps-zebra-stripe-height)))
  4034. (setq ps-print-height (- (* (floor ps-print-height zebra) zebra)
  4035. line-height))
  4036. (if (<= ps-print-height 0)
  4037. (error "Bad vertical layout (full zebra stripe follow):
  4038. ps-zebra-stripe-follow == %s
  4039. ps-zebra-stripe-height == %s
  4040. font-text-height == %s
  4041. line-spacing == %s
  4042. page-height == ((floor print-height ((th + ls) * zh)) * ((th + ls) * zh)) - th
  4043. => print-height == %d !"
  4044. ps-zebra-stripe-follow
  4045. ps-zebra-stripe-height
  4046. (ps-line-height 'ps-font-for-text)
  4047. ps-line-spacing-internal
  4048. ps-print-height))))))
  4049. (defun ps-print-preprint-region (prefix)
  4050. (or (ps-mark-active-p)
  4051. (error "The mark is not set now"))
  4052. (list (point) (mark) (ps-print-preprint prefix)))
  4053. (defun ps-print-preprint (prefix)
  4054. (and prefix
  4055. (or (numberp prefix)
  4056. (listp prefix))
  4057. (let* ((name (concat (file-name-nondirectory (or (buffer-file-name)
  4058. (buffer-name)))
  4059. ".ps"))
  4060. (prompt (format "Save PostScript to file (default %s): " name))
  4061. (res (read-file-name prompt default-directory name nil)))
  4062. (while (cond ((file-directory-p res)
  4063. (ding)
  4064. (setq prompt "It's a directory"))
  4065. ((not (file-writable-p res))
  4066. (ding)
  4067. (setq prompt "File is unwritable"))
  4068. ((file-exists-p res)
  4069. (setq prompt "File exists")
  4070. (not (y-or-n-p (format "File `%s' exists; overwrite? "
  4071. res))))
  4072. (t nil))
  4073. (setq res (read-file-name
  4074. (format "%s; save PostScript to file: " prompt)
  4075. (file-name-directory res) nil nil
  4076. (file-name-nondirectory res))))
  4077. (if (file-directory-p res)
  4078. (expand-file-name name (file-name-as-directory res))
  4079. res))))
  4080. ;; The following functions implement a simple list-buffering scheme so
  4081. ;; that ps-print doesn't have to repeatedly switch between buffers
  4082. ;; while spooling. The functions `ps-output' and `ps-output-string' build
  4083. ;; up the lists; the function `ps-flush-output' takes the lists and
  4084. ;; insert its contents into the spool buffer (*PostScript*).
  4085. (defvar ps-string-escape-codes
  4086. (let ((table (make-vector 256 nil))
  4087. (char ?\000))
  4088. ;; control characters
  4089. (while (<= char ?\037)
  4090. (aset table char (format "\\%03o" char))
  4091. (setq char (1+ char)))
  4092. ;; printable characters
  4093. (while (< char ?\177)
  4094. (aset table char (format "%c" char))
  4095. (setq char (1+ char)))
  4096. ;; DEL and 8-bit characters
  4097. (while (<= char ?\377)
  4098. (aset table char (format "\\%o" char))
  4099. (setq char (1+ char)))
  4100. ;; Override ASCII formatting characters with named escape code:
  4101. (aset table ?\n "\\n") ; [NL] linefeed
  4102. (aset table ?\r "\\r") ; [CR] carriage return
  4103. (aset table ?\t "\\t") ; [HT] horizontal tab
  4104. (aset table ?\b "\\b") ; [BS] backspace
  4105. (aset table ?\f "\\f") ; [NP] form feed
  4106. ;; Escape PostScript escape and string delimiter characters:
  4107. (aset table ?\\ "\\\\")
  4108. (aset table ?\( "\\(")
  4109. (aset table ?\) "\\)")
  4110. table)
  4111. "Vector used to map characters to PostScript string escape codes.")
  4112. (defsubst ps-output-string-prim (string)
  4113. (insert "(") ;insert start-string delimiter
  4114. (save-excursion ;insert string
  4115. (insert (string-as-unibyte string)))
  4116. ;; Find and quote special characters as necessary for PS
  4117. ;; This skips everything except control chars, non-ASCII chars, (, ) and \.
  4118. (while (progn (skip-chars-forward " -'*-[]-~") (not (eobp)))
  4119. (let ((special (following-char)))
  4120. (delete-char 1)
  4121. (insert
  4122. (if (and (<= 0 special) (<= special 255))
  4123. (aref ps-string-escape-codes special)
  4124. ;; insert hexadecimal representation if character code is out of range
  4125. (format "\\%04X" special)
  4126. ))))
  4127. (goto-char (point-max))
  4128. (insert ")")) ;insert end-string delimiter
  4129. (defsubst ps-init-output-queue ()
  4130. (setq ps-output-head (list "")
  4131. ps-output-tail ps-output-head))
  4132. (defun ps-selected-pages ()
  4133. (while (progn
  4134. (setq ps-first-page (car (car ps-selected-pages))
  4135. ps-last-page (cdr (car ps-selected-pages))
  4136. ps-selected-pages (cdr ps-selected-pages))
  4137. (and ps-selected-pages
  4138. (< ps-last-page ps-page-postscript)))))
  4139. (defsubst ps-print-page-p ()
  4140. (setq ps-print-page-p
  4141. (and (cond ((null ps-first-page))
  4142. ((<= ps-page-postscript ps-last-page)
  4143. (<= ps-first-page ps-page-postscript))
  4144. (ps-selected-pages
  4145. (ps-selected-pages)
  4146. (and (<= ps-first-page ps-page-postscript)
  4147. (<= ps-page-postscript ps-last-page)))
  4148. (t
  4149. nil))
  4150. (cond ((eq ps-even-or-odd-pages 'even-page)
  4151. (= (logand ps-page-postscript 1) 0))
  4152. ((eq ps-even-or-odd-pages 'odd-page)
  4153. (= (logand ps-page-postscript 1) 1))
  4154. (t)
  4155. ))))
  4156. (defsubst ps-print-sheet-p ()
  4157. (setq ps-print-page-p
  4158. (cond ((eq ps-even-or-odd-pages 'even-sheet)
  4159. (= (logand ps-page-sheet 1) 0))
  4160. ((eq ps-even-or-odd-pages 'odd-sheet)
  4161. (= (logand ps-page-sheet 1) 1))
  4162. (t)
  4163. )))
  4164. (defun ps-output (&rest args)
  4165. (when ps-print-page-p
  4166. (setcdr ps-output-tail args)
  4167. (while (cdr ps-output-tail)
  4168. (setq ps-output-tail (cdr ps-output-tail)))))
  4169. (defun ps-output-string (string)
  4170. (ps-output t string))
  4171. ;; Output strings in the list ARGS in the PostScript prologue part.
  4172. (defun ps-output-prologue (args)
  4173. (ps-output 'prologue (if (stringp args) (list args) args)))
  4174. (defun ps-flush-output ()
  4175. (with-current-buffer ps-spool-buffer
  4176. (goto-char (point-max))
  4177. (while ps-output-head
  4178. (let ((it (car ps-output-head)))
  4179. (cond
  4180. ((eq t it)
  4181. (setq ps-output-head (cdr ps-output-head))
  4182. (ps-output-string-prim (car ps-output-head)))
  4183. ((eq 'prologue it)
  4184. (setq ps-output-head (cdr ps-output-head))
  4185. (save-excursion
  4186. (search-backward "\nBeginDoc")
  4187. (forward-char 1)
  4188. (apply 'insert (car ps-output-head))))
  4189. (t
  4190. (insert it))))
  4191. (setq ps-output-head (cdr ps-output-head))))
  4192. (ps-init-output-queue))
  4193. (defun ps-insert-file (fname)
  4194. (ps-flush-output)
  4195. (with-current-buffer ps-spool-buffer
  4196. (goto-char (point-max))
  4197. (insert-file-contents fname)))
  4198. ;; These functions insert the arrays that define the contents of the headers.
  4199. (defvar ps-encode-header-string-function nil)
  4200. (defun ps-generate-header-line (fonttag &optional content)
  4201. (ps-output " [" fonttag " ")
  4202. (cond
  4203. ;; Literal strings should be output as is -- the string must contain its own
  4204. ;; PS string delimiters, '(' and ')', if necessary.
  4205. ((stringp content)
  4206. (ps-output content))
  4207. ;; Functions are called -- they should return strings; they will be inserted
  4208. ;; as strings and the PS string delimiters added.
  4209. ((functionp content)
  4210. (if (functionp ps-encode-header-string-function)
  4211. (dolist (l (funcall ps-encode-header-string-function
  4212. (funcall content) fonttag))
  4213. (ps-output-string l))
  4214. (ps-output-string (funcall content))))
  4215. ;; Variables will have their contents inserted. They should contain
  4216. ;; strings, and will be inserted as strings.
  4217. ((and (symbolp content) (boundp content))
  4218. (if (fboundp ps-encode-header-string-function)
  4219. (dolist (l (funcall ps-encode-header-string-function
  4220. (symbol-value content) fonttag))
  4221. (ps-output-string l))
  4222. (ps-output-string (symbol-value content))))
  4223. ;; Anything else will get turned into an empty string.
  4224. (t
  4225. (ps-output-string "")))
  4226. (ps-output "]\n"))
  4227. (defun ps-generate-header (name fonttag0 fonttag1 contents)
  4228. (ps-output "/" name "[\n")
  4229. (and contents (> ps-header-lines 0)
  4230. (let ((count 1))
  4231. (ps-generate-header-line fonttag0 (car contents))
  4232. (while (and (< count ps-header-lines)
  4233. (setq contents (cdr contents)))
  4234. (ps-generate-header-line fonttag1 (car contents))
  4235. (setq count (1+ count)))))
  4236. (ps-output "]def\n"))
  4237. (defun ps-output-boolean (name bool)
  4238. (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
  4239. (defun ps-output-frame-properties (name alist)
  4240. (ps-output "/" name " ["
  4241. (ps-format-color (cdr (assq 'fore-color alist)) 0.0)
  4242. (ps-format-color (cdr (assq 'back-color alist)) 0.9)
  4243. (ps-float-format (or (cdr (assq 'border-width alist)) 0.4))
  4244. (ps-format-color (cdr (assq 'border-color alist)) 0.0)
  4245. (ps-format-color (cdr (assq 'shadow-color alist)) 0.0)
  4246. "]def\n"))
  4247. (defun ps-background-pages (page-list func)
  4248. (if page-list
  4249. (mapcar
  4250. #'(lambda (pages)
  4251. (let ((start (if (consp pages) (car pages) pages))
  4252. (end (if (consp pages) (cdr pages) pages)))
  4253. (and (integerp start) (integerp end) (<= start end)
  4254. (add-to-list 'ps-background-pages (vector start end func)))))
  4255. page-list)
  4256. (setq ps-background-all-pages (cons func ps-background-all-pages))))
  4257. (defconst ps-boundingbox-re
  4258. "^%%BoundingBox:\
  4259. \\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)\\s-+\\([0-9.]+\\)")
  4260. (defun ps-get-boundingbox ()
  4261. (with-current-buffer ps-spool-buffer
  4262. (save-excursion
  4263. (if (re-search-forward ps-boundingbox-re nil t)
  4264. (vector (string-to-number ; lower x
  4265. (buffer-substring (match-beginning 1) (match-end 1)))
  4266. (string-to-number ; lower y
  4267. (buffer-substring (match-beginning 2) (match-end 2)))
  4268. (string-to-number ; upper x
  4269. (buffer-substring (match-beginning 3) (match-end 3)))
  4270. (string-to-number ; upper y
  4271. (buffer-substring (match-beginning 4) (match-end 4))))
  4272. (vector 0 0 0 0)))))
  4273. (defun ps-float-format (value &optional default)
  4274. (let ((literal (or value default)))
  4275. (cond ((null literal)
  4276. " ")
  4277. ((numberp literal)
  4278. (format ps-float-format (* literal 1.0))) ; force float number
  4279. (t
  4280. (format "%s " literal))
  4281. )))
  4282. (defun ps-background-text ()
  4283. (mapcar
  4284. #'(lambda (text)
  4285. (setq ps-background-text-count (1+ ps-background-text-count))
  4286. (ps-output (format "/ShowBackText-%d{\n" ps-background-text-count))
  4287. (ps-output-string (nth 0 text)) ; text
  4288. (ps-output
  4289. "\n"
  4290. (ps-float-format (nth 4 text) 200.0) ; font size
  4291. (format "/%s " (or (nth 3 text) "Times-Roman")) ; font name
  4292. (ps-float-format (nth 6 text)
  4293. "PrintHeight PrintPageWidth atan") ; rotation
  4294. (ps-float-format (nth 5 text) 0.85) ; gray
  4295. (ps-float-format (nth 1 text) "0") ; x position
  4296. (ps-float-format (nth 2 text) "0") ; y position
  4297. "\nShowBackText}def\n")
  4298. (ps-background-pages (nthcdr 7 text) ; page list
  4299. (format "ShowBackText-%d\n"
  4300. ps-background-text-count)))
  4301. ps-print-background-text))
  4302. (defun ps-background-image ()
  4303. (mapcar
  4304. #'(lambda (image)
  4305. (let ((image-file (expand-file-name (nth 0 image))))
  4306. (when (file-readable-p image-file)
  4307. (setq ps-background-image-count (1+ ps-background-image-count))
  4308. (ps-output
  4309. (format "/ShowBackImage-%d{\n--back-- "
  4310. ps-background-image-count)
  4311. (ps-float-format (nth 5 image) 0.0) ; rotation
  4312. (ps-float-format (nth 3 image) 1.0) ; x scale
  4313. (ps-float-format (nth 4 image) 1.0) ; y scale
  4314. (ps-float-format (nth 1 image) ; x position
  4315. "PrintPageWidth 2 div")
  4316. (ps-float-format (nth 2 image) ; y position
  4317. "PrintHeight 2 div BottomMargin add")
  4318. "\nBeginBackImage\n")
  4319. (ps-insert-file image-file)
  4320. ;; coordinate adjustment to center image
  4321. ;; around x and y position
  4322. (let ((box (ps-get-boundingbox)))
  4323. (with-current-buffer ps-spool-buffer
  4324. (save-excursion
  4325. (if (re-search-backward "^--back--" nil t)
  4326. (replace-match
  4327. (format "%s %s"
  4328. (ps-float-format
  4329. (- (+ (/ (- (aref box 2) (aref box 0)) 2.0)
  4330. (aref box 0))))
  4331. (ps-float-format
  4332. (- (+ (/ (- (aref box 3) (aref box 1)) 2.0)
  4333. (aref box 1)))))
  4334. t)))))
  4335. (ps-output "\nEndBackImage}def\n")
  4336. (ps-background-pages (nthcdr 6 image) ; page list
  4337. (format "ShowBackImage-%d\n"
  4338. ps-background-image-count)))))
  4339. ps-print-background-image))
  4340. (defun ps-background (page-number)
  4341. (let (has-local-background)
  4342. (mapc #'(lambda (range)
  4343. (and (<= (aref range 0) page-number)
  4344. (<= page-number (aref range 1))
  4345. (if has-local-background
  4346. (ps-output (aref range 2))
  4347. (setq has-local-background t)
  4348. (ps-output "/printLocalBackground{\n"
  4349. (aref range 2)))))
  4350. ps-background-pages)
  4351. (and has-local-background (ps-output "}def\n"))))
  4352. ;; Return a list of the distinct elements of LIST.
  4353. ;; Elements are compared with `equal'.
  4354. (defun ps-remove-duplicates (list)
  4355. (let (new (tail list))
  4356. (while tail
  4357. (or (member (car tail) new)
  4358. (setq new (cons (car tail) new)))
  4359. (setq tail (cdr tail)))
  4360. (nreverse new)))
  4361. ;; Find the first occurrence of ITEM in LIST.
  4362. ;; Return the index of the matching item, or nil if not found.
  4363. ;; Elements are compared with `eq'.
  4364. (defun ps-alist-position (item list)
  4365. (let ((tail list) (index 0) found)
  4366. (while tail
  4367. (if (setq found (eq (car (car tail)) item))
  4368. (setq tail nil)
  4369. (setq index (1+ index)
  4370. tail (cdr tail))))
  4371. (and found index)))
  4372. (defconst ps-n-up-database
  4373. '((a4
  4374. (1 nil 1 1 0)
  4375. (2 t 1 2 0)
  4376. (4 nil 2 2 0)
  4377. (6 t 2 3 1)
  4378. (8 t 2 4 0)
  4379. (9 nil 3 3 0)
  4380. (12 t 3 4 2)
  4381. (16 nil 4 4 0)
  4382. (18 t 3 6 0)
  4383. (20 nil 5 4 1)
  4384. (25 nil 5 5 0)
  4385. (30 nil 6 5 1)
  4386. (32 t 4 8 0)
  4387. (36 nil 6 6 0)
  4388. (42 nil 7 6 1)
  4389. (49 nil 7 7 0)
  4390. (50 t 5 10 0)
  4391. (56 nil 8 7 1)
  4392. (64 nil 8 8 0)
  4393. (72 nil 9 8 1)
  4394. (81 nil 9 9 0)
  4395. (90 nil 10 9 1)
  4396. (100 nil 10 10 0))
  4397. (a3
  4398. (1 nil 1 1 0)
  4399. (2 t 1 2 0)
  4400. (4 nil 2 2 0)
  4401. (6 t 2 3 1)
  4402. (8 t 2 4 0)
  4403. (9 nil 3 3 0)
  4404. (12 nil 4 3 1)
  4405. (16 nil 4 4 0)
  4406. (18 t 3 6 0)
  4407. (20 nil 5 4 1)
  4408. (25 nil 5 5 0)
  4409. (30 nil 6 5 1)
  4410. (32 t 4 8 0)
  4411. (36 nil 6 6 0)
  4412. (42 nil 7 6 1)
  4413. (49 nil 7 7 0)
  4414. (50 t 5 10 0)
  4415. (56 nil 8 7 1)
  4416. (64 nil 8 8 0)
  4417. (72 nil 9 8 1)
  4418. (81 nil 9 9 0)
  4419. (90 nil 10 9 1)
  4420. (100 nil 10 10 0))
  4421. (letter
  4422. (1 nil 1 1 0)
  4423. (2 t 1 2 0) ; adjusted by PostScript code
  4424. (4 nil 2 2 0)
  4425. (6 t 2 3 0)
  4426. (9 nil 3 3 0)
  4427. (12 nil 4 3 1)
  4428. (16 nil 4 4 0)
  4429. (20 nil 5 4 1)
  4430. (25 nil 5 5 0)
  4431. (30 nil 6 5 1)
  4432. (36 nil 6 6 0)
  4433. (40 t 5 8 0)
  4434. (42 nil 7 6 1)
  4435. (49 nil 7 7 0)
  4436. (56 nil 8 7 1)
  4437. (64 nil 8 8 0)
  4438. (72 nil 9 8 1)
  4439. (81 nil 9 9 0)
  4440. (90 nil 10 9 1)
  4441. (100 nil 10 10 0))
  4442. (legal
  4443. (1 nil 1 1 0)
  4444. (2 t 1 2 0)
  4445. (4 nil 2 2 0)
  4446. (6 nil 3 2 1)
  4447. (9 nil 3 3 0)
  4448. (10 t 2 5 0)
  4449. (12 nil 4 3 1)
  4450. (16 nil 4 4 0)
  4451. (20 nil 5 4 1)
  4452. (25 nil 5 5 0)
  4453. (30 nil 6 5 1)
  4454. (36 nil 6 6 0)
  4455. (42 nil 7 6 1)
  4456. (49 nil 7 7 0)
  4457. (56 nil 8 7 1)
  4458. (64 nil 8 8 0)
  4459. (70 t 5 14 0)
  4460. (72 nil 9 8 1)
  4461. (81 nil 9 9 0)
  4462. (90 nil 10 9 1)
  4463. (100 nil 10 10 0))
  4464. (letter-small
  4465. (1 nil 1 1 0)
  4466. (2 t 1 2 0) ; adjusted by PostScript code
  4467. (4 nil 2 2 0)
  4468. (6 t 2 3 0)
  4469. (9 nil 3 3 0)
  4470. (12 t 3 4 1)
  4471. (15 t 3 5 0)
  4472. (16 nil 4 4 0)
  4473. (20 nil 5 4 1)
  4474. (25 nil 5 5 0)
  4475. (28 t 4 7 0)
  4476. (30 nil 6 5 1)
  4477. (36 nil 6 6 0)
  4478. (40 t 5 8 0)
  4479. (42 nil 7 6 1)
  4480. (49 nil 7 7 0)
  4481. (56 nil 8 7 1)
  4482. (60 t 6 10 0)
  4483. (64 nil 8 8 0)
  4484. (72 ni 9 8 1)
  4485. (81 nil 9 9 0)
  4486. (84 t 7 12 0)
  4487. (90 nil 10 9 1)
  4488. (100 nil 10 10 0))
  4489. (tabloid
  4490. (1 nil 1 1 0)
  4491. (2 t 1 2 0)
  4492. (4 nil 2 2 0)
  4493. (6 t 2 3 1)
  4494. (8 t 2 4 0)
  4495. (9 nil 3 3 0)
  4496. (12 nil 4 3 1)
  4497. (16 nil 4 4 0)
  4498. (20 nil 5 4 1)
  4499. (25 nil 5 5 0)
  4500. (30 nil 6 5 1)
  4501. (36 nil 6 6 0)
  4502. (42 nil 7 6 1)
  4503. (49 nil 7 7 0)
  4504. (56 nil 8 7 1)
  4505. (64 nil 8 8 0)
  4506. (72 nil 9 8 1)
  4507. (81 nil 9 9 0)
  4508. (84 t 6 14 0)
  4509. (90 nil 10 9 1)
  4510. (100 nil 10 10 0))
  4511. ;; Ledger paper size is a special case, it is the only paper size where the
  4512. ;; normal size is landscaped, that is, the height is smaller than width.
  4513. ;; So, we use the special value `pag' in the `landscape' field.
  4514. (ledger
  4515. (1 nil 1 1 0)
  4516. (2 pag 1 2 0)
  4517. (4 nil 2 2 0)
  4518. (6 pag 2 3 1)
  4519. (8 pag 2 4 0)
  4520. (9 nil 3 3 0)
  4521. (12 nil 4 3 1)
  4522. (16 nil 4 4 0)
  4523. (20 nil 5 4 1)
  4524. (25 nil 5 5 0)
  4525. (30 nil 6 5 1)
  4526. (36 nil 6 6 0)
  4527. (42 nil 7 6 1)
  4528. (49 nil 7 7 0)
  4529. (56 nil 8 7 1)
  4530. (64 nil 8 8 0)
  4531. (72 nil 9 8 1)
  4532. (81 nil 9 9 0)
  4533. (84 pag 6 14 0)
  4534. (90 nil 10 9 1)
  4535. (100 nil 10 10 0))
  4536. (statement
  4537. (1 nil 1 1 0)
  4538. (2 t 1 2 0)
  4539. (4 nil 2 2 0)
  4540. (6 nil 3 2 1)
  4541. (9 nil 3 3 0)
  4542. (10 t 2 5 0)
  4543. (12 nil 4 3 1)
  4544. (16 nil 4 4 0)
  4545. (20 nil 5 4 1)
  4546. (21 t 3 7 0)
  4547. (25 nil 5 5 0)
  4548. (30 nil 6 5 1)
  4549. (36 nil 6 6 0)
  4550. (40 t 4 10 0)
  4551. (42 nil 7 6 1)
  4552. (49 nil 7 7 0)
  4553. (56 nil 8 7 1)
  4554. (60 t 5 12 0)
  4555. (64 nil 8 8 0)
  4556. (72 nil 9 8 1)
  4557. (81 nil 9 9 0)
  4558. (90 nil 10 9 1)
  4559. (100 nil 10 10 0))
  4560. (executive
  4561. (1 nil 1 1 0)
  4562. (2 t 1 2 0) ; adjusted by PostScript code
  4563. (4 nil 2 2 0)
  4564. (6 t 2 3 0)
  4565. (9 nil 3 3 0)
  4566. (12 nil 4 3 1)
  4567. (16 nil 4 4 0)
  4568. (20 nil 5 4 1)
  4569. (25 nil 5 5 0)
  4570. (28 t 4 7 0)
  4571. (30 nil 6 5 1)
  4572. (36 nil 6 6 0)
  4573. (42 nil 7 6 1)
  4574. (45 t 5 9 0)
  4575. (49 nil 7 7 0)
  4576. (56 nil 8 7 1)
  4577. (60 t 6 10 0)
  4578. (64 nil 8 8 0)
  4579. (72 nil 9 8 1)
  4580. (81 nil 9 9 0)
  4581. (84 t 7 12 0)
  4582. (90 nil 10 9 1)
  4583. (100 nil 10 10 0))
  4584. (a4small
  4585. (1 nil 1 1 0)
  4586. (2 t 1 2 0)
  4587. (4 nil 2 2 0)
  4588. (6 t 2 3 1)
  4589. (8 t 2 4 0)
  4590. (9 nil 3 3 0)
  4591. (12 nil 4 3 1)
  4592. (16 nil 4 4 0)
  4593. (18 t 3 6 0)
  4594. (20 nil 5 4 1)
  4595. (25 nil 5 5 0)
  4596. (30 nil 6 5 1)
  4597. (32 t 4 8 0)
  4598. (36 nil 6 6 0)
  4599. (42 nil 7 6 1)
  4600. (49 nil 7 7 0)
  4601. (50 t 5 10 0)
  4602. (56 nil 8 7 1)
  4603. (64 nil 8 8 0)
  4604. (72 nil 9 8 1)
  4605. (78 t 6 13 0)
  4606. (81 nil 9 9 0)
  4607. (90 nil 10 9 1)
  4608. (100 nil 10 10 0))
  4609. (b4
  4610. (1 nil 1 1 0)
  4611. (2 t 1 2 0)
  4612. (4 nil 2 2 0)
  4613. (6 t 2 3 1)
  4614. (8 t 2 4 0)
  4615. (9 nil 3 3 0)
  4616. (12 nil 4 3 1)
  4617. (16 nil 4 4 0)
  4618. (18 t 3 6 0)
  4619. (20 nil 5 4 1)
  4620. (25 nil 5 5 0)
  4621. (30 nil 6 5 1)
  4622. (32 t 4 8 0)
  4623. (36 nil 6 6 0)
  4624. (42 nil 7 6 1)
  4625. (49 nil 7 7 0)
  4626. (50 t 5 10 0)
  4627. (56 nil 8 7 1)
  4628. (64 nil 8 8 0)
  4629. (72 nil 9 8 1)
  4630. (81 nil 9 9 0)
  4631. (90 nil 10 9 1)
  4632. (100 nil 10 10 0))
  4633. (b5
  4634. (1 nil 1 1 0)
  4635. (2 t 1 2 0)
  4636. (4 nil 2 2 0)
  4637. (6 t 2 3 1)
  4638. (8 t 2 4 0)
  4639. (9 nil 3 3 0)
  4640. (12 nil 4 3 1)
  4641. (16 nil 4 4 0)
  4642. (18 t 3 6 0)
  4643. (20 nil 5 4 1)
  4644. (25 nil 5 5 0)
  4645. (30 nil 6 5 1)
  4646. (32 t 4 8 0)
  4647. (36 nil 6 6 0)
  4648. (42 nil 7 6 1)
  4649. (49 nil 7 7 0)
  4650. (50 t 5 10 0)
  4651. (56 nil 8 7 1)
  4652. (64 nil 8 8 0)
  4653. (72 nil 9 8 0)
  4654. (81 nil 9 9 0)
  4655. (90 nil 10 9 1)
  4656. (98 t 7 14 0)
  4657. (100 nil 10 10 0)))
  4658. "Alist which is the page matrix database used for N-up printing.
  4659. Each element has the following form:
  4660. (PAGE
  4661. (MAX LANDSCAPE LINES COLUMNS COL-MISSING)
  4662. ...)
  4663. Where:
  4664. PAGE is the page size used (see `ps-paper-type').
  4665. MAX is the maximum elements of this page matrix.
  4666. LANDSCAPE specifies if page matrix is landscaped, has the following valid
  4667. values:
  4668. nil the sheet is in portrait mode.
  4669. t the sheet is in landscape mode.
  4670. pag the sheet is in portrait mode and page is in landscape mode.
  4671. LINES is the number of lines of page matrix.
  4672. COLUMNS is the number of columns of page matrix.
  4673. COL-MISSING is the number of columns missing to fill the sheet.")
  4674. (defmacro ps-n-up-landscape (mat) `(nth 1 ,mat))
  4675. (defmacro ps-n-up-lines (mat) `(nth 2 ,mat))
  4676. (defmacro ps-n-up-columns (mat) `(nth 3 ,mat))
  4677. (defmacro ps-n-up-missing (mat) `(nth 4 ,mat))
  4678. (defun ps-n-up-printing ()
  4679. ;; force `ps-n-up-printing' be in range 1 to 100.
  4680. (setq ps-n-up-printing (max (min ps-n-up-printing 100) 1))
  4681. ;; find suitable page matrix for a given `ps-paper-type'.
  4682. (let ((the-list (cdr (assq ps-paper-type ps-n-up-database))))
  4683. (and the-list
  4684. (while (> ps-n-up-printing (caar the-list))
  4685. (setq the-list (cdr the-list))))
  4686. (or (car the-list)
  4687. '(1 nil 1 1 0))))
  4688. (defconst ps-n-up-filling-database
  4689. '((left-top
  4690. "PageWidth" ; N-Up-XColumn
  4691. "0" ; N-Up-YColumn
  4692. "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
  4693. "LandscapePageHeight neg" ; N-Up-YLine
  4694. "N-Up-Lines" ; N-Up-Repeat
  4695. "N-Up-Columns" ; N-Up-End
  4696. "0" ; N-Up-XStart
  4697. "0") ; N-Up-YStart
  4698. (left-bottom
  4699. "PageWidth" ; N-Up-XColumn
  4700. "0" ; N-Up-YColumn
  4701. "N-Up-End 1 sub PageWidth mul neg" ; N-Up-XLine
  4702. "LandscapePageHeight" ; N-Up-YLine
  4703. "N-Up-Lines" ; N-Up-Repeat
  4704. "N-Up-Columns" ; N-Up-End
  4705. "0" ; N-Up-XStart
  4706. "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
  4707. (right-top
  4708. "PageWidth neg" ; N-Up-XColumn
  4709. "0" ; N-Up-YColumn
  4710. "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
  4711. "LandscapePageHeight neg" ; N-Up-YLine
  4712. "N-Up-Lines" ; N-Up-Repeat
  4713. "N-Up-Columns" ; N-Up-End
  4714. "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
  4715. "0") ; N-Up-YStart
  4716. (right-bottom
  4717. "PageWidth neg" ; N-Up-XColumn
  4718. "0" ; N-Up-YColumn
  4719. "N-Up-End 1 sub PageWidth mul" ; N-Up-XLine
  4720. "LandscapePageHeight" ; N-Up-YLine
  4721. "N-Up-Lines" ; N-Up-Repeat
  4722. "N-Up-Columns" ; N-Up-End
  4723. "N-Up-End 1 sub PageWidth mul" ; N-Up-XStart
  4724. "N-Up-Repeat 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
  4725. (top-left
  4726. "0" ; N-Up-XColumn
  4727. "LandscapePageHeight neg" ; N-Up-YColumn
  4728. "PageWidth" ; N-Up-XLine
  4729. "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
  4730. "N-Up-Columns" ; N-Up-Repeat
  4731. "N-Up-Lines" ; N-Up-End
  4732. "0" ; N-Up-XStart
  4733. "0") ; N-Up-YStart
  4734. (bottom-left
  4735. "0" ; N-Up-XColumn
  4736. "LandscapePageHeight" ; N-Up-YColumn
  4737. "PageWidth" ; N-Up-XLine
  4738. "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
  4739. "N-Up-Columns" ; N-Up-Repeat
  4740. "N-Up-Lines" ; N-Up-End
  4741. "0" ; N-Up-XStart
  4742. "N-Up-End 1 sub LandscapePageHeight mul neg") ; N-Up-YStart
  4743. (top-right
  4744. "0" ; N-Up-XColumn
  4745. "LandscapePageHeight neg" ; N-Up-YColumn
  4746. "PageWidth neg" ; N-Up-XLine
  4747. "N-Up-End 1 sub LandscapePageHeight mul" ; N-Up-YLine
  4748. "N-Up-Columns" ; N-Up-Repeat
  4749. "N-Up-Lines" ; N-Up-End
  4750. "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
  4751. "0") ; N-Up-YStart
  4752. (bottom-right
  4753. "0" ; N-Up-XColumn
  4754. "LandscapePageHeight" ; N-Up-YColumn
  4755. "PageWidth neg" ; N-Up-XLine
  4756. "N-Up-End 1 sub LandscapePageHeight mul neg" ; N-Up-YLine
  4757. "N-Up-Columns" ; N-Up-Repeat
  4758. "N-Up-Lines" ; N-Up-End
  4759. "N-Up-Repeat 1 sub PageWidth mul" ; N-Up-XStart
  4760. "N-Up-End 1 sub LandscapePageHeight mul neg")) ; N-Up-YStart
  4761. "Alist for n-up printing initializations.
  4762. Each element has the following form:
  4763. (KIND XCOL YCOL XLIN YLIN REPEAT END XSTART YSTART)
  4764. Where:
  4765. KIND is a valid value of `ps-n-up-filling'.
  4766. XCOL YCOL are the relative position for the next column.
  4767. XLIN YLIN are the relative position for the beginning of next line.
  4768. REPEAT is the number of repetitions for external loop.
  4769. END is the number of repetitions for internal loop and also the number
  4770. of pages in a row.
  4771. XSTART YSTART are the relative position for the first page in a sheet.")
  4772. (defun ps-n-up-filling ()
  4773. (cdr (or (assq ps-n-up-filling ps-n-up-filling-database)
  4774. (assq 'left-top ps-n-up-filling-database))))
  4775. (defmacro ps-n-up-xcolumn (init) `(nth 0 ,init))
  4776. (defmacro ps-n-up-ycolumn (init) `(nth 1 ,init))
  4777. (defmacro ps-n-up-xline (init) `(nth 2 ,init))
  4778. (defmacro ps-n-up-yline (init) `(nth 3 ,init))
  4779. (defmacro ps-n-up-repeat (init) `(nth 4 ,init))
  4780. (defmacro ps-n-up-end (init) `(nth 5 ,init))
  4781. (defmacro ps-n-up-xstart (init) `(nth 6 ,init))
  4782. (defmacro ps-n-up-ystart (init) `(nth 7 ,init))
  4783. (defconst ps-error-handler-alist
  4784. '((none . 0)
  4785. (paper . 1)
  4786. (system . 2)
  4787. (paper-and-system . 3))
  4788. "Alist for error handler message.")
  4789. (defconst ps-zebra-stripe-alist
  4790. '((follow . 1)
  4791. (full . 2)
  4792. (full-follow . 3))
  4793. "Alist for zebra stripe continuation.")
  4794. (defun ps-begin-file ()
  4795. (setq ps-page-order 0
  4796. ps-page-printed 0
  4797. ps-background-text-count 0
  4798. ps-background-image-count 0
  4799. ps-background-pages nil
  4800. ps-background-all-pages nil)
  4801. (let ((dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
  4802. (tumble (if ps-landscape-mode (not ps-spool-tumble) ps-spool-tumble))
  4803. (n-up (ps-n-up-printing))
  4804. (n-up-filling (ps-n-up-filling)))
  4805. (and ps-n-up-on (setq tumble (not tumble)))
  4806. (ps-output
  4807. ps-adobe-tag
  4808. "%%Title: " (buffer-name) ; Take job name from name of
  4809. ; first buffer printed
  4810. "\n%%Creator: ps-print v" ps-print-version
  4811. "\n%%For: " (user-full-name)
  4812. "\n%%CreationDate: " (format-time-string "%T %b %d %Y")
  4813. "\n%%Orientation: "
  4814. (if ps-landscape-mode "Landscape" "Portrait")
  4815. "\n%%DocumentNeededResources: font Times-Roman Times-Italic\n%%+ font "
  4816. (mapconcat 'identity
  4817. (ps-remove-duplicates
  4818. (append (ps-fonts 'ps-font-for-text)
  4819. (list (ps-font 'ps-font-for-header 'normal)
  4820. (ps-font 'ps-font-for-header 'bold)
  4821. (ps-font 'ps-font-for-footer 'normal)
  4822. (ps-font 'ps-font-for-footer 'bold))))
  4823. "\n%%+ font ")
  4824. "\n%%DocumentSuppliedResources: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0"
  4825. "\n%%DocumentMedia: " (ps-page-dimensions-get-media dimensions)
  4826. (format " %d" (round (ps-page-dimensions-get-width dimensions)))
  4827. (format " %d" (round (ps-page-dimensions-get-height dimensions)))
  4828. " 0 () ()\n%%PageOrder: Ascend\n%%Pages: (atend)\n%%Requirements:"
  4829. (if ps-spool-duplex
  4830. (if tumble " duplex(tumble)\n" " duplex\n")
  4831. "\n"))
  4832. (ps-insert-string ps-print-prologue-header)
  4833. (ps-output "%%EndComments\n%%BeginDefaults\n%%PageMedia: "
  4834. (ps-page-dimensions-get-media dimensions)
  4835. "\n%%EndDefaults\n\n%%BeginProlog\n\n"
  4836. "/languagelevel where{pop}{/languagelevel 1 def}ifelse\n"
  4837. (format "/ErrorMessage %s def\n\n"
  4838. (or (cdr (assoc ps-error-handler-message
  4839. ps-error-handler-alist))
  4840. 1)) ; send to paper
  4841. ps-print-prologue-0
  4842. "\n%%BeginResource: procset PSPrintUserDefinedPrologue-" (user-login-name) " 0 0\n\n")
  4843. (ps-insert-string ps-user-defined-prologue)
  4844. (ps-output "\n%%EndResource\n\n")
  4845. (ps-output-boolean "LandscapeMode "
  4846. (or ps-landscape-mode
  4847. (eq (ps-n-up-landscape n-up) 'pag)))
  4848. (ps-output-boolean "UpsideDown " ps-print-upside-down)
  4849. (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns)
  4850. (format "/LandscapePageHeight %s def\n" ps-landscape-page-height)
  4851. (format "/PrintPageWidth %s def\n"
  4852. (- (* (+ ps-print-width ps-inter-column)
  4853. ps-number-of-columns)
  4854. ps-inter-column))
  4855. (format "/PrintWidth %s def\n" ps-print-width)
  4856. (format "/PrintHeight %s def\n" ps-print-height)
  4857. (format "/LeftMargin %s def\n" ps-left-margin)
  4858. (format "/RightMargin %s def\n" ps-right-margin)
  4859. (format "/InterColumn %s def\n" ps-inter-column)
  4860. (format "/BottomMargin %s def\n" ps-bottom-margin)
  4861. (format "/TopMargin %s def\n" ps-top-margin) ; not used
  4862. (format "/HeaderOffset %s def\n" ps-header-offset)
  4863. (format "/HeaderPad %s def\n" ps-header-pad)
  4864. (format "/FooterOffset %s def\n" ps-footer-offset)
  4865. (format "/FooterPad %s def\n" ps-footer-pad)
  4866. (format "/FooterLines %s def\n" ps-footer-lines))
  4867. (ps-output-boolean "ShowNofN " ps-show-n-of-n)
  4868. (ps-output-boolean "SwitchHeader " (if (eq ps-switch-header 'duplex)
  4869. ps-spool-duplex
  4870. ps-switch-header))
  4871. (ps-output-boolean "PrintOnlyOneHeader" ps-print-only-one-header)
  4872. (ps-output-boolean "PrintHeader " ps-print-header)
  4873. (ps-output-boolean "PrintHeaderFrame " ps-print-header-frame)
  4874. (ps-output-frame-properties "HeaderFrameProperties" ps-header-frame-alist)
  4875. (ps-output-boolean "PrintFooter " ps-print-footer)
  4876. (ps-output-boolean "PrintFooterFrame " ps-print-footer-frame)
  4877. (ps-output-frame-properties "FooterFrameProperties" ps-footer-frame-alist)
  4878. (let ((line-height (ps-line-height 'ps-font-for-text)))
  4879. (ps-output (format "/LineSpacing %s def\n" ps-line-spacing-internal)
  4880. (format "/ParagraphSpacing %s def\n"
  4881. ps-paragraph-spacing-internal)
  4882. (format "/LineHeight %s def\n" line-height)
  4883. (format "/LinesPerColumn %d def\n"
  4884. (let ((height (+ line-height
  4885. ps-line-spacing-internal)))
  4886. (round (/ (+ ps-print-height
  4887. (* height 0.45))
  4888. height))))))
  4889. (ps-output-boolean "WarnPaperSize " ps-warn-paper-type)
  4890. (ps-output-boolean "Zebra " ps-zebra-stripes)
  4891. (ps-output-boolean "PrintLineNumber " ps-line-number)
  4892. (ps-output-boolean "SyncLineZebra " (not (integerp ps-line-number-step)))
  4893. (ps-output (format "/ZebraFollow %d def\n"
  4894. (or (cdr (assq ps-zebra-stripe-follow
  4895. ps-zebra-stripe-alist))
  4896. 0))
  4897. (format "/PrintLineStep %d def\n"
  4898. (if (integerp ps-line-number-step)
  4899. ps-line-number-step
  4900. ps-zebra-stripe-height))
  4901. (format "/PrintLineStart %d def\n" ps-line-number-start)
  4902. "/LineNumberColor "
  4903. (ps-format-color ps-line-number-color 0.0)
  4904. (format "def\n/ZebraHeight %d def\n"
  4905. ps-zebra-stripe-height)
  4906. "/ZebraColor "
  4907. (ps-format-color ps-zebra-color 0.95)
  4908. "def\n")
  4909. (ps-output "/BackgroundColor "
  4910. (ps-format-color ps-default-background 1.0)
  4911. "def\n")
  4912. (ps-output "/UseSetpagedevice "
  4913. (if (eq ps-spool-config 'setpagedevice)
  4914. "/setpagedevice where{pop languagelevel 2 eq}{false}ifelse"
  4915. "false")
  4916. " def\n\n/PageWidth "
  4917. "PrintPageWidth LeftMargin add RightMargin add def\n\n"
  4918. (format "/N-Up %d def\n" ps-n-up-printing))
  4919. (ps-output-boolean "N-Up-Landscape" (eq (ps-n-up-landscape n-up) t))
  4920. (ps-output-boolean "N-Up-Border " ps-n-up-border-p)
  4921. (ps-output (format "/N-Up-Lines %d def\n" (ps-n-up-lines n-up))
  4922. (format "/N-Up-Columns %d def\n" (ps-n-up-columns n-up))
  4923. (format "/N-Up-Missing %d def\n" (ps-n-up-missing n-up))
  4924. (format "/N-Up-Margin %s def\n" ps-n-up-margin)
  4925. "/N-Up-Repeat "
  4926. (if ps-landscape-mode
  4927. (ps-n-up-end n-up-filling)
  4928. (ps-n-up-repeat n-up-filling))
  4929. " def\n/N-Up-End "
  4930. (if ps-landscape-mode
  4931. (ps-n-up-repeat n-up-filling)
  4932. (ps-n-up-end n-up-filling))
  4933. " def\n/N-Up-XColumn " (ps-n-up-xcolumn n-up-filling)
  4934. " def\n/N-Up-YColumn " (ps-n-up-ycolumn n-up-filling)
  4935. " def\n/N-Up-XLine " (ps-n-up-xline n-up-filling)
  4936. " def\n/N-Up-YLine " (ps-n-up-yline n-up-filling)
  4937. " def\n/N-Up-XStart " (ps-n-up-xstart n-up-filling)
  4938. " def\n/N-Up-YStart " (ps-n-up-ystart n-up-filling) " def\n")
  4939. (ps-background-text)
  4940. (ps-background-image)
  4941. (setq ps-background-all-pages (nreverse ps-background-all-pages)
  4942. ps-background-pages (nreverse ps-background-pages))
  4943. (ps-output "\n" ps-print-prologue-1
  4944. "\n/printGlobalBackground{\n")
  4945. (mapc 'ps-output ps-background-all-pages)
  4946. (ps-output
  4947. "}def\n/printLocalBackground{\n}def\n"
  4948. "\n%%EndProlog\n\n%%BeginSetup\n"
  4949. "\n%%IncludeResource: font Times-Roman"
  4950. "\n%%IncludeResource: font Times-Italic"
  4951. "\n%%IncludeResource: font "
  4952. (mapconcat 'identity
  4953. (ps-remove-duplicates
  4954. (append (ps-fonts 'ps-font-for-text)
  4955. (list (ps-font 'ps-font-for-header 'normal)
  4956. (ps-font 'ps-font-for-header 'bold)
  4957. (ps-font 'ps-font-for-footer 'normal)
  4958. (ps-font 'ps-font-for-footer 'bold))))
  4959. "\n%%IncludeResource: font ")
  4960. ;; Header/line number fonts
  4961. (format "\n/h0 %s(%s)cvn DefFont\n" ; /h0 14/Helvetica-Bold DefFont
  4962. ps-header-title-font-size-internal
  4963. (ps-font 'ps-font-for-header 'bold))
  4964. (format "/h1 %s(%s)cvn DefFont\n" ; /h1 12/Helvetica DefFont
  4965. ps-header-font-size-internal
  4966. (ps-font 'ps-font-for-header 'normal))
  4967. (format "/L0 %s(%s)cvn DefFont\n" ; /L0 6/Times-Italic DefFont
  4968. (ps-get-font-size 'ps-line-number-font-size)
  4969. ps-line-number-font)
  4970. (format "/H0 %s(%s)cvn DefFont\n" ; /H0 12/Helvetica DefFont
  4971. ps-footer-font-size-internal
  4972. (ps-font 'ps-font-for-footer 'normal))
  4973. "\n\n% ---- These lines must be kept together because...
  4974. /h0 F
  4975. /HeaderTitleLineHeight FontHeight def
  4976. /h1 F
  4977. /HeaderLineHeight FontHeight def
  4978. /HeaderDescent Descent def
  4979. /H0 F
  4980. /FooterLineHeight FontHeight def
  4981. /FooterDescent Descent def
  4982. % ---- ...because `F' has a side-effect on `FontHeight' and `Descent'\n\n")
  4983. ;; Text fonts
  4984. (let ((font (ps-font-alist 'ps-font-for-text))
  4985. (i 0))
  4986. (while font
  4987. (ps-output (format "/f%d %s(%s)cvn DefFont\n"
  4988. i
  4989. ps-font-size-internal
  4990. (ps-font 'ps-font-for-text (car (car font)))))
  4991. (setq font (cdr font)
  4992. i (1+ i))))
  4993. (let ((font-entry (cdr (assq ps-font-family ps-font-info-database))))
  4994. (ps-output (format "/SpaceWidthRatio %f def\n"
  4995. (/ (ps-lookup 'space-width) (ps-lookup 'size)))))
  4996. (unless (eq ps-spool-config 'lpr-switches)
  4997. (ps-output "\n%%BeginFeature: *Duplex "
  4998. (ps-boolean-capitalized ps-spool-duplex)
  4999. " *Tumble "
  5000. (ps-boolean-capitalized tumble)
  5001. "\nUseSetpagedevice\n{BMark/Duplex "
  5002. (ps-boolean-constant ps-spool-duplex)
  5003. "/Tumble "
  5004. (ps-boolean-constant tumble)
  5005. " EMark setpagedevice}\n{statusdict begin "
  5006. (ps-boolean-constant ps-spool-duplex)
  5007. " setduplexmode "
  5008. (ps-boolean-constant tumble)
  5009. " settumble end}ifelse\n%%EndFeature\n")))
  5010. (ps-output "\n%%BeginFeature: *ManualFeed "
  5011. (ps-boolean-capitalized ps-manual-feed)
  5012. "\nBMark /ManualFeed "
  5013. (ps-boolean-constant ps-manual-feed)
  5014. " EMark setpagedevice\n%%EndFeature\n\nBeginDoc\n%%EndSetup\n")
  5015. (and ps-banner-page-when-duplexing
  5016. (ps-output "\n%%Page: banner 0\nsave showpage restore\n")))
  5017. (defun ps-format-color (color &optional default)
  5018. (let ((the-color (if (stringp color)
  5019. (ps-color-scale color)
  5020. color)))
  5021. (if (and the-color (listp the-color))
  5022. (concat "["
  5023. (format ps-color-format
  5024. (* (nth 0 the-color) 1.0) ; force float number
  5025. (* (nth 1 the-color) 1.0) ; force float number
  5026. (* (nth 2 the-color) 1.0)) ; force float number
  5027. "] ")
  5028. (ps-float-format (if (numberp the-color) the-color default)))))
  5029. (defun ps-insert-string (prologue)
  5030. (let ((str (if (functionp prologue)
  5031. (funcall prologue)
  5032. prologue)))
  5033. (and (stringp str)
  5034. (ps-output str))))
  5035. (defun ps-boolean-capitalized (bool)
  5036. (if bool "True" "False"))
  5037. (defun ps-boolean-constant (bool)
  5038. (if bool "true" "false"))
  5039. (defun ps-header-dirpart ()
  5040. (let ((fname (buffer-file-name)))
  5041. (if fname
  5042. (if (string-equal (buffer-name) (file-name-nondirectory fname))
  5043. (abbreviate-file-name (file-name-directory fname))
  5044. fname)
  5045. "")))
  5046. (defun ps-get-buffer-name ()
  5047. (cond
  5048. ;; Indulge Jim this little easter egg:
  5049. ((string= (buffer-name) "ps-print.el")
  5050. "Hey, Cool! It's ps-print.el!!!")
  5051. ;; Indulge Jack this other little easter egg:
  5052. ((string= (buffer-name) "sokoban.el")
  5053. "Super! C'est sokoban.el!")
  5054. (t (concat
  5055. (and ps-printing-region-p "Subset of: ")
  5056. (buffer-name)
  5057. (and (buffer-modified-p) " (unsaved)")))))
  5058. (defun ps-get-size (size mess &optional arg)
  5059. (let ((siz (cond ((numberp size)
  5060. size)
  5061. ((and (consp size)
  5062. (numberp (car size))
  5063. (numberp (cdr size)))
  5064. (if ps-landscape-mode
  5065. (car size)
  5066. (cdr size)))
  5067. (t
  5068. -1))))
  5069. (and (< siz 0)
  5070. (error "Invalid %s `%S'%s"
  5071. mess size
  5072. (if arg
  5073. (format " for `%S'" arg)
  5074. "")))
  5075. siz))
  5076. (defun ps-get-font-size (font-sym)
  5077. (ps-get-size (symbol-value font-sym) "font size" font-sym))
  5078. (defun ps-rgb-color (color unspecified default)
  5079. (cond
  5080. ;; (float float float) ==> (R G B)
  5081. ((and color (listp color) (= (length color) 3)
  5082. (let ((cl color)
  5083. (ok t) e)
  5084. (while (and ok cl)
  5085. (setq e (car cl)
  5086. cl (cdr cl)
  5087. ok (and (floatp e) (<= 0.0 e) (<= e 1.0))))
  5088. ok))
  5089. color)
  5090. ;; float ==> 0.0 = black .. 1.0 = white
  5091. ((and (floatp color) (<= 0.0 color) (<= color 1.0))
  5092. (list color color color))
  5093. ;; "colorName" but different from "unspecified-[bf]g"
  5094. ((and (stringp color) (not (string= color unspecified)))
  5095. (ps-color-scale color))
  5096. ;; ok, use the default
  5097. (t
  5098. (list default default default))))
  5099. (defvar ps-basic-plot-string-function 'ps-basic-plot-string)
  5100. (defun ps-begin-job (genfunc)
  5101. ;; prologue files
  5102. (or (equal ps-mark-code-directory ps-postscript-code-directory)
  5103. (setq ps-print-prologue-0 (ps-prologue-file 0)
  5104. ps-print-prologue-1 (ps-prologue-file 1)
  5105. ps-mark-code-directory ps-postscript-code-directory))
  5106. ;; selected pages
  5107. (let (new page)
  5108. (while ps-selected-pages
  5109. (setq page (car ps-selected-pages)
  5110. ps-selected-pages (cdr ps-selected-pages))
  5111. (cond ((integerp page)
  5112. (and (> page 0)
  5113. (setq new (cons (cons page page) new))))
  5114. ((consp page)
  5115. (and (integerp (car page)) (integerp (cdr page))
  5116. (> (car page) 0)
  5117. (<= (car page) (cdr page))
  5118. (setq new (cons page new))))))
  5119. (setq ps-selected-pages (sort new #'(lambda (one other)
  5120. (< (car one) (car other))))
  5121. ps-last-selected-pages ps-selected-pages
  5122. ps-first-page nil
  5123. ps-last-page nil))
  5124. ;; face background
  5125. (or (listp ps-use-face-background)
  5126. (setq ps-use-face-background t))
  5127. ;; line number
  5128. (and (integerp ps-line-number-step)
  5129. (<= ps-line-number-step 0)
  5130. (setq ps-line-number-step 1))
  5131. (setq ps-n-up-on (> ps-n-up-printing 1)
  5132. ps-line-number-start (max 1 (min ps-line-number-start
  5133. (if (integerp ps-line-number-step)
  5134. ps-line-number-step
  5135. ps-zebra-stripe-height))))
  5136. ;; spooling buffer
  5137. (with-current-buffer ps-spool-buffer
  5138. (goto-char (point-max))
  5139. (and (re-search-backward "^%%Trailer$" nil t)
  5140. (delete-region (match-beginning 0) (point-max))))
  5141. ;; miscellaneous
  5142. (setq ps-zebra-stripe-full-p (memq ps-zebra-stripe-follow
  5143. '(full full-follow))
  5144. ps-page-postscript 0
  5145. ps-page-sheet 0
  5146. ps-page-n-up 0
  5147. ps-page-column 0
  5148. ps-lines-printed 0
  5149. ps-print-page-p t
  5150. ps-showline-count (car ps-printing-region)
  5151. ps-line-spacing-internal (ps-get-size ps-line-spacing
  5152. "line spacing")
  5153. ps-paragraph-spacing-internal (ps-get-size ps-paragraph-spacing
  5154. "paragraph spacing")
  5155. ps-font-size-internal (ps-get-font-size 'ps-font-size)
  5156. ps-header-font-size-internal (ps-get-font-size 'ps-header-font-size)
  5157. ps-header-title-font-size-internal
  5158. (ps-get-font-size 'ps-header-title-font-size)
  5159. ps-footer-font-size-internal (ps-get-font-size 'ps-footer-font-size)
  5160. ps-control-or-escape-regexp
  5161. (cond ((eq ps-print-control-characters '8-bit)
  5162. (string-as-unibyte "[\000-\037\177-\377]"))
  5163. ((eq ps-print-control-characters 'control-8-bit)
  5164. (string-as-unibyte "[\000-\037\177-\237]"))
  5165. ((eq ps-print-control-characters 'control)
  5166. "[\000-\037\177]")
  5167. (t "[\t\n\f]"))
  5168. ;; Set the color scale. We do it here instead of in the defvar so
  5169. ;; that ps-print can be dumped into emacs. This expression can't be
  5170. ;; evaluated at dump-time because X isn't initialized.
  5171. ps-color-p (and ps-print-color-p (ps-color-device))
  5172. ps-print-color-scale (if ps-color-p
  5173. (float (car (ps-color-values "white")))
  5174. 1.0)
  5175. ps-default-background (ps-rgb-color
  5176. (cond
  5177. ((or (member ps-print-color-p
  5178. '(nil back-white))
  5179. (eq genfunc 'ps-generate-postscript))
  5180. nil)
  5181. ((eq ps-default-bg 'frame-parameter)
  5182. (ps-frame-parameter nil 'background-color))
  5183. ((eq ps-default-bg t)
  5184. (ps-face-background-name 'default))
  5185. (t
  5186. ps-default-bg))
  5187. "unspecified-bg"
  5188. 1.0)
  5189. ps-default-foreground (ps-rgb-color
  5190. (cond
  5191. ((or (member ps-print-color-p
  5192. '(nil back-white))
  5193. (eq genfunc 'ps-generate-postscript))
  5194. nil)
  5195. ((eq ps-default-fg 'frame-parameter)
  5196. (ps-frame-parameter nil 'foreground-color))
  5197. ((eq ps-default-fg t)
  5198. (ps-face-foreground-name 'default))
  5199. (t
  5200. ps-default-fg))
  5201. "unspecified-fg"
  5202. 0.0)
  5203. ps-foreground-list (mapcar
  5204. #'(lambda (arg)
  5205. (ps-rgb-color arg "unspecified-fg" 0.0))
  5206. (append (and (not (member ps-print-color-p
  5207. '(nil back-white)))
  5208. ps-fg-list)
  5209. (list ps-default-foreground
  5210. "black")))
  5211. ps-default-color (and (not (member ps-print-color-p
  5212. '(nil back-white)))
  5213. ps-default-foreground)
  5214. ps-current-color ps-default-color
  5215. ;; Set up default functions.
  5216. ;; They may be overridden by ps-mule-begin-job.
  5217. ps-basic-plot-string-function 'ps-basic-plot-string
  5218. ps-encode-header-string-function nil)
  5219. ;; initialize page dimensions
  5220. (ps-get-page-dimensions)
  5221. ;; final check
  5222. (unless (listp ps-lpr-switches)
  5223. (error "`ps-lpr-switches' value should be a list"))
  5224. (and ps-color-p
  5225. (equal ps-default-background ps-default-foreground)
  5226. (error
  5227. (concat
  5228. "`ps-default-fg' and `ps-default-bg' have the same color.\n"
  5229. "Text won't appear on page. Please, check these variables."))))
  5230. (defun ps-page-number ()
  5231. (if ps-print-only-one-header
  5232. (1+ (/ (1- ps-page-column) ps-number-of-columns))
  5233. ps-page-column))
  5234. (defsubst ps-end-page ()
  5235. (ps-output "EndPage\nEndDSCPage\n"))
  5236. (defsubst ps-next-page ()
  5237. (ps-end-page)
  5238. (ps-flush-output)
  5239. (ps-begin-page))
  5240. (defun ps-end-sheet ()
  5241. (and ps-print-page-p (> ps-page-sheet 0)
  5242. (ps-output "EndSheet\n")))
  5243. (defun ps-header-sheet ()
  5244. ;; Print only when a new sheet begins.
  5245. (ps-end-sheet)
  5246. (setq ps-page-sheet (1+ ps-page-sheet))
  5247. (when (ps-print-sheet-p)
  5248. (setq ps-page-order (1+ ps-page-order))
  5249. (ps-output (if ps-n-up-on
  5250. (format "\n%%%%Page: (%d \\(%d\\)) %d\n"
  5251. ps-page-order ps-page-postscript ps-page-order)
  5252. (format "\n%%%%Page: %d %d\n"
  5253. ps-page-postscript ps-page-order))
  5254. ;; spooling needs to redefine Lines and PageCount on each page
  5255. "/Lines 0 def\n/PageCount 0 def\n"
  5256. (format "%d BeginSheet\nBeginDSCPage\n"
  5257. ps-n-up-printing))))
  5258. (defun ps-header-page ()
  5259. ;; set total line and page number when printing has finished
  5260. ;; (see `ps-generate')
  5261. (if (zerop (mod ps-page-column ps-number-of-columns))
  5262. (progn
  5263. (setq ps-page-postscript (1+ ps-page-postscript))
  5264. (when (ps-print-page-p)
  5265. (ps-print-sheet-p)
  5266. (if (zerop (mod ps-page-n-up ps-n-up-printing))
  5267. ;; Print only when a new sheet begins.
  5268. (progn
  5269. (ps-header-sheet)
  5270. (run-hooks 'ps-print-begin-sheet-hook))
  5271. ;; Print only when a new page begins.
  5272. (ps-output "BeginDSCPage\n")
  5273. (run-hooks 'ps-print-begin-page-hook))
  5274. (ps-background ps-page-postscript)
  5275. (setq ps-page-n-up (1+ ps-page-n-up))
  5276. (and ps-print-page-p
  5277. (setq ps-page-printed (1+ ps-page-printed)))))
  5278. ;; Print only when a new column begins.
  5279. (ps-output "BeginDSCPage\n")
  5280. (run-hooks 'ps-print-begin-column-hook))
  5281. (setq ps-page-column (1+ ps-page-column)))
  5282. (defun ps-begin-page ()
  5283. (setq ps-width-remaining ps-print-width
  5284. ps-height-remaining ps-print-height)
  5285. (ps-header-page)
  5286. (ps-output (format "/LineNumber %d def\n" ps-showline-count)
  5287. (format "/PageNumber %d def\n" (ps-page-number)))
  5288. (when ps-print-header
  5289. (ps-generate-header "HeaderLinesLeft" "/h0" "/h1" ps-left-header)
  5290. (ps-generate-header "HeaderLinesRight" "/h0" "/h1" ps-right-header)
  5291. (ps-output (format "%d SetHeaderLines\n" ps-header-lines)))
  5292. (when ps-print-footer
  5293. (ps-generate-header "FooterLinesLeft" "/H0" "/H0" ps-left-footer)
  5294. (ps-generate-header "FooterLinesRight" "/H0" "/H0" ps-right-footer)
  5295. (ps-output (format "%d SetFooterLines\n" ps-footer-lines)))
  5296. (ps-output (number-to-string ps-lines-printed) " BeginPage\n")
  5297. (ps-set-font ps-current-font)
  5298. (ps-set-bg ps-current-bg)
  5299. (ps-set-color ps-current-color))
  5300. (defsubst ps-skip-newline (limit)
  5301. (setq ps-showline-count (1+ ps-showline-count)
  5302. ps-lines-printed (1+ ps-lines-printed))
  5303. (and (< (point) limit)
  5304. (forward-char 1)))
  5305. (defsubst ps-next-line ()
  5306. (setq ps-showline-count (1+ ps-showline-count)
  5307. ps-lines-printed (1+ ps-lines-printed))
  5308. (let* ((paragraph-p (and ps-paragraph-regexp
  5309. (looking-at ps-paragraph-regexp)))
  5310. (lh (+ (ps-line-height 'ps-font-for-text)
  5311. (if paragraph-p
  5312. ps-paragraph-spacing-internal
  5313. ps-line-spacing-internal))))
  5314. (if (< ps-height-remaining lh)
  5315. (ps-next-page)
  5316. (setq ps-width-remaining ps-print-width
  5317. ps-height-remaining (- ps-height-remaining lh))
  5318. (ps-output (if paragraph-p "PHL\n" "LHL\n")))))
  5319. (defun ps-continue-line ()
  5320. (setq ps-lines-printed (1+ ps-lines-printed))
  5321. (let ((lh (+ (ps-line-height 'ps-font-for-text) ps-line-spacing-internal)))
  5322. (if (< ps-height-remaining lh)
  5323. (ps-next-page)
  5324. (setq ps-width-remaining ps-print-width
  5325. ps-height-remaining (- ps-height-remaining lh))
  5326. (ps-output "SL\n"))))
  5327. (defun ps-find-wrappoint (from to char-width)
  5328. (let ((avail (truncate (/ ps-width-remaining char-width)))
  5329. (todo (- to from)))
  5330. (if (< todo avail)
  5331. (cons to (* todo char-width))
  5332. (cons (+ from avail) ps-width-remaining))))
  5333. (defun ps-basic-plot-str (from to string)
  5334. (let* ((wrappoint (ps-find-wrappoint from to
  5335. (ps-avg-char-width 'ps-font-for-text)))
  5336. (to (car wrappoint))
  5337. (str (substring string from to)))
  5338. (ps-output-string str)
  5339. (ps-output " S\n")
  5340. wrappoint))
  5341. (defun ps-basic-plot-string (from to &optional _bg-color)
  5342. (let* ((wrappoint (ps-find-wrappoint from to
  5343. (ps-avg-char-width 'ps-font-for-text)))
  5344. (to (car wrappoint))
  5345. (string (buffer-substring-no-properties from to)))
  5346. (ps-output-string string)
  5347. (ps-output " S\n")
  5348. wrappoint))
  5349. (defun ps-basic-plot-whitespace (from to &optional _bg-color)
  5350. (let* ((wrappoint (ps-find-wrappoint from to
  5351. (ps-space-width 'ps-font-for-text)))
  5352. (to (car wrappoint)))
  5353. (ps-output (format "%d W\n" (- to from)))
  5354. wrappoint))
  5355. (defun ps-plot (plotfunc from to &optional bg-color)
  5356. (while (< from to)
  5357. (let* ((wrappoint (funcall plotfunc from to bg-color))
  5358. (plotted-to (car wrappoint))
  5359. (plotted-width (cdr wrappoint)))
  5360. (setq from plotted-to
  5361. ps-width-remaining (- ps-width-remaining plotted-width))
  5362. (if (< from to)
  5363. (ps-continue-line))))
  5364. (if ps-razzle-dazzle
  5365. (let* ((q-todo (- (point-max) (point-min)))
  5366. (q-done (- (point) (point-min)))
  5367. (chunkfrac (/ q-todo 8))
  5368. (chunksize (min chunkfrac 1000)))
  5369. (if (> (- q-done ps-razchunk) chunksize)
  5370. (progn
  5371. (setq ps-razchunk q-done)
  5372. (message "Formatting...%3d%%"
  5373. (if (< q-todo 100)
  5374. (/ (* 100 q-done) q-todo)
  5375. (/ q-done (/ q-todo 100)))
  5376. ))))))
  5377. (defvar ps-last-font nil)
  5378. (defun ps-set-font (font)
  5379. (setq ps-last-font (format "f%d" (setq ps-current-font font)))
  5380. (ps-output (format "/%s F\n" ps-last-font)))
  5381. (defun ps-set-bg (color)
  5382. (if (setq ps-current-bg color)
  5383. (ps-output (format ps-color-format
  5384. (nth 0 color) (nth 1 color) (nth 2 color))
  5385. " true BG\n")
  5386. (ps-output "false BG\n")))
  5387. (defun ps-set-color (color)
  5388. (setq ps-current-color (or color ps-default-foreground))
  5389. (ps-output (format ps-color-format
  5390. (nth 0 ps-current-color)
  5391. (nth 1 ps-current-color) (nth 2 ps-current-color))
  5392. " FG\n"))
  5393. (defsubst ps-plot-string (string)
  5394. (ps-plot 'ps-basic-plot-str 0 (length string) string))
  5395. (defvar ps-current-effect 0)
  5396. (defvar ps-print-translation-table
  5397. (let ((tbl (make-char-table 'translation-table nil)))
  5398. (if (and (boundp 'ucs-mule-8859-to-mule-unicode)
  5399. (char-table-p ucs-mule-8859-to-mule-unicode))
  5400. (map-char-table
  5401. #'(lambda (k v)
  5402. (if (and v (eq (char-charset v) 'latin-iso8859-1) (/= k v))
  5403. (aset tbl k v)))
  5404. ucs-mule-8859-to-mule-unicode))
  5405. tbl)
  5406. "Translation table for PostScript printing.
  5407. The default value is a table that translates non-Latin-1 Latin characters
  5408. to the equivalent Latin-1 characters.")
  5409. (defun ps-plot-region (from to font &optional fg-color bg-color effects)
  5410. (or (equal font ps-current-font)
  5411. (ps-set-font font))
  5412. ;; Specify a foreground color only if:
  5413. ;; one's specified,
  5414. ;; it's different than the background (if `ps-fg-validate-p' is non-nil)
  5415. ;; and it's different than the current.
  5416. (let ((fg (or fg-color ps-default-foreground)))
  5417. (if ps-fg-validate-p
  5418. (let ((bg (or bg-color ps-default-background))
  5419. (el ps-foreground-list))
  5420. (while (and el (equal fg bg))
  5421. (setq fg (car el)
  5422. el (cdr el)))))
  5423. (or (equal fg ps-current-color)
  5424. (ps-set-color fg)))
  5425. (or (equal bg-color ps-current-bg)
  5426. (ps-set-bg bg-color))
  5427. ;; Specify effects (underline, overline, box, etc.)
  5428. (cond
  5429. ((not (integerp effects))
  5430. (ps-output "0 EF\n")
  5431. (setq ps-current-effect 0))
  5432. ((/= effects ps-current-effect)
  5433. (ps-output (number-to-string effects) " EF\n")
  5434. (setq ps-current-effect effects)))
  5435. ;; Starting at the beginning of the specified region...
  5436. (save-excursion
  5437. (goto-char from)
  5438. ;; ...break the region up into chunks separated by tabs, linefeeds,
  5439. ;; pagefeeds, control characters, and plot each chunk.
  5440. (while (< from to)
  5441. ;; skip lines between cut markers
  5442. (and ps-begin-cut-regexp ps-end-cut-regexp
  5443. (looking-at ps-begin-cut-regexp)
  5444. (progn
  5445. (goto-char (match-end 0))
  5446. (and (re-search-forward ps-end-cut-regexp to 'noerror)
  5447. (= (following-char) ?\n)
  5448. (forward-char 1))
  5449. (setq from (point))))
  5450. (if (re-search-forward ps-control-or-escape-regexp to t)
  5451. ;; region with some control characters or some multi-byte characters
  5452. (let* ((match-point (match-beginning 0))
  5453. (match (char-after match-point)))
  5454. (when (< from match-point)
  5455. (ps-plot ps-basic-plot-string-function
  5456. from match-point bg-color))
  5457. (cond
  5458. ((= match ?\t) ; tab
  5459. (let ((linestart (line-beginning-position)))
  5460. (forward-char -1)
  5461. (setq from (+ linestart (current-column)))
  5462. (when (re-search-forward "[ \t]+" to t)
  5463. (ps-plot 'ps-basic-plot-whitespace
  5464. from (+ linestart (current-column))
  5465. bg-color))))
  5466. ((= match ?\n) ; newline
  5467. (if (looking-at "\f[^\n]")
  5468. ;; \n\ftext\n ==>> next page, but keep line counting!!
  5469. (progn
  5470. (ps-skip-newline to)
  5471. (ps-next-page))
  5472. ;; \n\f\n ==>> it'll be handled by form feed
  5473. ;; \ntext\n ==>> next line
  5474. (ps-next-line)))
  5475. ((= match ?\f) ; form feed
  5476. ;; do not skip page if previous character is NEWLINE and
  5477. ;; it is a beginning of page.
  5478. (unless (and (equal (char-after (1- match-point)) ?\n)
  5479. (= ps-height-remaining ps-print-height))
  5480. ;; \f\n ==>> skip \n, but keep line counting!!
  5481. (and (equal (following-char) ?\n)
  5482. (ps-skip-newline to))
  5483. (ps-next-page)))
  5484. (t ; characters from 127 to 255
  5485. (ps-control-character match)))
  5486. (setq from (point)))
  5487. ;; region without control characters
  5488. (ps-plot ps-basic-plot-string-function from to bg-color)
  5489. (setq from to)))))
  5490. (defvar ps-string-control-codes
  5491. (let ((table (make-vector 256 nil))
  5492. (char ?\000))
  5493. ;; control character
  5494. (while (<= char ?\037)
  5495. (aset table char (format "^%c" (+ char ?@)))
  5496. (setq char (1+ char)))
  5497. ;; printable character
  5498. (while (< char ?\177)
  5499. (aset table char (format "%c" char))
  5500. (setq char (1+ char)))
  5501. ;; DEL
  5502. (aset table char "^?")
  5503. ;; 8-bit character
  5504. (while (<= (setq char (1+ char)) ?\377)
  5505. (aset table char (format "\\%o" char)))
  5506. table)
  5507. "Vector used to map characters to a printable string.")
  5508. (defun ps-control-character (char)
  5509. (let* ((str (aref ps-string-control-codes char))
  5510. (from (1- (point)))
  5511. (len (length str))
  5512. (to (+ from len))
  5513. (char-width (ps-avg-char-width 'ps-font-for-text))
  5514. (wrappoint (ps-find-wrappoint from to char-width)))
  5515. (if (< (car wrappoint) to)
  5516. (ps-continue-line))
  5517. (setq ps-width-remaining (- ps-width-remaining (* len char-width)))
  5518. (ps-output-string str)
  5519. (ps-output " S\n")))
  5520. (defsubst ps-face-foreground-color-p (attr)
  5521. (memq attr '(foreground-color :foreground)))
  5522. (defsubst ps-face-background-color-p (attr)
  5523. (memq attr '(background-color :background)))
  5524. (defsubst ps-face-color-p (attr)
  5525. (memq attr '(foreground-color :foreground background-color :background)))
  5526. (defun ps-face-extract-color (face-attrs)
  5527. (let ((color (cdr face-attrs)))
  5528. (if (listp color)
  5529. (car color)
  5530. color)))
  5531. (defun ps-face-attributes (face)
  5532. "Return face attribute vector.
  5533. If FACE is not in `ps-print-face-extension-alist' or in
  5534. `ps-print-face-alist', insert it on `ps-print-face-alist' and
  5535. return the attribute vector.
  5536. If FACE is not a valid face name, use default face."
  5537. (and (stringp face) (facep face) (setq face (intern face)))
  5538. (cond
  5539. (ps-black-white-faces-alist
  5540. (or (and (symbolp face)
  5541. (cdr (assq face ps-black-white-faces-alist)))
  5542. (vector 0 nil nil)))
  5543. ((symbolp face)
  5544. (cdr (or (assq face ps-print-face-extension-alist)
  5545. (assq face ps-print-face-alist)
  5546. (let* ((the-face (if (facep face) face 'default))
  5547. (new-face (ps-screen-to-bit-face the-face)))
  5548. (or (and (eq the-face 'default)
  5549. (assq the-face ps-print-face-alist))
  5550. (setq ps-print-face-alist
  5551. (cons new-face ps-print-face-alist)))
  5552. new-face))))
  5553. ((ps-face-foreground-color-p (car face))
  5554. (vector 0 (ps-face-extract-color face) nil))
  5555. ((ps-face-background-color-p (car face))
  5556. (vector 0 nil (ps-face-extract-color face)))
  5557. (t
  5558. (vector 0 nil nil))))
  5559. (defun ps-face-background (face background)
  5560. (and (cond ((eq ps-use-face-background t)) ; always
  5561. ((null ps-use-face-background) nil) ; never
  5562. ;; ps-user-face-background is a symbol face list
  5563. ((symbolp face)
  5564. (memq face ps-use-face-background))
  5565. ((listp face)
  5566. (or (ps-face-color-p (car face))
  5567. (let (ok)
  5568. (while face
  5569. (if (or (memq (car face) ps-use-face-background)
  5570. (ps-face-color-p (car face)))
  5571. (setq face nil
  5572. ok t)
  5573. (setq face (cdr face))))
  5574. ok)))
  5575. (t
  5576. nil)
  5577. )
  5578. background))
  5579. (defun ps-face-attribute-list (face-or-list)
  5580. (cond
  5581. ;; simple face
  5582. ((not (listp face-or-list))
  5583. (ps-face-attributes face-or-list))
  5584. ;; only foreground color, not a `real' face
  5585. ((ps-face-foreground-color-p (car face-or-list))
  5586. (vector 0 (ps-face-extract-color face-or-list) nil))
  5587. ;; only background color, not a `real' face
  5588. ((ps-face-background-color-p (car face-or-list))
  5589. (vector 0 nil (ps-face-extract-color face-or-list)))
  5590. ;; list of faces
  5591. (t
  5592. (let ((effects 0)
  5593. foreground background face-attr face)
  5594. (while face-or-list
  5595. (setq face (car face-or-list)
  5596. face-or-list (cdr face-or-list)
  5597. face-attr (ps-face-attributes face)
  5598. effects (logior effects (aref face-attr 0)))
  5599. (or foreground (setq foreground (aref face-attr 1)))
  5600. (or background
  5601. (setq background (ps-face-background face (aref face-attr 2)))))
  5602. (vector effects foreground background)))))
  5603. (defconst ps-font-type (vector nil 'bold 'italic 'bold-italic))
  5604. (defun ps-plot-with-face (from to face)
  5605. (cond
  5606. ((null face) ; print text with null face
  5607. (ps-plot-region from to 0))
  5608. ((eq face 'emacs--invisible--face)) ; skip invisible text!!!
  5609. (t ; otherwise, text has a valid face
  5610. (let* ((face-bit (ps-face-attribute-list face))
  5611. (effect (aref face-bit 0))
  5612. (foreground (aref face-bit 1))
  5613. (background (ps-face-background face (aref face-bit 2)))
  5614. (fg-color (if (and ps-color-p foreground)
  5615. (ps-color-scale foreground)
  5616. ps-default-color))
  5617. (bg-color (and ps-color-p background
  5618. (ps-color-scale background))))
  5619. (ps-plot-region
  5620. from to
  5621. (ps-font-number 'ps-font-for-text
  5622. (or (aref ps-font-type (logand effect 3))
  5623. face))
  5624. fg-color bg-color (lsh effect -2)))))
  5625. (goto-char to))
  5626. ;; Ensure that face-list is fbound.
  5627. (or (fboundp 'face-list) (defalias 'face-list 'list-faces))
  5628. (defun ps-build-reference-face-lists ()
  5629. ;; Ensure that face database is updated with faces on
  5630. ;; `font-lock-face-attributes' (obsolete stuff)
  5631. (ps-font-lock-face-attributes)
  5632. ;; Now, rebuild reference face lists
  5633. (setq ps-print-face-alist nil)
  5634. (if ps-auto-font-detect
  5635. (mapc 'ps-map-face (face-list))
  5636. (mapc 'ps-set-face-bold ps-bold-faces)
  5637. (mapc 'ps-set-face-italic ps-italic-faces)
  5638. (mapc 'ps-set-face-underline ps-underlined-faces))
  5639. (setq ps-build-face-reference nil))
  5640. (defun ps-set-face-bold (face)
  5641. (ps-set-face-attribute face 1))
  5642. (defun ps-set-face-italic (face)
  5643. (ps-set-face-attribute face 2))
  5644. (defun ps-set-face-underline (face)
  5645. (ps-set-face-attribute face 4))
  5646. (defun ps-set-face-attribute (face effect)
  5647. (let ((face-bit (cdr (ps-map-face face))))
  5648. (aset face-bit 0 (logior (aref face-bit 0) effect))))
  5649. (defun ps-map-face (face)
  5650. (let* ((face-map (ps-screen-to-bit-face face))
  5651. (ps-face-bit (cdr (assq (car face-map) ps-print-face-alist))))
  5652. (if ps-face-bit
  5653. ;; if face exists, merge both
  5654. (let ((face-bit (cdr face-map)))
  5655. (aset ps-face-bit 0 (logior (aref ps-face-bit 0) (aref face-bit 0)))
  5656. (or (aref ps-face-bit 1) (aset ps-face-bit 1 (aref face-bit 1)))
  5657. (or (aref ps-face-bit 2) (aset ps-face-bit 2 (aref face-bit 2))))
  5658. ;; if face does not exist, insert it
  5659. (setq ps-print-face-alist (cons face-map ps-print-face-alist)))
  5660. face-map))
  5661. (defun ps-screen-to-bit-face (face)
  5662. (cons face
  5663. (vector (logior (if (ps-face-bold-p face) 1 0) ; bold
  5664. (if (ps-face-italic-p face) 2 0) ; italic
  5665. (if (ps-face-underlined-p face) 4 0) ; underline
  5666. (if (ps-face-strikeout-p face) 8 0) ; strikeout
  5667. (if (ps-face-overline-p face) 16 0) ; overline
  5668. (if (ps-face-box-p face) 64 0)) ; box
  5669. (ps-face-foreground-name face)
  5670. (ps-face-background-name face))))
  5671. (declare-function jit-lock-fontify-now "jit-lock" (&optional start end))
  5672. (declare-function lazy-lock-fontify-region "lazy-lock" (beg end))
  5673. ;; to avoid compilation gripes
  5674. (defun ps-print-ensure-fontified (start end)
  5675. (cond ((and (boundp 'jit-lock-mode) (symbol-value 'jit-lock-mode))
  5676. (jit-lock-fontify-now start end))
  5677. ((and (boundp 'lazy-lock-mode) (symbol-value 'lazy-lock-mode))
  5678. (lazy-lock-fontify-region start end))))
  5679. (defun ps-generate-postscript-with-faces (from to)
  5680. ;; Some initialization...
  5681. (setq ps-current-effect 0)
  5682. ;; Build the reference lists of faces if necessary.
  5683. (when (or ps-always-build-face-reference
  5684. ps-build-face-reference)
  5685. (message "Collecting face information...")
  5686. (ps-build-reference-face-lists))
  5687. ;; Black/white printer.
  5688. (setq ps-black-white-faces-alist nil)
  5689. (and (eq ps-print-color-p 'black-white)
  5690. (ps-extend-face-list ps-black-white-faces nil
  5691. 'ps-black-white-faces-alist))
  5692. ;; Generate some PostScript.
  5693. (save-restriction
  5694. (narrow-to-region from to)
  5695. (ps-print-ensure-fontified from to)
  5696. (ps-generate-postscript-with-faces1 from to)))
  5697. (defun ps-generate-postscript (from to)
  5698. (ps-plot-region from to 0))
  5699. ;; These are autoloaded, but ps-mule generates autoloads at the end of
  5700. ;; this file, so they are unknown at this point when compiling.
  5701. (declare-function ps-mule-initialize "ps-mule" ())
  5702. (declare-function ps-mule-begin-job "ps-mule" (from to))
  5703. (declare-function ps-mule-end-job "ps-mule" ())
  5704. (defun ps-generate (buffer from to genfunc)
  5705. (save-excursion
  5706. (let ((from (min to from))
  5707. (to (max to from))
  5708. ;; This avoids trouble if chars with read-only properties
  5709. ;; are copied into ps-spool-buffer.
  5710. (inhibit-read-only t))
  5711. (save-restriction
  5712. (narrow-to-region from to)
  5713. (and ps-razzle-dazzle
  5714. (message "Formatting...%3d%%" (setq ps-razchunk 0)))
  5715. (setq ps-source-buffer buffer
  5716. ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
  5717. (ps-init-output-queue)
  5718. (let (safe-marker completed-safely needs-begin-file)
  5719. (unwind-protect
  5720. (progn
  5721. (set-buffer ps-spool-buffer)
  5722. (set-buffer-multibyte nil)
  5723. ;; Get a marker and make it point to the current end of the
  5724. ;; buffer, If an error occurs, we'll delete everything from
  5725. ;; the end of this marker onwards.
  5726. (setq safe-marker (make-marker))
  5727. (set-marker safe-marker (point-max))
  5728. (goto-char (point-min))
  5729. (or (looking-at (regexp-quote ps-adobe-tag))
  5730. (setq needs-begin-file t))
  5731. (set-buffer ps-source-buffer)
  5732. (save-excursion
  5733. (let ((ps-print-page-p t)
  5734. ps-even-or-odd-pages)
  5735. (ps-begin-job genfunc)
  5736. (when needs-begin-file
  5737. (ps-begin-file)
  5738. (ps-mule-initialize))
  5739. (ps-mule-begin-job from to)
  5740. (ps-selected-pages)))
  5741. (ps-begin-page)
  5742. (funcall genfunc from to)
  5743. (ps-end-page)
  5744. (ps-mule-end-job)
  5745. (ps-end-job needs-begin-file)
  5746. ;; Setting this variable tells the unwind form that the
  5747. ;; the PostScript was generated without error.
  5748. (setq completed-safely t))
  5749. ;; Unwind form: If some bad mojo occurred while generating
  5750. ;; PostScript, delete all the PostScript that was generated.
  5751. ;; This protects the previously spooled files from getting
  5752. ;; corrupted.
  5753. (and (markerp safe-marker) (not completed-safely)
  5754. (progn
  5755. (set-buffer ps-spool-buffer)
  5756. (delete-region (marker-position safe-marker) (point-max))))))
  5757. (and ps-razzle-dazzle (message "Formatting...done"))))))
  5758. (defun ps-end-job (needs-begin-file)
  5759. (let ((ps-print-page-p t))
  5760. (ps-flush-output)
  5761. (save-excursion
  5762. (let ((pages-per-sheet (mod ps-page-printed ps-n-up-printing))
  5763. (total-lines (cdr ps-printing-region))
  5764. (total-pages (ps-page-number)))
  5765. (set-buffer ps-spool-buffer)
  5766. (let (case-fold-search)
  5767. ;; Back to the PS output buffer to set the last page n-up printing
  5768. (goto-char (point-max))
  5769. (and (> pages-per-sheet 0)
  5770. (re-search-backward "^[0-9]+ BeginSheet$" nil t)
  5771. (replace-match (format "%d BeginSheet" pages-per-sheet) t))
  5772. ;; Back to the PS output buffer to set the page count
  5773. (goto-char (point-min))
  5774. (while (re-search-forward "^/Lines 0 def\n/PageCount 0 def$" nil t)
  5775. (replace-match (format "/Lines %d def\n/PageCount %d def"
  5776. total-lines total-pages) t)))))
  5777. ;; Set dummy page
  5778. (and ps-spool-duplex (= (mod ps-page-order 2) 1)
  5779. (let ((ps-n-up-printing 0))
  5780. (ps-header-sheet)
  5781. (ps-output "/PrintHeader false def\n/ColumnIndex 0 def\n"
  5782. "/PrintLineNumber false def\n"
  5783. (number-to-string ps-lines-printed) " BeginPage\n")
  5784. (ps-end-page)))
  5785. ;; Set end of PostScript file
  5786. (ps-end-sheet)
  5787. (ps-output "\n%%Trailer\n%%Pages: "
  5788. (number-to-string
  5789. (if (and needs-begin-file
  5790. ps-banner-page-when-duplexing)
  5791. (1+ ps-page-order)
  5792. ps-page-order))
  5793. "\n\nEndDoc\n\n%%EOF\n")
  5794. (and ps-end-with-control-d
  5795. (ps-output "\C-d"))
  5796. (ps-flush-output))
  5797. ;; disable selected pages
  5798. (setq ps-selected-pages nil))
  5799. ;; Permit dynamic evaluation at print time of `ps-lpr-switches'.
  5800. (defun ps-do-despool (filename)
  5801. (if (or (not (boundp 'ps-spool-buffer))
  5802. (not (symbol-value 'ps-spool-buffer)))
  5803. (message "No spooled PostScript to print")
  5804. (if filename
  5805. (save-excursion
  5806. (and ps-razzle-dazzle (message "Saving..."))
  5807. (set-buffer ps-spool-buffer)
  5808. (setq filename (expand-file-name filename))
  5809. (let ((coding-system-for-write 'raw-text-unix))
  5810. (write-region (point-min) (point-max) filename))
  5811. (and ps-razzle-dazzle (message "Wrote %s" filename)))
  5812. ;; Else, spool to the printer
  5813. (and ps-razzle-dazzle (message "Printing..."))
  5814. (with-current-buffer ps-spool-buffer
  5815. (let* ((coding-system-for-write 'raw-text-unix)
  5816. (ps-printer-name (or ps-printer-name
  5817. (and (boundp 'printer-name)
  5818. (symbol-value 'printer-name))))
  5819. (ps-lpr-switches
  5820. (append ps-lpr-switches
  5821. (and (stringp ps-printer-name)
  5822. (string< "" ps-printer-name)
  5823. (list (concat
  5824. (and (stringp ps-printer-name-option)
  5825. ps-printer-name-option)
  5826. ps-printer-name))))))
  5827. (or (stringp ps-printer-name)
  5828. (setq ps-printer-name nil))
  5829. (apply (or ps-print-region-function 'call-process-region)
  5830. (point-min) (point-max) ps-lpr-command nil
  5831. (and (fboundp 'start-process) 0)
  5832. nil
  5833. (ps-flatten-list ; dynamic evaluation
  5834. (ps-string-list
  5835. (mapcar 'ps-eval-switch ps-lpr-switches))))))
  5836. (and ps-razzle-dazzle (message "Printing...done")))
  5837. (kill-buffer ps-spool-buffer)))
  5838. (defun ps-string-list (arg)
  5839. (let (lstr)
  5840. (dolist (elm arg)
  5841. (cond ((stringp elm)
  5842. (setq lstr (cons elm lstr)))
  5843. ((listp elm)
  5844. (let ((s (ps-string-list elm)))
  5845. (when s
  5846. (setq lstr (cons s lstr)))))
  5847. (t ))) ; ignore any other value
  5848. (nreverse lstr)))
  5849. ;; Dynamic evaluation
  5850. (defun ps-eval-switch (arg)
  5851. (cond ((stringp arg) arg)
  5852. ((functionp arg) (apply arg nil))
  5853. ((symbolp arg) (symbol-value arg))
  5854. ((consp arg) (apply (car arg) (cdr arg)))
  5855. (t nil)))
  5856. ;; `ps-flatten-list' is defined here (copied from "message.el" and
  5857. ;; enhanced to handle dotted pairs as well) until we can get some
  5858. ;; sensible autoloads, or `flatten-list' gets put somewhere decent.
  5859. ;; (ps-flatten-list '((a . b) c (d . e) (f g h) i . j))
  5860. ;; => (a b c d e f g h i j)
  5861. (defun ps-flatten-list (&rest list)
  5862. (ps-flatten-list-1 list))
  5863. (defun ps-flatten-list-1 (list)
  5864. (cond ((null list) nil)
  5865. ((consp list) (append (ps-flatten-list-1 (car list))
  5866. (ps-flatten-list-1 (cdr list))))
  5867. (t (list list))))
  5868. (defun ps-kill-emacs-check ()
  5869. (let (ps-buffer)
  5870. (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
  5871. (buffer-name ps-buffer) ; check if it's not killed
  5872. (buffer-modified-p ps-buffer)
  5873. (y-or-n-p "Unprinted PostScript waiting; print now? ")
  5874. (ps-despool))
  5875. (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
  5876. (buffer-name ps-buffer) ; check if it's not killed
  5877. (buffer-modified-p ps-buffer)
  5878. (not (yes-or-no-p "Unprinted PostScript waiting; exit anyway? "))
  5879. (error "Unprinted PostScript"))))
  5880. (cond ((fboundp 'add-hook)
  5881. (unless noninteractive
  5882. (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)))
  5883. (kill-emacs-hook
  5884. (message "Won't override existing `kill-emacs-hook'"))
  5885. (t
  5886. (setq kill-emacs-hook 'ps-kill-emacs-check)))
  5887. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5888. ;; To make this file smaller, some commands go in a separate file.
  5889. ;; But autoload them here to make the separation invisible.
  5890. ;;;### (autoloads (ps-mule-end-job ps-mule-begin-job ps-mule-initialize
  5891. ;;;;;; ps-multibyte-buffer) "ps-mule" "ps-mule.el" "86bf8e46dac41afe73df5ab098038ab0")
  5892. ;;; Generated autoloads from ps-mule.el
  5893. (defvar ps-multibyte-buffer nil "\
  5894. Specifies the multi-byte buffer handling.
  5895. Valid values are:
  5896. nil This is the value to use the default settings;
  5897. by default, this only works to print buffers with
  5898. only ASCII and Latin characters. But this default
  5899. setting can be changed by setting the variable
  5900. `ps-mule-font-info-database-default' differently.
  5901. The initial value of this variable is
  5902. `ps-mule-font-info-database-latin' (see
  5903. documentation).
  5904. `non-latin-printer' This is the value to use when you have a Japanese
  5905. or Korean PostScript printer and want to print
  5906. buffer with ASCII, Latin-1, Japanese (JISX0208 and
  5907. JISX0201-Kana) and Korean characters. At present,
  5908. it was not tested with the Korean characters
  5909. printing. If you have a korean PostScript printer,
  5910. please, test it.
  5911. `bdf-font' This is the value to use when you want to print
  5912. buffer with BDF fonts. BDF fonts include both latin
  5913. and non-latin fonts. BDF (Bitmap Distribution
  5914. Format) is a format used for distributing X's font
  5915. source file. BDF fonts are included in
  5916. `intlfonts-1.2' which is a collection of X11 fonts
  5917. for all characters supported by Emacs. In order to
  5918. use this value, be sure to have installed
  5919. `intlfonts-1.2' and set the variable
  5920. `bdf-directory-list' appropriately (see ps-bdf.el for
  5921. documentation of this variable).
  5922. `bdf-font-except-latin' This is like `bdf-font' except that it uses
  5923. PostScript default fonts to print ASCII and Latin-1
  5924. characters. This is convenient when you want or
  5925. need to use both latin and non-latin characters on
  5926. the same buffer. See `ps-font-family',
  5927. `ps-header-font-family' and `ps-font-info-database'.
  5928. Any other value is treated as nil.")
  5929. (custom-autoload 'ps-multibyte-buffer "ps-mule" t)
  5930. (autoload 'ps-mule-initialize "ps-mule" "\
  5931. Initialize global data for printing multi-byte characters.
  5932. \(fn)" nil nil)
  5933. (autoload 'ps-mule-begin-job "ps-mule" "\
  5934. Start printing job for multi-byte chars between FROM and TO.
  5935. It checks if all multi-byte characters in the region are printable or not.
  5936. \(fn FROM TO)" nil nil)
  5937. (autoload 'ps-mule-end-job "ps-mule" "\
  5938. Finish printing job for multi-byte chars.
  5939. \(fn)" nil nil)
  5940. ;;;***
  5941. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  5942. (provide 'ps-print)
  5943. ;;; ps-print.el ends here