feedmail.el 137 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181
  1. ;;; feedmail.el --- assist other email packages to massage outgoing messages
  2. ;;; This file is in the public domain.
  3. ;; This file is part of GNU Emacs.
  4. ;; Author: Bill Carpenter <bill@carpenter.ORG>
  5. ;; Version: 11
  6. ;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
  7. ;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html>
  8. ;;; Commentary:
  9. ;; A replacement for parts of sendmail.el (specifically,
  10. ;; it's what handles your outgoing mail after you hit C-c C-c in mail
  11. ;; mode). See below for a list of additional features, including the
  12. ;; ability to queue messages for later sending. This replaces
  13. ;; the standalone fakemail program that used to be distributed with Emacs.
  14. ;; feedmail works with recent versions of Emacs (20.x series) and
  15. ;; XEmacs (tested with 20.4 and later betas). It probably no longer
  16. ;; works with Emacs v18, though I haven't tried that in a long
  17. ;; time. Makoto.Nakagawa@jp.compaq.com reports: "I have a report
  18. ;; that with a help of APEL library, feedmail works fine under emacs
  19. ;; 19.28. You can get APEL from ftp://ftp.m17n.org/pub/mule/apel/.
  20. ;; you need apel-10.2 or later to make feedmail work under emacs
  21. ;; 19.28."
  22. ;; Sorry, no manual yet in this release. Look for one with the next
  23. ;; release. Or the one after that. Or maybe later.
  24. ;; As far as I'm concerned, anyone can do anything they want with
  25. ;; this specific piece of code. No warranty or promise of support is
  26. ;; offered. This code is hereby released into the public domain.
  27. ;; Thanks: My thanks to the many people who have sent me suggestions
  28. ;; and fixes over time, as well as those who have tested many beta
  29. ;; iterations. Some are cited in comments in code fragments below,
  30. ;; but that doesn't correlate well with the list of folks who have
  31. ;; actually helped me along the way.
  32. ;; If you use feedmail, I invite you to send me some email about it.
  33. ;; I appreciate feedback about problems you find or suggestions for
  34. ;; improvements or added features (even though I can't predict when
  35. ;; I'll incorporate changes). It's also OK with me if you send me a
  36. ;; note along the lines of "I use feedmail and find it useful" or "I
  37. ;; tried feedmail and didn't find it useful, so I stopped using it".
  38. ;;
  39. ;; It is most useful, when sending a bug report, if you tell me what
  40. ;; version of Emacs you are using, what version of feedmail you are
  41. ;; using, and what versions of other email-related elisp packages you
  42. ;; are using. If in doubt about any of that, send the bug report
  43. ;; anyhow.
  44. ;;
  45. ;; =====
  46. ;; A NOTE TO THOSE WHO WOULD CHANGE THIS CODE... Since it is PD,
  47. ;; you're within your rights to do whatever you want. If you do
  48. ;; publish a new version with your changes in it, please (1) insert
  49. ;; lisp comments describing the changes, (2) insert lisp comments
  50. ;; that clearly delimit where your changes are, (3) email me a copy
  51. ;; (I can't always consistently follow the relevant usenet groups),
  52. ;; and (4) use a version number that is based on the version you're
  53. ;; changing along with something that indicates you changed it. For
  54. ;; example,
  55. ;;
  56. ;; (defconst feedmail-patch-level "123")
  57. ;; (defconst feedmail-patch-level "123-XYZ-mods")
  58. ;;
  59. ;; The point of the last item, of course, is to try to minimize
  60. ;; confusion. Odds are good that if your idea makes sense to me that
  61. ;; it will show up in some future version of feedmail, though it's
  62. ;; hard to say when releases will tumble out.
  63. ;; =====
  64. ;;
  65. ;; This file requires the mail-utils library.
  66. ;;
  67. ;; This file requires the smtpmail library if you use
  68. ;; feedmail-buffer-to-smtpmail. It requires the smtp library if
  69. ;; you use feedmail-buffer-smtp.
  70. ;;
  71. ;; This file requires the custom library. Unfortunately, there are
  72. ;; two incompatible versions of the custom library. If you don't have
  73. ;; custom or you have the old version, this file will still load and
  74. ;; work properly. If you don't know what custom is all about and want
  75. ;; to edit your user option elisp variables the old fashioned way,
  76. ;; just imagine that all the "defcustom" stuff you see below is really
  77. ;; "defvar", and ignore everything else. For info about custom, see
  78. ;; <URL:http://www.dina.kvl.dk/~abraham/custom/>.
  79. ;;
  80. ;; This code does in elisp a superset of the stuff that used to be done
  81. ;; by the separate program "fakemail" for processing outbound email.
  82. ;; In other words, it takes over after you hit "C-c C-c" in mail mode.
  83. ;; By appropriate setting of options, you can even revert to sendmail
  84. ;; (which is not too popular locally). See the variables at the top
  85. ;; of the elisp for how to achieve these effects (there are more
  86. ;; features than in this bullet list, so trolling through the variable
  87. ;; and function doc strings may be worth your while):
  88. ;;
  89. ;; --- you can park outgoing messages into a disk-based queue and
  90. ;; stimulate sending them all later (handy for laptop users);
  91. ;; there is also a queue for draft messages
  92. ;;
  93. ;; --- you can get one last look at the prepped outbound message and
  94. ;; be prompted for confirmation
  95. ;;
  96. ;; --- removes Bcc:/Resent-Bcc: headers after getting address info
  97. ;;
  98. ;; --- does smart filling of address headers
  99. ;;
  100. ;; --- calls a routine to process Fcc: lines and removes them
  101. ;;
  102. ;; --- empty headers are removed
  103. ;;
  104. ;; --- can force From: or Sender: line
  105. ;;
  106. ;; --- can generate a Message-Id: line
  107. ;;
  108. ;; --- can generate a Date: line; the date can be the time the
  109. ;; message was written or the time it is being sent
  110. ;;
  111. ;; --- strips comments from address info (both "()" and "<>" are
  112. ;; handled via a call to mail-strip-quoted-names); the
  113. ;; comments are stripped in the simplified address list given
  114. ;; to a subprocess, not in the headers in the mail itself
  115. ;; (they are left unchanged, modulo smart filling)
  116. ;;
  117. ;; --- error info is pumped into a normal buffer instead of the
  118. ;; minibuffer
  119. ;;
  120. ;; --- just before the optional prompt for confirmation, lets you
  121. ;; run a hook on the prepped message and simplified address
  122. ;; list
  123. ;;
  124. ;; --- you can specify something other than /bin/mail for the
  125. ;; subprocess
  126. ;;
  127. ;; --- you can generate/modify an X-Mailer: message header
  128. ;;
  129. ;; After a long list of options below, you will find the function
  130. ;; feedmail-send-it. Hers's the best way to use the stuff in this
  131. ;; file:
  132. ;;
  133. ;; Save this file as feedmail.el somewhere on your elisp
  134. ;; loadpath; byte-compile it. Put the following lines somewhere in
  135. ;; your ~/.emacs stuff:
  136. ;;
  137. ;; (setq send-mail-function 'feedmail-send-it)
  138. ;; (autoload 'feedmail-send-it "feedmail")
  139. ;;
  140. ;; If you plan to use the queue stuff, also use this:
  141. ;;
  142. ;; (setq feedmail-enable-queue t)
  143. ;; (autoload 'feedmail-run-the-queue "feedmail")
  144. ;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail")
  145. ;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist))
  146. ;;
  147. ;; though VM users might find it more comfortable to use this instead of
  148. ;; the above example's last line:
  149. ;;
  150. ;; (setq auto-mode-alist (cons '("\\.fqm$" . feedmail-vm-mail-mode) auto-mode-alist))
  151. ;;
  152. ;; If you end up getting asked about killing modified buffers all the time
  153. ;; you are probably being prompted from outside feedmail. You can probably
  154. ;; get cured by doing the defadvice stuff described in the documentation
  155. ;; for the variable feedmail-queue-buffer-file-name below.
  156. ;;
  157. ;; If you are wondering how to send your messages to some SMTP server
  158. ;; (which is not really a feedmail-specific issue), you are probably
  159. ;; looking for smtpmail.el, and it is probably already present in your
  160. ;; emacs installation. Look at smtpmail.el for how to set that up, and
  161. ;; then do this to hook it into feedmail:
  162. ;;
  163. ;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t)
  164. ;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail)
  165. ;;
  166. ;; Alternatively, the FLIM <http://www.m17n.org/FLIM/> project
  167. ;; provides a library called smtp.el. If you want to use that, the above lines
  168. ;; would be:
  169. ;;
  170. ;; (autoload 'feedmail-buffer-to-smtp "feedmail" nil t)
  171. ;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtp)
  172. ;;
  173. ;; If you are using the desktop.el library to restore your sessions, you might
  174. ;; like to add the suffix ".fqm" to the list of non-saved things via the variable
  175. ;; desktop-files-not-to-save.
  176. ;;
  177. ;; If you are planning to call feedmail-queue-reminder from your .emacs or
  178. ;; something similar, you might need this:
  179. ;;
  180. ;; (autoload 'feedmail-queue-reminder "feedmail")
  181. ;;
  182. ;; If you ever use rmail-resend and queue messages, you should do this:
  183. ;;
  184. ;; (setq feedmail-queue-alternative-mail-header-separator "")
  185. ;;
  186. ;; If you want to automatically spell-check messages, but not when sending
  187. ;; them from the queue, you could do something like this:
  188. ;;
  189. ;; (autoload 'feedmail-mail-send-hook-splitter "feedmail")
  190. ;; (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
  191. ;; (add-hook 'feedmail-mail-send-hook 'ispell-message)
  192. ;;
  193. ;; If you are using message-mode to compose and send mail, feedmail will
  194. ;; probably work fine with that (someone else tested it and told me it worked).
  195. ;; Follow the directions above, but make these adjustments instead:
  196. ;;
  197. ;; (setq message-send-mail-function 'feedmail-send-it)
  198. ;; (add-hook 'message-mail-send-hook 'feedmail-mail-send-hook-splitter)
  199. ;;
  200. ;; If you use message-mode and you make use of feedmail's queueing
  201. ;; stuff, you might also like to adjust these variables to appropriate
  202. ;; values for message-mode:
  203. ;;
  204. ;; feedmail-queue-runner-mode-setter
  205. ;; feedmail-queue-runner-message-sender
  206. ;;
  207. ;; If you are using the "cmail" email package, there is some built-in
  208. ;; support for feedmail in recent versions. To enable it, you should:
  209. ;;
  210. ;; (setq cmail-use-feedmail t)
  211. ;;
  212. ;;;;;;;;
  213. ;;
  214. ;; I think the LCD is no longer being updated, but if it were, this
  215. ;; would be a proper LCD record. There is an old version of
  216. ;; feedmail.el in the LCD archive. It works but is missing a lot of
  217. ;; features.
  218. ;;
  219. ;; LCD record:
  220. ;; feedmail|WJCarpenter|bill-feedmail@carpenter.ORG|Outbound mail queue handling|01-??-??|11-beta-??|feedmail.el
  221. ;;
  222. ;; Change log:
  223. ;; original, 31 March 1991
  224. ;; patchlevel 1, 5 April 1991
  225. ;; patchlevel 2, 24 May 1991
  226. ;; 5-may-92 jwz Conditionalized calling expand-mail-aliases, since that
  227. ;; function doesn't exist in Lucid Emacs or when using
  228. ;; mail-abbrevs.el.
  229. ;; patchlevel 3, 3 October 1996
  230. ;; added queue stuff; still works in v18
  231. ;; patchlevel 4, issued by someone else
  232. ;; patchlevel 5, issued by someone else
  233. ;; patchlevel 6, not issued as far as I know
  234. ;; patchlevel 7, 20 May 1997
  235. ;; abandon futile support of Emacs 18 (sorry if that hurts you)
  236. ;; provide a Date: header by default
  237. ;; provide a default for generating Message-Id: header contents
  238. ;; and use it by default (slightly changed API)
  239. ;; return value from feedmail-run-the-queue
  240. ;; new wrapper function feedmail-run-the-queue-no-prompts
  241. ;; user-mail-address as default for From:
  242. ;; properly deal with Resent-{To,Cc,Bcc}
  243. ;; Bcc and Resent-* now included in smart filling
  244. ;; limited support for a "drafts" directory
  245. ;; user-configurable default message action
  246. ;; allow timeout for confirmation prompt (where available)
  247. ;; move Fcc handling to as late as possible to get max
  248. ;; header munging in the saved file
  249. ;; work around sendmail.el's prompts when working from queue
  250. ;; more reliably detect voluntary user bailouts
  251. ;; offer to save modified buffers visiting queue files
  252. ;; offer to delete old file copies of messages being queued
  253. ;; offer to delete queue files when sending immediately
  254. ;; queue filename convention preserves queue order
  255. ;; default queue and draft directory names that work on VMS
  256. ;; deduced address list now really a list, not a string (API change)
  257. ;; no more address buffer
  258. ;; when sending immediately, brief reminder of queue/draft counts
  259. ;; copy trace of smtpmail stuff to feedmail error buffer on no-go
  260. ;; more granularity on when to confirm sending
  261. ;; pause a bit for errors while running queue
  262. ;; try to clean up some pesky auto-save files from the
  263. ;; queue/draft directories
  264. ;; feedmail-force-expand-mail-aliases in case you can't figure
  265. ;; any other way
  266. ;; cleanup some of my sloppiness about case-fold-search (a strange
  267. ;; variable)
  268. ;; best effort following coding conventions from Emacs
  269. ;; elisp manual appendix
  270. ;; "customize" (see custom.el)
  271. ;; when user selects "immediate send", clear action prompt since
  272. ;; hooks may take a while to operate, and user may think the
  273. ;; response didn't take
  274. ;; fixes to the argument conventions for the
  275. ;; feedmail-queue-runner-* functions; allows
  276. ;; feedmail-run-the-queue[-no-prompts] to properly be called
  277. ;; non-interactively
  278. ;; eliminate reliance on directory-sep-char and feedmail-sep-thing
  279. ;; tweak smart filling (reminded of comma problem by levitte@lp.se)
  280. ;; option to control writing in text vs binary mode
  281. ;; patchlevel 8, 15 June 1998
  282. ;; reliable re-editing of text-mode (vs binary) queued messages
  283. ;; user option to keep Bcc: in Fcc: copy (keep by default)
  284. ;; user option to delete body from Fcc: copy (keep by default)
  285. ;; feedmail-deduce-bcc-where for envelope (API change for
  286. ;; feedmail-deduce-address list)
  287. ;; feedmail-queue-alternative-mail-header-separator
  288. ;; at message action prompt, "I"/"S" bypass message confirmation prompt
  289. ;; feedmail-mail-send-hook-splitter, feedmail-mail-send-hook,
  290. ;; feedmail-mail-send-hook-queued
  291. ;; user can supply stuff for message action prompt
  292. ;; variable feedmail-queue-runner-confirm-global, function feedmail-run-the-queue-global-prompt
  293. ;; bugfix: absolute argument to directory-files (tracked down for me
  294. ;; by gray@austin.apc.slb.com (Douglas Gray Stephens)); relative
  295. ;; pathnames can tickle stuff in ange-ftp remote directories
  296. ;; (perhaps because feedmail is careless about its working
  297. ;; directory)
  298. ;; feedmail-deduce-envelope-from
  299. ;; always supply envelope "from" (user-mail-address) to sendmail
  300. ;; feedmail-message-id-suffix
  301. ;; feedmail-queue-reminder, feedmail-queue-reminder-alist (after suggestions
  302. ;; and/or code fragments from tonyl@Eng.Sun.COM (Tony Lam) and
  303. ;; burge@newvision.com (Shane Burgess); bumped up the default value of
  304. ;; feedmail-queue-chatty-sit-for since info is more complex sometimes
  305. ;; feedmail-enable-spray (individual transmissions, crude mailmerge)
  306. ;; blank Subject: no longer a special case; see feedmail-nuke-empty-headers
  307. ;; fiddle-plexes data structure used lots of places; see feedmail-fiddle-plex-blurb
  308. ;; feedmail-fiddle-plex-user-list
  309. ;; feedmail-is-a-resend
  310. ;; honor mail-from-style in constructing default for feedmail-from-line
  311. ;; re-implement feedmail-from-line and feedmail-sender-line with
  312. ;; fiddle-plexes; slightly modified semantics for feedmail-sender-line
  313. ;; feedmail-queue-default-file-slug; tidy up some other slug details
  314. ;; feedmail-queue-auto-file-nuke
  315. ;; feedmail-queue-express-to-queue and feedmail-queue-express-to-draft
  316. ;; strong versions of "q"ueue and "d"raft answers (always make a new file)
  317. ;; patchlevel 9, 23 March 2001
  318. ;; feedmail-queue-buffer-file-name to work around undesirable mail-send prompt
  319. ;; at message action prompt, can scroll message buffer with "<" and ">";
  320. ;; C-v no longer scrolls help buffer
  321. ;; conditionalize (discard-input) in message action prompt to avoid killing
  322. ;; define-kbd-macro
  323. ;; fixed error if feedmail-x-mailer-line was nil
  324. ;; feedmail-binmail-template only uses /bin/rmail if it exists
  325. ;; relocate feedmail-queue-alternative-mail-header-separator stuff
  326. ;; added feedmail-vm-mail-mode, which make a good auto-mode-alist entry
  327. ;; for FQM files if you're a VM user
  328. ;; change buffer-substring calls to buffer-substring-no-properties for
  329. ;; speed-up (suggested by Howard Melman <howard@silverstream.com>)
  330. ;; feedmail-sendmail-f-doesnt-sell-me-out to control "-f" in call to sendmail
  331. ;; in feedmail-buffer-to-sendmail
  332. ;; better trapping of odd conditions during the running of the queue;
  333. ;; thanks to Yigal Hochberg for helping me test much of this by remote
  334. ;; control
  335. ;; feedmail-debug and feedmail-debug-sit-for
  336. ;; feedmail-display-full-frame
  337. ;; feedmail-queue-express-hook
  338. ;; added example function feedmail-spray-via-bbdb
  339. ;; use expand-file-name for setting default directory names
  340. ;; define feedmail-binmail-gnulinuxish-template as a suggestion for
  341. ;; the value of feedmail-binmail-template on GNU/Linux and maybe other
  342. ;; systems with non-classic /bin/[r]mail behavior
  343. ;; guard against nil user-mail-address in generating MESSAGE-ID:
  344. ;; feedmail-queue-slug-suspect-regexp is now a variable to
  345. ;; accommodate non-ASCII environments (thanks to
  346. ;; Makoto.Nakagawa@jp.compaq.com for this suggestion)
  347. ;; feedmail-buffer-to-smtp, to parallel feedmail-buffer-to-smtpmail
  348. ;; patchlevel 10, 22 April 2001
  349. ;; DATE: and MESSAGE-ID stuff now forces system-time-locale to "C"
  350. ;; (brought to my attention by Makoto.Nakagawa@jp.compaq.com)
  351. ;; patchlevel 11
  352. ;; tweak default FROM: calculation to look at mail-host-address
  353. ;; (suggested by "Jason Eisner" <jason@cs.jhu.edu>)
  354. ;;
  355. ;; todo:
  356. ;; write texinfo manual
  357. ;; maybe partition into multiple files, including files of examples
  358. ;;
  359. ;;; Code:
  360. (defconst feedmail-patch-level "11-beta-1")
  361. (require 'mail-utils) ; pick up mail-strip-quoted-names
  362. (eval-when-compile
  363. (require 'smtpmail)
  364. (require 'cl))
  365. (autoload 'mail-do-fcc "sendmail")
  366. (defgroup feedmail nil
  367. "Assist other email packages to massage outgoing messages."
  368. :link '(url-link "http://www.carpenter.org/feedmail/feedmail.html")
  369. :link '(emacs-commentary-link "feedmail")
  370. :group 'mail)
  371. (defgroup feedmail-misc nil
  372. "Miscellaneous feedmail options that don't fit in other groups."
  373. :group 'feedmail)
  374. (defgroup feedmail-headers nil
  375. "Options related to manipulating specific headers or types of headers."
  376. :group 'feedmail)
  377. (defgroup feedmail-queue nil
  378. "Options related to queuing messages for later sending."
  379. :group 'feedmail)
  380. (defgroup feedmail-debug nil
  381. "Options related to debug messages for later sending."
  382. :group 'feedmail)
  383. (defcustom feedmail-confirm-outgoing nil
  384. "If non-nil, give a y-or-n confirmation prompt before sending mail.
  385. This is done after the message is completely prepped, and you'll be
  386. looking at the top of the message in a buffer when you get the prompt.
  387. If set to the symbol 'queued, give the confirmation prompt only while
  388. running the queue (however, the prompt is always suppressed if you are
  389. processing the queue via `feedmail-run-the-queue-no-prompts'). If set
  390. to the symbol 'immediate, give the confirmation prompt only when
  391. sending immediately. For any other non-nil value, prompt in both
  392. cases. You can give a timeout for the prompt; see variable
  393. `feedmail-confirm-outgoing-timeout'."
  394. :group 'feedmail-misc
  395. :type 'boolean
  396. )
  397. (defcustom feedmail-display-full-frame 'queued
  398. "If non-nil, show prepped messages in a full frame.
  399. If nil, the prepped message will be shown, for confirmation or
  400. otherwise, in some window in the current frame without resizing
  401. anything. That may or may not display enough of the message to
  402. distinguish it from others. If set to the symbol 'queued, take
  403. this action only when running the queue. If set to the symbol
  404. 'immediate, take this action only when sending immediately. For
  405. any other non-nil value, take the action in both cases. Even if
  406. you're not confirming the sending of immediate or queued messages,
  407. it can still be interesting to see a lot about them as they are
  408. shuttled robotically onward."
  409. :version "24.1"
  410. :group 'feedmail-misc
  411. :type 'boolean
  412. )
  413. (defcustom feedmail-confirm-outgoing-timeout nil
  414. "If non-nil, a timeout in seconds at the send confirmation prompt.
  415. If a positive number, it's a timeout before sending. If a negative
  416. number, it's a timeout before not sending. This will not work if your
  417. version of Emacs doesn't include the function `y-or-n-p-with-timeout'
  418. \(e.g., some versions of XEmacs\)."
  419. :version "24.1"
  420. :group 'feedmail-misc
  421. :type '(choice (const nil) integer)
  422. )
  423. (defcustom feedmail-nuke-bcc t
  424. "If non-nil remove Bcc: lines from the message headers.
  425. In any case, the Bcc: lines do participate in the composed address
  426. list. You may want to leave them in if you're using sendmail
  427. \(see `feedmail-buffer-eating-function'\)."
  428. :group 'feedmail-headers
  429. :type 'boolean
  430. )
  431. (defcustom feedmail-nuke-resent-bcc t
  432. "If non-nil remove Resent-Bcc: lines from the message headers.
  433. In any case, the Resent-Bcc: lines do participate in the composed
  434. address list. You may want to leave them in if you're using sendmail
  435. \(see `feedmail-buffer-eating-function'\)."
  436. :group 'feedmail-headers
  437. :type 'boolean
  438. )
  439. (defcustom feedmail-deduce-bcc-where nil
  440. "Where Bcc:/Resent-Bcc: addresses should appear in the envelope list.
  441. Addresses for the message envelope are deduced by examining
  442. appropriate address headers in the message. Generally, they will show
  443. up in the list of deduced addresses in the order that the headers
  444. happen to appear (duplicate addresses are eliminated in any case).
  445. This variable can be set to the symbol 'first, in which case the
  446. Bcc:/Resent-Bcc: addresses will appear at the beginning in the list;
  447. or, it can be set to the symbol 'last, in which case they will appear
  448. at the end of the list.
  449. Why should you care? Well, maybe you don't, and certainly the same
  450. things could be accomplished by affecting the order of message headers
  451. in the outgoing message. Some people use Bcc: as a way of getting
  452. their own \"come back\" copy of each message they send. If Bcc:
  453. addresses are not handled first, there can be substantial delays in
  454. seeing the message again. Some configurations of sendmail, for example,
  455. seem to try to deliver to each addressee at least once, immediately
  456. and serially, so slow SMTP conversations can add up to a delay. There
  457. is an option for either 'first or 'last because you might have a
  458. delivery agent that processes the addresses backwards."
  459. :group 'feedmail-headers
  460. :type 'boolean
  461. )
  462. (defcustom feedmail-fill-to-cc t
  463. "If non-nil do smart filling of addressee header lines.
  464. Smart filling means breaking long lines at appropriate points and
  465. making continuation lines. Despite the function name, it includes
  466. To:, Cc:, Bcc: (and their Resent-* forms), as well as From: and
  467. Reply-To: (though they seldom need it). If nil, the lines are left
  468. as-is. The filling is done after mail address alias expansion."
  469. :group 'feedmail-headers
  470. :type 'boolean
  471. )
  472. (defcustom feedmail-fill-to-cc-fill-column default-fill-column
  473. "Fill column used by `feedmail-fill-to-cc'."
  474. :group 'feedmail-headers
  475. :type 'integer
  476. )
  477. (defcustom feedmail-nuke-bcc-in-fcc nil
  478. "If non-nil remove [Resent-]Bcc: lines in message copies saved via Fcc:.
  479. This is independent of whether the Bcc: header lines are actually sent
  480. with the message (see feedmail-nuke-bcc). Though not implied in the name,
  481. the same Fcc: treatment applies to both Bcc: and Resent-Bcc: lines."
  482. :group 'feedmail-headers
  483. :type 'boolean
  484. )
  485. (defcustom feedmail-nuke-body-in-fcc nil
  486. "If non-nil remove body of message in copies saved via Fcc:.
  487. If a positive integer value, leave (up to) that many lines of the
  488. beginning of the body intact. The result is that the Fcc: copy will
  489. consist only of the message headers, serving as a sort of an outgoing
  490. message log."
  491. :group 'feedmail-headers
  492. :type '(choice (const nil) (const t) integer)
  493. )
  494. (defcustom feedmail-force-expand-mail-aliases nil
  495. "If non-nil, force the calling of `expand-mail-aliases'.
  496. Normally, feedmail tries to figure out if you're using mailalias or
  497. mailabbrevs and only calls `expand-mail-aliases' if it thinks you're
  498. using the mailalias package. This user option can be used to force
  499. the issue since there are configurations which fool the figuring
  500. out."
  501. :group 'feedmail-headers
  502. :type 'boolean
  503. )
  504. (defcustom feedmail-nuke-empty-headers t
  505. "If non-nil, remove header lines which have no contents.
  506. A completely empty Subject: header is always removed, regardless of
  507. the setting of this variable. The only time you would want them left
  508. in would be if you used some headers whose presence indicated
  509. something rather than their contents. This is rare in Internet email
  510. but common in some proprietary systems."
  511. :group 'feedmail-headers
  512. :type 'boolean
  513. )
  514. ;; wjc sez: I think the use of the Sender: line is pretty pointless,
  515. ;; but I left it in to be compatible with sendmail.el and because
  516. ;; maybe some distant mail system needs it. Really, though, if you
  517. ;; want a sender line in your mail, just put one in there and don't
  518. ;; wait for feedmail to do it for you. (Yes, I know all about
  519. ;; RFC-822 and RFC-1123, but are you *really* one of those cases
  520. ;; they're talking about? I doubt it.)
  521. (defcustom feedmail-sender-line nil
  522. "If non-nil and the email has no Sender: header, use this value.
  523. May be nil, in which case nothing in particular is done with respect
  524. to Sender: lines. By design, will not replace an existing Sender:
  525. line, but you can achieve that with a fiddle-plex 'replace action.
  526. NB: it makes no sense to use the value t since there is no sensible
  527. default for Sender:.
  528. If not nil, it may be a string, a fiddle-plex, or a function which
  529. returns either nil, t, a string, or a fiddle-plex (or, in fact,
  530. another function, but let's not be ridiculous). If a string, it
  531. should be just the contents of the header, not the name of the header
  532. itself nor the trailing newline. If a function, it will be called
  533. with no arguments. For an explanation of fiddle-plexes, see the
  534. documentation for the variable `feedmail-fiddle-plex-blurb'. In all
  535. cases the name element of the fiddle-plex is ignored and is hardwired
  536. by feedmail to either \"Sender\" or \"Resent-Sender\".
  537. You can probably leave this nil, but if you feel like using it, a good
  538. value would be a string of a fully-qualified domain name form of your
  539. address. For example, \"bill@example.net (WJCarpenter)\". The Sender:
  540. header is fiddled after the From: header is fiddled."
  541. :group 'feedmail-headers
  542. :type '(choice (const nil) string)
  543. )
  544. (defcustom feedmail-force-binary-write t
  545. "If non-nil, force writing file as binary (this applies to queues and Fcc:).
  546. On systems where there is a difference between binary and text files,
  547. feedmail will temporarily manipulate the value of `buffer-file-type'
  548. to make the writing as binary. If nil, writing will be in text mode.
  549. On systems where there is no distinction or where it is controlled by other
  550. variables or other means, this option has no effect."
  551. :group 'feedmail-misc
  552. :type 'boolean
  553. )
  554. (defcustom feedmail-from-line t
  555. "If non-nil and the email has no From: header, use this value.
  556. May be t, in which case a default is computed (and you probably won't
  557. be happy with it). May be nil, in which case nothing in particular is
  558. done with respect to From: lines. By design, will not replace an
  559. existing From: line, but you can achieve that with a fiddle-plex 'replace
  560. action.
  561. If neither nil nor t, it may be a string, a fiddle-plex, or a function
  562. which returns either nil, t, a string, or a fiddle-plex (or, in fact,
  563. another function, but let's not be ridiculous). If a string, it
  564. should be just the contents of the header, not the name of the header
  565. itself nor the trailing newline. If a function, it will be called
  566. with no arguments. For an explanation of fiddle-plexes, see the
  567. documentation for the variable `feedmail-fiddle-plex-blurb'. In all
  568. cases the name element of the fiddle-plex is ignored and is hardwired
  569. by feedmail to either \"From\" or \"Resent-From\".
  570. A good value would be a string fully-qualified domain name form of
  571. your address. For example, \"bill@example.net (WJCarpenter)\". The
  572. default value of this variable uses the standard elisp variable
  573. `user-mail-address' which should be set on every system but has a decent
  574. chance of being wrong. It also honors `mail-from-style'. Better to set
  575. this variable explicitly to the string you want or find some other way
  576. to arrange for the message to get a From: line."
  577. :group 'feedmail-headers
  578. :type '(choice (const t) (const nil) string)
  579. )
  580. (defcustom feedmail-sendmail-f-doesnt-sell-me-out nil
  581. "Says whether the sendmail program issues a warning header if called with \"-f\".
  582. The sendmail program has a useful feature to let you set the envelope FROM
  583. address via a command line option, \"-f\". Unfortunately, it also has a widely
  584. disliked default behavior of selling you out if you do that by inserting
  585. an unattractive warning in the headers. It looks something like this:
  586. X-Authentication-Warning: u1.example.com: niceguy set sender to niceguy@example.com using -f
  587. It is possible to configure sendmail to not do this, but such a reconfiguration
  588. is not an option for many users. As this is the default behavior of most
  589. sendmail installations, one can mostly only wish it were otherwise. If feedmail
  590. believes the sendmail program will sell you out this way, it won't use the \"-f\"
  591. option when calling sendmail. If it doesn't think sendmail will sell you out,
  592. it will use the \"-f\" \(since it is a handy feature\). You control what
  593. feedmail thinks with this variable. The default is nil, meaning that feedmail
  594. will believe that sendmail will sell you out."
  595. :version "24.1"
  596. :group 'feedmail-headers
  597. :type 'boolean
  598. )
  599. (defcustom feedmail-deduce-envelope-from t
  600. "If non-nil, deduce message envelope \"from\" from header From: or Sender:.
  601. In other words, if there is a Sender: header in the message, temporarily
  602. change the value of `user-mail-address' to be the same while the message
  603. is being sent. If there is no Sender: header, use the From: header,
  604. if any. Address values are taken from the actual message just before
  605. it is sent, and the process is independent of the values of
  606. `feedmail-from-line' and/or `feedmail-sender-line'.
  607. There are many and good reasons for having the message header
  608. From:/Sender: be different from the message envelope \"from\"
  609. information. However, for most people and for most circumstances, it
  610. is usual for them to be the same (this is probably especially true for
  611. the case where the user doesn't understand the difference between the
  612. two in the first place).
  613. The idea behind this feature is that you can have everything set up
  614. some normal way for yourself. If for some reason you want to send a
  615. message with another From: line, you can just type it at the top of
  616. the message, and feedmail will take care of \"fixing up\" the envelope
  617. \"from\". This only works for mail senders which make use of
  618. `user-mail-address' as the envelope \"from\" value. For some mail
  619. senders (e.g., feedmail-buffer-to-bin-mail), there is no simple way to
  620. influence what they will use as the envelope."
  621. :group 'feedmail-headers
  622. :type 'boolean
  623. )
  624. (defcustom feedmail-x-mailer-line-user-appendage nil
  625. "See feedmail-x-mailer-line."
  626. :group 'feedmail-headers
  627. :type '(choice (const nil) (const t) string)
  628. )
  629. (defcustom feedmail-x-mailer-line t
  630. "Control the form of an X-Mailer: header in an outgoing message.
  631. Moderately useful for debugging, keeping track of your correspondents'
  632. mailer preferences, or just wearing your MUA on your sleeve. You
  633. should probably know that some people are fairly emotional about the
  634. presence of X-Mailer: lines in email.
  635. If nil, nothing is done about X-Mailer:.
  636. If t, an X-Mailer: header of a predetermined format is produced,
  637. combining its efforts with any existing X-Mailer: header. If you want
  638. to take the default construct and just add a little blob of your own
  639. at the end, define the variable feedmail-x-mailer-line-user-appendage
  640. as that blob string. A value of t is equivalent to using the function
  641. feedmail-default-x-mailer-generator.
  642. If neither nil nor t, it may be a string, a fiddle-plex, or a function
  643. which returns either nil, t, a string, or a fiddle-plex (or, in fact,
  644. another function, but let's not be ridiculous). If a string, it
  645. should be just the contents of the header, not the name of the header
  646. itself nor the trailing newline. If a function, it will be called
  647. with no arguments. For an explanation of fiddle-plexes, see the
  648. documentation for the variable `feedmail-fiddle-plex-blurb'. In all
  649. cases the name element of the fiddle-plex is ignored and is hardwired
  650. by feedmail to either \"X-Mailer\" or \"X-Resent-Mailer\"."
  651. :group 'feedmail-headers
  652. :type '(choice (const t) (const nil) string function)
  653. )
  654. (defcustom feedmail-message-id-generator t
  655. "Specifies the creation of a Message-Id: header field.
  656. If nil, nothing is done about Message-Id:.
  657. If t, a Message-Id: header of a predetermined format is produced, but
  658. only if there is not already a Message-Id: in the message. A value of
  659. t is equivalent to using the function feedmail-default-message-id-generator.
  660. If neither nil nor t, it may be a string, a fiddle-plex, or a function
  661. which returns either nil, t, a string, or a fiddle-plex (or, in fact,
  662. another function, but let's not be ridiculous). If a string, it
  663. should be just the contents of the header, not the name of the header
  664. itself nor the trailing newline. If a function, it will be called
  665. with one argument: the possibly-nil name of the file associated with
  666. the message buffer. For an explanation of fiddle-plexes, see the
  667. documentation for the variable `feedmail-fiddle-plex-blurb'. In all
  668. cases the name element of the fiddle-plex is ignored and is hardwired
  669. by feedmail to either \"Message-Id\" or \"Resent-Message-Id\".
  670. You should let feedmail generate a Message-Id: for you unless you are sure
  671. that whatever you give your messages to will do it for you (e.g., most
  672. configurations of sendmail). Even if the latter case is true, it
  673. probably won't hurt you to generate your own, and it will then show up
  674. in the saved message if you use Fcc:."
  675. :group 'feedmail-headers
  676. :type '(choice (const t) (const nil) function)
  677. )
  678. (defcustom feedmail-message-id-suffix nil
  679. "If non-nil, used as a suffix for generating unique Message-Id: headers.
  680. The function `feedmail-default-message-id-generator' creates its work based
  681. on a formatted date-time string, a random number, and a domain-looking suffix.
  682. You can control the suffix used by assigning a string value to this variable.
  683. If you don't supply one, the value of the variable `user-mail-address' will be
  684. used. If the value of `feedmail-message-id-suffix' contains an \"@\" character,
  685. the string will be used verbatim, else an \"@\" character will be prepended
  686. automatically."
  687. :group 'feedmail-headers
  688. :type '(choice (const nil) string)
  689. )
  690. ;; this was suggested in various forms by several people; first was
  691. ;; Tony DeSimone in Oct 1992; sorry to be so tardy
  692. (defcustom feedmail-date-generator t
  693. "Specifies the creation of a Date: header field.
  694. If nil, nothing is done about Date:.
  695. If t, a Date: header of a predetermined format is produced, but only
  696. if there is not already a Date: in the message. A value of t is
  697. equivalent to using the function `feedmail-default-date-generator'.
  698. If neither nil nor t, it may be a string, a fiddle-plex, or a function
  699. which returns either nil, t, a string, or a fiddle-plex (or, in fact,
  700. another function, but let's not be ridiculous). If a string, it
  701. should be just the contents of the header, not the name of the header
  702. itself nor the trailing newline. If a function, it will be called
  703. with one argument: the possibly-nil name of the file associated with
  704. the message buffer. For an explanation of fiddle-plexes, see the
  705. documentation for the variable `feedmail-fiddle-plex-blurb'. In all
  706. cases the name element of the fiddle-plex is ignored and is hardwired
  707. by feedmail to either \"Date\" or \"Resent-Date\".
  708. If you decide to format your own date field, do us all a favor and know
  709. what you're doing. Study the relevant parts of RFC-822 and RFC-1123.
  710. Don't make me come up there!
  711. You should let feedmail generate a Date: for you unless you are sure
  712. that whatever you give your messages to will do it for you (e.g., most
  713. configurations of sendmail). Even if the latter case is true, it
  714. probably won't hurt you to generate your own, and it will then show up
  715. in the saved message if you use Fcc:."
  716. :group 'feedmail-headers
  717. :type '(choice (const t) (const nil) function)
  718. )
  719. (defcustom feedmail-fiddle-headers-upwardly t
  720. "Non-nil means fiddled header fields should go at the top of the header.
  721. nil means insert them at the bottom. This is mostly a novelty issue since
  722. the standards define the ordering of header fields to be immaterial and it's
  723. fairly likely that some MTA/MUA along the way will have its own idea of what the
  724. order should be, regardless of what you specify."
  725. :group 'feedmail-headers
  726. :type 'boolean
  727. )
  728. (defcustom feedmail-fiddle-plex-user-list nil
  729. "If non-nil, should be a list of one or more fiddle-plexes.
  730. Each element of the list can also be a function which returns a
  731. fiddle-plex.
  732. feedmail will use this list of fiddle-plexes to manipulate user-specified
  733. message header fields. It does this after it has completed all normal
  734. message header field manipulation and before calling `feedmail-last-chance-hook'.
  735. For an explanation of fiddle-plexes, see the documentation for the
  736. variable `feedmail-fiddle-plex-blurb'. In contrast to some other fiddle-plex
  737. manipulation functions, in this context, it makes no sense to have an element
  738. which is nil, t, or a simple string."
  739. :group 'feedmail-headers
  740. :type '(repeat (choice function)
  741. sexp) ; too complex to be described accurately
  742. )
  743. (defcustom feedmail-enable-spray nil
  744. "If non-nil, transmit message separately to each addressee.
  745. feedmail normally accumulates a list of addressees and passes the message
  746. along with that list to a buffer-eating function which expects any number
  747. of addressees. If this variable is non-nil, however, feedmail will
  748. repeatedly call the same buffer-eating function. Each time, the list of
  749. addressees will be just one item from the original list. This only affects
  750. the message envelope addresses and doesn't affect what appears in the
  751. message headers except as noted.
  752. Spray mode is usually pointless, and if you can't think of a good reason for
  753. it, you should avoid it since it is inherently less efficient than normal
  754. multiple delivery. One reason to use it is to overcome mis-featured mail
  755. transports which betray your trust by revealing Bcc: addressees in the
  756. headers of a message. Another use is to do a crude form of mailmerge, for
  757. which see `feedmail-spray-address-fiddle-plex-list'.
  758. If one of the calls to the buffer-eating function results in an error,
  759. what happens next is carelessly defined, so beware. This should get ironed
  760. out in some future release, and there could be other API changes for spraying
  761. as well."
  762. :group 'feedmail-spray
  763. :type 'boolean
  764. )
  765. (defvar feedmail-spray-this-address nil
  766. "Do not set this variable, except via `feedmail-spray-address-fiddle-plex-list'.")
  767. (defcustom feedmail-spray-address-fiddle-plex-list nil
  768. "User-supplied specification for a crude form of mailmerge capability.
  769. When spraying is enabled, feedmail composes a list of envelope addresses.
  770. In turn, `feedmail-spray-this-address' is temporarily set to each address
  771. \(stripped of any comments and angle brackets\) and a function is called which
  772. fiddles message headers according to this variable. See the documentation for
  773. `feedmail-fiddle-plex-blurb', for an overview of fiddle-plex data structures.
  774. May be nil, in which case nothing in particular is done about message
  775. headers for specific addresses.
  776. May be t, in which case a \"To:\" header is added to the message with
  777. the stripped address as the header contents. The fiddle-plex operator
  778. is 'supplement.
  779. May be a string, in which case the string is assumed to be the name of
  780. a message header field with the stripped address serving as the value.
  781. The fiddle-plex operator is 'supplement.
  782. May be a function, in which case it is called with no arguments and is
  783. expected to return nil, t, a string, another function, or a fiddle-plex.
  784. The result is used recursively. The function may alter the value of the
  785. variable feedmail-spray-this-address, perhaps to embellish it with a
  786. human name. It would be logical in such a case to return as a value a
  787. string naming a message header like \"TO\" or an appropriately constructed
  788. fiddle-plex. For an example, see feedmail-spray-via-bbdb.
  789. May be a list of any combination of the foregoing and/or
  790. fiddle-plexes. (A value for this variable which consists of a single
  791. fiddle-plex must be nested inside another list to avoid ambiguity.)
  792. If a list, each item is acted on in turn as described above.
  793. For example,
  794. (setq feedmail-spray-address-fiddle-plex-list 'feedmail-spray-via-bbdb)
  795. The idea of the example is that, during spray mode, as each message is
  796. about to be transmitted to an individual address, the function will be
  797. called and will consult `feedmail-spray-this-address' to find the
  798. stripped envelope email address (no comments or angle brackets). The
  799. function should return an embellished form of the address.
  800. The recipe for sending form letters is: (1) create a message with all
  801. addressees on Bcc: headers; (2) tell feedmail to remove Bcc: headers
  802. before sending the message; (3) create a function which will embellish
  803. stripped addresses, if desired; (4) define `feedmail-spray-address-fiddle-plex-list'
  804. appropriately; (5) send the message with `feedmail-enable-spray' set
  805. non-nil; (6) stand back and watch co-workers wonder at how efficient
  806. you are at accomplishing inherently inefficient things."
  807. :group 'feedmail-spray
  808. :type 'sexp ; too complex to be described accurately
  809. )
  810. ;; FIXME this is a macro?
  811. (declare-function bbdb-search "ext:bbdb-com"
  812. (records &optional name company net notes phone))
  813. (declare-function bbdb-records "ext:bbdb"
  814. (&optional dont-check-disk already-in-db-buffer))
  815. (declare-function bbdb-dwim-net-address "ext:bbdb-com" (record &optional net))
  816. (defun feedmail-spray-via-bbdb ()
  817. "Example function for use with feedmail spray mode.
  818. NB: it's up to the user to have the BBDB environment already set up properly
  819. before using this."
  820. (let (net-rec q-net-addy embellish)
  821. (setq q-net-addy (concat "^" (regexp-quote feedmail-spray-this-address) "$"))
  822. (setq net-rec (bbdb-search (bbdb-records) nil nil q-net-addy))
  823. (if (and (car net-rec) (not (cdr net-rec)))
  824. (setq net-rec (car net-rec))
  825. (setq net-rec nil))
  826. (if net-rec (setq embellish (bbdb-dwim-net-address net-rec)))
  827. (if embellish
  828. (list "To" embellish 'supplement)
  829. (list "To" feedmail-spray-this-address 'supplement))))
  830. (defcustom feedmail-enable-queue nil
  831. "If non-nil, provide for stashing outgoing messages in a queue.
  832. This is the master on/off switch for feedmail message queuing.
  833. Queuing is quite handy for laptop-based users. It's also handy if you
  834. get a lot of mail and process it more or less sequentially. For
  835. example, you might change your mind about contents of a reply based on
  836. a message you see a bit later.
  837. There is a separate queue for draft messages, intended to prevent
  838. you from accidentally sending incomplete messages. The queues are
  839. disk-based and intended for later transmission. The messages are
  840. queued in their raw state as they appear in the mail-mode buffer and
  841. can be arbitrarily edited later, before sending, by visiting the
  842. appropriate file in the queue directory (and setting the buffer to
  843. mail-mode or whatever). If you visit a file in the queue directory
  844. and try to queue it again, it will just get saved in its existing file
  845. name. You can move a message from the draft to the main queue or vice
  846. versa by pretending to send it and then selecting whichever queue
  847. directory you want at the prompt. The right thing will happen.
  848. To transmit all the messages in the queue, invoke the command
  849. `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'."
  850. :group 'feedmail-queue
  851. :type 'boolean
  852. )
  853. (defcustom feedmail-queue-runner-confirm-global nil
  854. "If non-nil, give a y-or-n confirmation prompt before running the queue.
  855. Prompt even if the queue is about to be processed as a result of a call to
  856. `feedmail-run-the-queue-no-prompts'. This gives you a way to bail out
  857. without having to answer no to the individual message prompts."
  858. :group 'feedmail-queue
  859. :type 'boolean)
  860. (defcustom feedmail-queue-directory
  861. (expand-file-name "~/mail/q")
  862. "Name of a directory where messages will be queued.
  863. Directory will be created if necessary. Should be a string that
  864. doesn't end with a slash. Default is \"~/mail/q\"."
  865. :group 'feedmail-queue
  866. :type 'string
  867. )
  868. (defcustom feedmail-queue-draft-directory
  869. (expand-file-name "~/mail/draft")
  870. "Name of a directory where draft messages will be queued.
  871. Directory will be created if necessary. Should be a string that
  872. doesn't end with a slash. Default is \"~/mail/draft\"."
  873. :group 'feedmail-queue
  874. :type 'string
  875. )
  876. (defcustom feedmail-ask-before-queue t
  877. "If non-nil, feedmail will ask what you want to do with the message.
  878. Default choices for the message action prompt will include sending it
  879. immediately, putting it in the main queue, putting it in the draft
  880. queue, or returning to the buffer to continue editing. Only matters if
  881. queuing is enabled. If nil, the message is placed in the main queue
  882. without a prompt."
  883. :group 'feedmail-queue
  884. :type 'boolean
  885. )
  886. (defcustom feedmail-ask-before-queue-prompt "FQM: Message action (q, i, d, e, ?)? [%s]: "
  887. "A string which will be used for the message action prompt.
  888. If it contains a \"%s\", that will be replaced with the value of
  889. `feedmail-ask-before-queue-default'."
  890. :group 'feedmail-queue
  891. :type 'string
  892. )
  893. (defcustom feedmail-ask-before-queue-reprompt "FQM: Please type q, i, d, or e; or ? for help [%s]: "
  894. "A string which will be used for reprompting after invalid input.
  895. If it contains a \"%s\", that will be replaced with the value of
  896. `feedmail-ask-before-queue-default'."
  897. :group 'feedmail-queue
  898. :type 'string
  899. )
  900. (defcustom feedmail-ask-before-queue-default "queue"
  901. "Meaning if user hits return in response to the message action prompt.
  902. Should be a character or a string; if a string, only the first
  903. character is significant. Useful values are those described in
  904. the help for the message action prompt."
  905. :group 'feedmail-queue
  906. :type '(choice string integer) ;use integer to get char
  907. )
  908. (defvar feedmail-prompt-before-queue-standard-alist
  909. '((?q . feedmail-message-action-queue)
  910. (?Q . feedmail-message-action-queue-strong)
  911. (?d . feedmail-message-action-draft)
  912. (?r . feedmail-message-action-draft)
  913. (?D . feedmail-message-action-draft-strong)
  914. (?R . feedmail-message-action-draft-strong)
  915. (?e . feedmail-message-action-edit)
  916. (?E . feedmail-message-action-edit)
  917. (?\C-g . feedmail-message-action-edit)
  918. (?n . feedmail-message-action-edit)
  919. (?N . feedmail-message-action-edit)
  920. (?i . feedmail-message-action-send)
  921. (?I . feedmail-message-action-send-strong)
  922. (?s . feedmail-message-action-send)
  923. (?S . feedmail-message-action-send-strong)
  924. (?* . feedmail-message-action-toggle-spray)
  925. (?> . feedmail-message-action-scroll-up)
  926. (?< . feedmail-message-action-scroll-down)
  927. (? . feedmail-message-action-scroll-up)
  928. ;; (?\C-v . feedmail-message-action-help)
  929. (?? . feedmail-message-action-help))
  930. "An alist of choices for the message action prompt.
  931. All of the values are function names, except help, which is a special
  932. symbol that calls up help for the prompt (the help describes the
  933. actions from the standard alist). To customize your own choices,
  934. define a similar alist called `feedmail-prompt-before-queue-user-alist'.
  935. The actual alist used for message action will be the standard alist
  936. overlaid with the user-alist. To neutralize an item in the standard
  937. alist without providing a replacement, define an appropriate element
  938. in the user alist with a value of nil." )
  939. (defcustom feedmail-prompt-before-queue-user-alist nil
  940. "See `feedmail-prompt-before-queue-standard-alist'."
  941. :group 'feedmail-queue
  942. :type '(repeat (cons character function))
  943. )
  944. (defcustom feedmail-prompt-before-queue-help-supplement nil
  945. "User-provided supplementary help string for the message action prompt.
  946. When the message action prompt is shown, the user can as for verbose help,
  947. at which point a buffer pops up describing the meaning of possible
  948. responses to the prompt. Through various customizations (see, for
  949. example, `feedmail-prompt-before-queue-user-alist'), the available responses
  950. and the prompt itself can be changed. If this variable is set to a string
  951. value, that string is written to the help buffer after the standard info.
  952. It may contain embedded line breaks. It will be printed via `princ'."
  953. :group 'feedmail-queue
  954. :type '(choice (const nil) string)
  955. )
  956. (defcustom feedmail-queue-reminder-alist
  957. '((after-immediate . feedmail-queue-reminder-brief)
  958. (after-queue . feedmail-queue-reminder-medium)
  959. (after-draft . feedmail-queue-reminder-medium)
  960. (after-run . feedmail-queue-reminder-brief)
  961. (on-demand . feedmail-run-the-queue-global-prompt))
  962. "See `feedmail-queue-reminder'."
  963. :group 'feedmail-queue
  964. :type '(repeat (cons (choice :tag "Event"
  965. (const on-demand)
  966. (const after-immediate)
  967. (const after-queue)
  968. (const after-draft)
  969. (const after-run))
  970. function))
  971. )
  972. (defcustom feedmail-queue-chatty t
  973. "If non-nil, blat a few status messages and such in the mini-buffer.
  974. If nil, just do the work and don't pester people about what's going on.
  975. In some cases, though, specific options inspire mini-buffer prompting.
  976. That's not affected by this variable setting. Also does not control
  977. reporting of error/abnormal conditions."
  978. :group 'feedmail-queue
  979. :type 'boolean
  980. )
  981. (defcustom feedmail-queue-chatty-sit-for 2
  982. "Duration of pause after most queue-related messages.
  983. After some messages are divulged, it is prudent to pause before
  984. something else obliterates them. This value controls the duration of
  985. the pause."
  986. :group 'feedmail-queue
  987. :type 'integer
  988. )
  989. (defcustom feedmail-queue-run-orderer nil
  990. "If non-nil, name a function which will sort the queued messages.
  991. The function is called during a running of the queue for sending, and
  992. takes one argument, a list of the files in the queue directory. It
  993. may contain the names of non-message files, and it's okay to leave
  994. them in the list when reordering it; they get skipped over later.
  995. When nil, the default action processes the messages in normal sort
  996. order by queued file name, which will typically result in the order
  997. they were placed in the queue."
  998. :group 'feedmail-queue
  999. :type '(choice (const nil) function)
  1000. )
  1001. (defcustom feedmail-queue-use-send-time-for-date nil
  1002. "If non-nil, use send time for the Date: header value.
  1003. This variable is used by the default date generating function,
  1004. feedmail-default-date-generator. If nil, the default, the
  1005. last-modified timestamp of the queue file is used to create the
  1006. message Date: header; if there is no queue file, the current time is
  1007. used. If you are using VM, it might be supplying this header for
  1008. you. To suppress VM's version
  1009. (setq vm-mail-header-insert-date nil)"
  1010. :group 'feedmail-queue
  1011. :type 'boolean
  1012. )
  1013. (defcustom feedmail-queue-use-send-time-for-message-id nil
  1014. "If non-nil, use send time for the Message-Id: header value.
  1015. This variable is used by the default Message-Id: generating function,
  1016. `feedmail-default-message-id-generator'. If nil, the default, the
  1017. last-modified timestamp of the queue file is used to create the
  1018. message Message-Id: header; if there is no queue file, the current time is
  1019. used. If you are using VM, it might be supplying this header for
  1020. you. To suppress VM's version
  1021. (setq vm-mail-header-insert-date nil)"
  1022. :group 'feedmail-queue
  1023. :type 'boolean
  1024. )
  1025. (defcustom feedmail-ask-for-queue-slug nil
  1026. "If non-nil, prompt user for part of the queue file name.
  1027. The file will automatically get the FQM suffix and an embedded
  1028. sequence number for uniqueness, so don't specify that. feedmail will
  1029. get rid of all characters other than alphanumeric and hyphen in the
  1030. results. If this variable is nil or if you just hit return in
  1031. response to the prompt, feedmail queuing will take care of things
  1032. properly. At the prompt, completion is available if you want to see
  1033. what filenames are already in use, though, as noted, you will not be
  1034. typing a complete file name. You probably don't want to be bothered
  1035. with this prompting since feedmail, by default, uses queue file names
  1036. based on the subjects of the messages."
  1037. :group 'feedmail-queue
  1038. :type 'boolean
  1039. )
  1040. (defcustom feedmail-queue-slug-maker 'feedmail-queue-subject-slug-maker
  1041. "If non-nil, a function which creates part of the queued file name.
  1042. Takes a single argument giving the name of the directory into
  1043. which the message will be queued. The returned string should be just
  1044. the non-directory filename part, without FQM suffix or uniquifying
  1045. sequence numbers. The current buffer holds the raw message. The
  1046. default function creates the slug based on the message subject, if
  1047. any."
  1048. :group 'feedmail-queue
  1049. :type '(choice (const nil) function)
  1050. )
  1051. (defcustom feedmail-queue-slug-suspect-regexp "[^a-z0-9-]+"
  1052. "Regular expression for characters/substrings to be replaced.
  1053. When feedmail creates a filename from a subject string, it puts hyphens
  1054. in place of strings which may cause problems in filenames. By default,
  1055. only alphanumeric and hyphen characters are kept, and all others are
  1056. converted. In non-ASCII environments, it may be more helpful to
  1057. tweak this regular expression to reflect local or personal language
  1058. conventions. Substitutions are done repeatedly until the regular expression
  1059. no longer matches to transformed string. Used by function
  1060. feedmail-tidy-up-slug and indirectly by feedmail-queue-subject-slug-maker."
  1061. :version "24.1"
  1062. :group 'feedmail-queue
  1063. :type 'string
  1064. )
  1065. (defcustom feedmail-queue-default-file-slug t
  1066. "Indicates what to use for subject-less messages when forming a file name.
  1067. When feedmail queues a message, it creates a unique file name. By default,
  1068. the file name is based in part on the subject of the message being queued.
  1069. If there is no subject, consult this variable. See documentation for the
  1070. function `feedmail-queue-subject-slug-maker'.
  1071. If t, an innocuous default is used.
  1072. If a string, it is used directly.
  1073. If a function, it is called with no arguments from the buffer containing the raw
  1074. text of the message. It must return a string (which may be empty).
  1075. If the symbol 'ask, you will be prompted for a string in the mini-buffer.
  1076. Filename completion is available so that you can inspect what's already been
  1077. used, but feedmail will do further manipulation on the string you return, so
  1078. it's not expected to be a complete filename."
  1079. :group 'feedmail-queue
  1080. :type '(choice (const :tag "Default" t) string function (const ask))
  1081. )
  1082. (defcustom feedmail-queue-fqm-suffix ".fqm"
  1083. "The FQM suffix used to distinguish feedmail queued message files.
  1084. You probably want this to be a period followed by some letters and/or
  1085. digits. The distinction is to be able to tell them from other random
  1086. files that happen to be in the `feedmail-queue-directory' or
  1087. `feedmail-queue-draft-directory'. By the way, FQM stands for feedmail
  1088. queued message."
  1089. :group 'feedmail-queue
  1090. :type 'string
  1091. )
  1092. (defcustom feedmail-nuke-buffer-after-queue nil
  1093. "If non-nil, silently kill the buffer after a message is queued.
  1094. You might like that since a side-effect of queueing the message is
  1095. that its buffer name gets changed to the filename. That means that
  1096. the buffer won't be reused for the next message you compose. If you
  1097. are using VM for creating messages, you probably want to leave this
  1098. nil, since VM has its own options for managing the recycling of
  1099. message buffers."
  1100. :group 'feedmail-queue
  1101. :type 'boolean
  1102. )
  1103. (defcustom feedmail-queue-auto-file-nuke nil
  1104. "If non-nil, automatically delete queue files when a message is sent.
  1105. Normally, feedmail will notice such files when you send a message in
  1106. immediate mode (i.e., not when you're running the queue) and will ask if
  1107. you want to delete them. Since the answer is usually yes, setting this
  1108. variable to non-nil will tell feedmail to skip the prompt and just delete
  1109. the file without bothering you."
  1110. :group 'feedmail-queue
  1111. :type 'boolean
  1112. )
  1113. (defcustom feedmail-debug nil
  1114. "If non-nil, blat a debug messages and such in the mini-buffer.
  1115. This is intended as an aid to tracing what's going on but is probably
  1116. of casual real use only to the feedmail developer."
  1117. :version "24.1"
  1118. :group 'feedmail-debug
  1119. :type 'boolean
  1120. )
  1121. (defcustom feedmail-debug-sit-for 0
  1122. "Duration of pause after feedmail-debug messages.
  1123. After some messages are divulged, it may be helpful to pause before
  1124. something else obliterates them. This value controls the duration of
  1125. the pause. If the value is nil or 0, the sit-for is not done, which
  1126. has the effect of not pausing at all. Debug messages can be seen after
  1127. the fact in the messages buffer."
  1128. :version "24.1"
  1129. :group 'feedmail-debug
  1130. :type 'integer
  1131. )
  1132. (defvar feedmail-queue-buffer-file-name nil
  1133. "If non-nil, has the value normally expected of 'buffer-file-name'.
  1134. You are not intended to set this to something in your configuration. Rather,
  1135. you might programmatically set it to something via a hook or function
  1136. advice or whatever. You might like to do this if you are using a mail
  1137. composition program that eventually uses sendmail.el's 'mail-send'
  1138. function to process the message. If there is a filename associated
  1139. with the message buffer, 'mail-send' will ask you for confirmation.
  1140. There's no trivial way to avoid it. It's unwise to just set the value
  1141. of 'buffer-file-name' to nil because that will defeat feedmail's file
  1142. management features. Instead, arrange for this variable to be set to
  1143. the value of 'buffer-file-name' before setting that to nil. An easy way
  1144. to do that would be with defadvice on 'mail-send' \(undoing the
  1145. assignments in a later advice\).
  1146. feedmail will pretend that 'buffer-file-name', if nil, has the value
  1147. assigned of 'feedmail-queue-buffer-file-name' and carry out its normal
  1148. activities. feedmail does not restore the non-nil value of
  1149. 'buffer-file-name'. For safe bookkeeping, the user should insure that
  1150. feedmail-queue-buffer-file-name is restored to nil.
  1151. Example 'defadvice' for mail-send:
  1152. (defadvice mail-send (before feedmail-mail-send-before-advice activate)
  1153. (setq feedmail-queue-buffer-file-name buffer-file-name)
  1154. (setq buffer-file-name nil))
  1155. (defadvice mail-send (after feedmail-mail-send-after-advice activate)
  1156. (if feedmail-queue-buffer-file-name (setq buffer-file-name feedmail-queue-buffer-file-name))
  1157. (setq feedmail-queue-buffer-file-name nil))
  1158. ")
  1159. ;; defvars to make byte-compiler happy(er)
  1160. (defvar feedmail-error-buffer nil)
  1161. (defvar feedmail-prepped-text-buffer nil)
  1162. (defvar feedmail-raw-text-buffer nil)
  1163. (defvar feedmail-address-list nil)
  1164. (defvar feedmail-queue-runner-is-active nil
  1165. "*Non-nil means we're inside the logic of the queue-running loop.
  1166. That is, iterating over all messages in the queue to send them. In
  1167. that case, the value is the name of the queued message file currently
  1168. being processed. This can be used for differentiating customized code
  1169. for different scenarios. Users shouldn't set or change this
  1170. variable, but may depend on its value as described here.")
  1171. (defun feedmail-mail-send-hook-splitter ()
  1172. "Facilitate dividing `mail-send-hook' things into queued and immediate cases.
  1173. If you have `mail-send-hook' functions that should only be called for sending/
  1174. queueing messages or only be called for the sending of queued messages, this is
  1175. for you. Add this function to `mail-send-hook' with something like this:
  1176. (add-hook 'mail-send-hook 'feedmail-mail-send-hook-splitter)
  1177. Then add the functions you want called to either `feedmail-mail-send-hook-queued'
  1178. or `feedmail-mail-send-hook', as appropriate. The distinction is that
  1179. `feedmail-mail-send-hook' will be called when you send mail from a composition
  1180. buffer (typically by typing C-c C-c), whether the message is sent immediately
  1181. or placed in the queue or drafts directory. `feedmail-mail-send-hook-queued' is
  1182. called when messages are being sent from the queue directory, typically via a
  1183. call to `feedmail-run-the-queue'."
  1184. (feedmail-say-debug ">in-> feedmail-mail-send-hook-splitter %s" feedmail-queue-runner-is-active)
  1185. (if feedmail-queue-runner-is-active
  1186. (run-hooks 'feedmail-mail-send-hook-queued)
  1187. (run-hooks 'feedmail-mail-send-hook))
  1188. )
  1189. (defvar feedmail-mail-send-hook nil
  1190. "*See documentation for `feedmail-mail-send-hook-splitter'.")
  1191. (defvar feedmail-mail-send-hook-queued nil
  1192. "*See documentation for `feedmail-mail-send-hook-splitter'.")
  1193. (defun feedmail-confirm-addresses-hook-example ()
  1194. "An example of a `feedmail-last-chance-hook'.
  1195. It shows the simple addresses and gets a confirmation. Use as:
  1196. (setq feedmail-last-chance-hook 'feedmail-confirm-addresses-hook-example)."
  1197. (save-window-excursion
  1198. (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E")))
  1199. (erase-buffer)
  1200. (insert (mapconcat 'identity feedmail-address-list " "))
  1201. (if (not (y-or-n-p "How do you like them apples? "))
  1202. (error "FQM: Sending...gave up in last chance hook")
  1203. )))
  1204. (defcustom feedmail-last-chance-hook nil
  1205. "User's last opportunity to modify the message on its way out.
  1206. When this hook runs, the current buffer is already the appropriate
  1207. buffer. It has already had all the header prepping from the standard
  1208. package. The next step after running the hook will be to save the
  1209. message via FCC: processing. The hook might be interested in these:
  1210. \(1) `feedmail-prepped-text-buffer' contains the header and body of the
  1211. message, ready to go; (2) `feedmail-address-list' contains a list
  1212. of simplified recipients of addresses which are to be given to the
  1213. subprocess (the hook may change the list); (3) `feedmail-error-buffer'
  1214. is an empty buffer intended to soak up errors for display to the user.
  1215. If the hook allows interactive activity, the user should not send more
  1216. mail while in the hook since some of the internal buffers will be
  1217. reused and things will get confused. It's not necessary to
  1218. arrange for the undoing of any changes you make to the buffer."
  1219. :group 'feedmail-misc
  1220. :type 'hook
  1221. )
  1222. (defcustom feedmail-queue-express-hook nil
  1223. "Chance to modify a message being sent directly to a queue.
  1224. Run by feedmail-queue-express-to-queue and feedmail-queue-express-to-draft.
  1225. For example, you might want to run vm-mime-encode-composition to take
  1226. care of attachments. If you subsequently edit the message buffer, you
  1227. can undo the encoding."
  1228. :version "24.1"
  1229. :group 'feedmail-queue
  1230. :type 'hook
  1231. )
  1232. (defcustom feedmail-before-fcc-hook nil
  1233. "User's last opportunity to modify the message before Fcc action.
  1234. It has already had all the header prepping from the standard package.
  1235. The next step after running the hook will be to save the message via
  1236. Fcc: processing. The hook might be interested in these: (1)
  1237. `feedmail-prepped-text-buffer' contains the header and body of the
  1238. message, ready to go; (2) `feedmail-address-list' contains a list of
  1239. simplified recipients of addressees to whom the message was sent (3)
  1240. `feedmail-error-buffer' is an empty buffer intended to soak up errors
  1241. for display to the user. If the hook allows interactive activity, the
  1242. user should not send more mail while in the hook since some of the
  1243. internal buffers will be reused and things will get confused."
  1244. :group 'feedmail-misc
  1245. :type 'hook
  1246. )
  1247. (defcustom feedmail-queue-runner-mode-setter
  1248. (lambda (&optional arg) (mail-mode))
  1249. "A function to set the proper mode of a message file.
  1250. Called when the message is read back out of the queue directory with a single
  1251. argument, the optional argument used in the call to
  1252. `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
  1253. Most people want `mail-mode', so the default value is an anonymous
  1254. function which is just a wrapper to ignore the supplied argument when
  1255. calling it, but here's your chance to have something different.
  1256. If you are a VM user, you might like feedmail-vm-mail-mode, though you
  1257. really don't need that (and it's not particularly well-tested).
  1258. Called with funcall, not `call-interactively'."
  1259. :group 'feedmail-queue
  1260. :type 'function
  1261. )
  1262. (defcustom feedmail-queue-alternative-mail-header-separator nil
  1263. "Alternative header demarcation for queued messages.
  1264. If you sometimes get alternative values for `mail-header-separator' in
  1265. queued messages, set the value of this variable to whatever it is.
  1266. For example, `rmail-resend' uses a `mail-header-separator' value of empty
  1267. string (\"\") when you send/queue a message.
  1268. When trying to send a queued message, if the value of this variable is
  1269. non-nil, feedmail will first try to send the message using the value
  1270. of `mail-header-separator'. If it can't find that, it will temporarily
  1271. set `mail-header-separator' to the value of
  1272. `feedmail-queue-alternative-mail-header-separator' and try again."
  1273. :group 'feedmail-queue
  1274. :type '(choice (const nil) string)
  1275. )
  1276. (defcustom feedmail-queue-runner-message-sender
  1277. (lambda (&optional arg) (mail-send))
  1278. "Function to initiate sending a message file.
  1279. Called for each message read back out of the queue directory with a
  1280. single argument, the optional argument used in the call to
  1281. `feedmail-run-the-queue' or `feedmail-run-the-queue-no-prompts'.
  1282. Interactively, that argument will be the prefix argument.
  1283. Most people want `mail-send' (bound to C-c C-s in mail-mode), but here's
  1284. your chance to have something different. The default value is just a
  1285. wrapper function which discards the optional argument and calls
  1286. mail-send. If you are a VM user, you might like vm-mail-send, though
  1287. you really don't need that. Called with funcall, not call-interactively."
  1288. :version "24.1" ; changed default
  1289. :group 'feedmail-queue
  1290. :type 'function
  1291. )
  1292. (defcustom feedmail-queue-runner-cleaner-upper
  1293. (lambda (fqm-file &optional arg)
  1294. (delete-file fqm-file)
  1295. (if arg (feedmail-say-chatter "Nuked %s" fqm-file)))
  1296. "Function that will be called after a message has been sent.
  1297. Not called in the case of errors. This function is called with two
  1298. arguments: the name of the message queue file for the message just sent,
  1299. and the optional argument used in the call to `feedmail-run-the-queue'
  1300. or `feedmail-run-the-queue-no-prompts' (prefix arg if interactive).
  1301. In any case, the affiliated buffer is killed elsewhere, so don't do that
  1302. inside this function. Return value is ignored.
  1303. The default action is an anonymous function which gets rid of the file
  1304. from the queue directory. With a non-nil second argument, a brief
  1305. message is give for each file deleted. You could replace this
  1306. function, for example, to archive all of your sent messages someplace
  1307. \(though there are better ways to get that particular result\)."
  1308. :group 'feedmail-queue
  1309. :type 'function
  1310. )
  1311. (defvar feedmail-is-a-resend nil
  1312. "*Non-nil means the message is a Resend (in the RFC-822 sense).
  1313. This affects the composition of certain headers. feedmail sets this
  1314. variable as soon as it starts prepping the message text buffer, so any
  1315. user-supplied functions can rely on it. Users shouldn't set or change this
  1316. variable, but may depend on its value as described here.")
  1317. (defcustom feedmail-buffer-eating-function 'feedmail-buffer-to-binmail
  1318. "Function used to send the prepped buffer to a subprocess.
  1319. The function's three (mandatory) arguments are: (1) the buffer
  1320. containing the prepped message; (2) a buffer where errors should be
  1321. directed; and (3) a list containing the addresses individually as
  1322. strings. Popular choices for this are `feedmail-buffer-to-binmail',
  1323. `feedmail-buffer-to-smtpmail', `feedmail-buffer-to-sendmail', and
  1324. `feedmail-buffer-to-smtp'. If you use the sendmail form, you probably
  1325. want to set `feedmail-nuke-bcc' and/or `feedmail-nuke-resent-bcc to nil'.
  1326. If you use the binmail form, check the value of `feedmail-binmail-template'."
  1327. :group 'feedmail-misc
  1328. :type 'function
  1329. )
  1330. (defconst feedmail-binmail-gnulinuxish-template
  1331. (concat
  1332. "(echo From "
  1333. (if (boundp 'user-login-name) user-login-name "feedmail")
  1334. " ; cat -) | /usr/bin/rmail %s")
  1335. "Good candidate for GNU/Linux systems and maybe others.
  1336. You may need to modify this if your \"rmail\" is in a different place.
  1337. For example, I hear that in some Debian systems, it's /usr/sbin/rmail.
  1338. See feedmail-binmail-template documentation."
  1339. )
  1340. (defcustom feedmail-binmail-template (if mail-interactive "/bin/mail %s"
  1341. (if (file-exists-p "/bin/rmail")
  1342. "/bin/rmail %s" "/bin/mail %s"))
  1343. "Command template for the subprocess which will get rid of the mail.
  1344. It can result in any command understandable by /bin/sh. Might not
  1345. work at all in non-UNIX environments. The single '%s', if present,
  1346. gets replaced by the space-separated, simplified list of addressees.
  1347. Used in `feedmail-buffer-to-binmail' to form the shell command which
  1348. will receive the contents of the prepped buffer as stdin. The default
  1349. value uses /bin/rmail (if it exists) unless `mail-interactive' has been
  1350. set non-nil.
  1351. If you'd like your errors to come back as mail instead of immediately
  1352. in a buffer, try /bin/rmail instead of /bin/mail. If /bin/rmail
  1353. exists, this can be accomplished by keeping the default nil setting of
  1354. `mail-interactive'. You might also like to consult local mail experts
  1355. for any other interesting command line possibilities. Some versions
  1356. of UNIX have an rmail program which behaves differently than
  1357. /bin/rmail and complains if feedmail gives it a message on stdin. If
  1358. you don't know about such things and if there is no local expert to
  1359. consult, stick with /bin/mail or use one of the other buffer eating
  1360. functions.
  1361. The above description applies to \"classic\" UNIX /bin/mail and /bin/rmail.
  1362. On most GNU/Linux systems and perhaps other places, /bin/mail behaves
  1363. completely differently and shouldn't be used at all in this template.
  1364. Instead of /bin/rmail, there is a /usr/bin/rmail, and it can be used
  1365. with a wrapper. The wrapper is necessary because /usr/bin/rmail on such
  1366. systems requires that the first line of the message appearing on standard
  1367. input have a UNIX-style From_ postmark. If you have such a system, the
  1368. wrapping can be accomplished by setting the value of `feedmail-binmail-template'
  1369. to `feedmail-binmail-gnulinuxish-template'. You should then send some test
  1370. messages to make sure it works as expected."
  1371. :version "24.1" ; changed default
  1372. :group 'feedmail-misc
  1373. :type 'string
  1374. )
  1375. ;; feedmail-buffer-to-binmail, feedmail-buffer-to-sendmail, and
  1376. ;; feedmail-buffer-to-smptmail are the only things provided for values
  1377. ;; for the variable feedmail-buffer-eating-function. It's pretty easy
  1378. ;; to write your own, though.
  1379. (defun feedmail-buffer-to-binmail (prepped errors-to addr-listoid)
  1380. "Function which actually calls /bin/mail as a subprocess.
  1381. Feeds the buffer to it."
  1382. (feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid)
  1383. (set-buffer prepped)
  1384. (apply
  1385. 'call-process-region
  1386. (append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c"
  1387. (format feedmail-binmail-template
  1388. (mapconcat 'identity addr-listoid " "))))))
  1389. (defvar sendmail-program)
  1390. (defun feedmail-buffer-to-sendmail (prepped errors-to addr-listoid)
  1391. "Function which actually calls sendmail as a subprocess.
  1392. Feeds the buffer to it. Probably has some flaws for Resent-* and other
  1393. complicated cases. Takes addresses from message headers and
  1394. might disappoint you with BCC: handling. In case of odd results, consult
  1395. local gurus."
  1396. (require 'sendmail)
  1397. (feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid)
  1398. (set-buffer prepped)
  1399. (apply 'call-process-region
  1400. (append (list (point-min) (point-max) sendmail-program
  1401. nil errors-to nil "-oi" "-t")
  1402. ;; provide envelope "from" to sendmail; results will vary
  1403. (if feedmail-sendmail-f-doesnt-sell-me-out
  1404. (list "-f" user-mail-address))
  1405. ;; These mean "report errors by mail" and "deliver in background".
  1406. (if (null mail-interactive) '("-oem" "-odb")))))
  1407. ;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
  1408. ;; simplified by WJC after more feedmail development;
  1409. ;; idea (but not implementation) of copying smtpmail trace buffer to
  1410. ;; feedmail error buffer from:
  1411. ;; Mon 14-Oct-1996; Douglas Gray Stephens
  1412. ;; modified to insert error for displaying
  1413. (defun feedmail-buffer-to-smtpmail (prepped errors-to addr-listoid)
  1414. "Function which actually calls `smtpmail-via-smtp' to send buffer as e-mail."
  1415. ;; I'm not sure smtpmail.el is careful about the following
  1416. ;; return value, but it also uses it internally, so I will fear
  1417. ;; no evil.
  1418. (feedmail-say-debug ">in-> feedmail-buffer-to-smtpmail %s" addr-listoid)
  1419. (require 'smtpmail)
  1420. (let ((result (smtpmail-via-smtp addr-listoid prepped)))
  1421. (when result
  1422. (set-buffer errors-to)
  1423. (insert "Send via smtpmail failed: %s" result)
  1424. (let ((case-fold-search t)
  1425. ;; don't be overconfident about the name of the trace buffer
  1426. (tracer (concat "trace.*smtp.*" (regexp-quote smtpmail-smtp-server))))
  1427. (mapcar
  1428. (lambda (buffy)
  1429. (if (string-match tracer (buffer-name buffy))
  1430. (progn
  1431. (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
  1432. (insert-buffer-substring buffy)
  1433. (insert "\n\n"))))
  1434. (buffer-list))))))
  1435. (declare-function smtp-via-smtp "ext:smtp" (sender recipients smtp-text-buffer))
  1436. (defvar smtp-server)
  1437. ;; FLIM's smtp.el pointed out to me by Kenichi Handa <handa@etl.go.jp>
  1438. (defun feedmail-buffer-to-smtp (prepped errors-to addr-listoid)
  1439. "Function which actually calls smtp-via-smtp to send buffer as e-mail."
  1440. (feedmail-say-debug ">in-> feedmail-buffer-to-smtp %s" addr-listoid)
  1441. (require 'smtp)
  1442. (if (not (smtp-via-smtp user-mail-address addr-listoid prepped))
  1443. (progn
  1444. (set-buffer errors-to)
  1445. (insert "Send via smtp failed. Probable SMTP protocol error.\n")
  1446. (insert "Look for details below or in the *Messages* buffer.\n\n")
  1447. (let ((case-fold-search t)
  1448. ;; don't be overconfident about the name of the trace buffer
  1449. (tracer (concat "trace.*smtp.*" (regexp-quote smtp-server))))
  1450. (mapcar
  1451. (lambda (buffy)
  1452. (if (string-match tracer (buffer-name buffy))
  1453. (progn
  1454. (insert "SMTP Trace from " (buffer-name buffy) "\n---------------")
  1455. (insert-buffer-substring buffy)
  1456. (insert "\n\n"))))
  1457. (buffer-list))))))
  1458. ;; just a place to park a docstring
  1459. (defconst feedmail-fiddle-plex-blurb nil
  1460. "A fiddle-plex is a concise way of specifying header field fiddling.
  1461. It is a list of up to 4 elements: NAME, VALUE, ACTION, FOLDING. The element
  1462. VALUE can also be a list sometimes.
  1463. NAME is the name of the header field to be fiddled with. Although case
  1464. doesn't matter in looking for headers, case of NAME is preserved when a header
  1465. is inserted via fiddling. It shouldn't include the trailing colon.
  1466. VALUE is either nil, a simple string, a function returning nil or a string, or,
  1467. as described below for ACTION `combine', a list of up to three values.
  1468. ACTION describes the nature of the fiddling to be done. Possibilities
  1469. for ACTION (default is `supplement'):
  1470. `supplement' Leave other like fields as-is, insert this one.
  1471. `replace' Delete other like fields, if any, and insert this one.
  1472. `create' Insert this one only if no like field exists.
  1473. `combine' Combine aggregate values of like fields with this one.
  1474. In this case, VALUE has a special form. It is a list
  1475. of three items: VAL-PRE, VAL-LIKE, and VAL-POST.
  1476. VAL-PRE and VAL-POST are strings or nil. VAL-LIKE may
  1477. be either a string or a function (it may also be nil,
  1478. but there's not much point to that).
  1479. Values of like header fields are aggregated, leading and
  1480. trailing whitespace is removed, and embedded
  1481. whitespace is left as-is. If there are no like
  1482. fields, or the aggregate value is an empty string,
  1483. VAL-LIKE is not used. Else, if VAL-LIKE is a function,
  1484. it is called with two arguments: NAME and the
  1485. aggregate like values. Else, if VAL-LIKE is a string, it is
  1486. used as a format string where a single \%s will be
  1487. replaced by the aggregate values of like fields.
  1488. VAL-PRE, the results of using VAL-LIKE, and VAL-POST
  1489. are concatenated, and the result, if not nil and not
  1490. an empty string, is used as the new value for the
  1491. field. Although this description sounds a bit
  1492. complicated, the idea is to provide a mechanism for
  1493. combining the old value with a new value in a flexible
  1494. way. For example, if you wanted to add a new value to
  1495. an existing header field by adding a semi-colon and
  1496. then starting the new value on a continuation line,
  1497. you might specify this:
  1498. (nil \"%s;\\n\\t\" \"This is my new value\")
  1499. FOLDING can be nil, in which case VALUE is used as-is. If FOLDING is
  1500. non-nil, feedmail \"smart filling\" is done on VALUE just before
  1501. insertion.")
  1502. (declare-function vm-mail "ext:vm" (&optional to subject))
  1503. (defun feedmail-vm-mail-mode (&optional arg)
  1504. "Make something like a buffer that has been created via `vm-mail'.
  1505. The optional argument is ignored and is just for argument compatibility with
  1506. `feedmail-queue-runner-mode-setter'. This function is suitable for being
  1507. applied to a file after you've just read it from disk: for example, a
  1508. feedmail FQM message file from a queue. You could use something like
  1509. this:
  1510. \(setq auto-mode-alist \(cons \'\(\"\\\\.fqm$\" . feedmail-vm-mail-mode\) auto-mode-alist\)\)
  1511. "
  1512. (feedmail-say-debug ">in-> feedmail-vm-mail-mode")
  1513. (let ((the-buf (current-buffer)))
  1514. (vm-mail)
  1515. (delete-region (point-min) (point-max))
  1516. (insert-buffer-substring the-buf)
  1517. (setq buffer-file-name (buffer-file-name the-buf))
  1518. (set-buffer-modified-p (buffer-modified-p the-buf))
  1519. ;; For some versions of emacs, saving the message to a queue
  1520. ;; triggers running the mode function on the buffer, and that
  1521. ;; leads (through a series of events I don't really understand)
  1522. ;; to this function being called while the buffer is still
  1523. ;; marked modified even though it is in the process of being
  1524. ;; saved. I guess the function gets called during the renaming
  1525. ;; that takes place en route to the save.
  1526. ;;
  1527. ;; This clearing of the marker probably wastes a buffer copy
  1528. ;; but it's easy to do and more reliable than figuring out what
  1529. ;; each variant of emacs does in this strange case.
  1530. (with-current-buffer the-buf
  1531. (set-buffer-modified-p nil))
  1532. (kill-buffer the-buf)
  1533. ))
  1534. ;;;###autoload
  1535. (defun feedmail-send-it ()
  1536. "Send the current mail buffer using the Feedmail package.
  1537. This is a suitable value for `send-mail-function'. It can be used
  1538. with various lower-level mechanisms to provide features such as queueing."
  1539. (feedmail-say-debug ">in-> feedmail-send-it")
  1540. (save-excursion
  1541. (let ((bfn-jiggle nil))
  1542. ;; if buffer-file-name is nil, temporarily use the stashed value
  1543. (if (and (not buffer-file-name) feedmail-queue-buffer-file-name)
  1544. (setq buffer-file-name feedmail-queue-buffer-file-name
  1545. bfn-jiggle t))
  1546. ;; avoid matching trouble over slash vs backslash by getting canonical
  1547. (if feedmail-queue-directory
  1548. (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
  1549. (if feedmail-queue-draft-directory
  1550. (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
  1551. (if (not feedmail-enable-queue) (feedmail-send-it-immediately-wrapper)
  1552. ;; else, queuing is enabled, should we ask about it or just do it?
  1553. (if feedmail-ask-before-queue
  1554. (funcall (feedmail-queue-send-edit-prompt))
  1555. (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue)))
  1556. ;; put this back
  1557. (if bfn-jiggle (setq feedmail-queue-buffer-file-name buffer-file-name))
  1558. )))
  1559. (defun feedmail-message-action-send ()
  1560. ;; hooks can make this take a while so clear the prompt
  1561. (feedmail-say-debug ">in-> feedmail-message-action-send")
  1562. (message "FQM: Immediate send...")
  1563. (feedmail-send-it-immediately-wrapper))
  1564. ;; From a VM mailing list discussion and some suggestions from Samuel Mikes <smikes@alumni.hmc.edu>
  1565. (defun feedmail-queue-express-to-queue ()
  1566. "Send message directly to the queue, with a minimum of fuss and bother."
  1567. (interactive)
  1568. (feedmail-say-debug ">in-> feedmail-queue-express-to-queue")
  1569. (run-hooks 'feedmail-queue-express-hook)
  1570. (let ((feedmail-enable-queue t)
  1571. (feedmail-ask-before-queue nil)
  1572. (feedmail-queue-reminder-alist nil)
  1573. (feedmail-queue-chatty-sit-for 0))
  1574. (feedmail-send-it)
  1575. )
  1576. )
  1577. (defun feedmail-queue-express-to-draft ()
  1578. "Send message directly to the draft queue, with a minimum of fuss and bother."
  1579. (interactive)
  1580. (feedmail-say-debug ">in-> feedmail-queue-express-to-draft")
  1581. (let ((feedmail-queue-directory feedmail-queue-draft-directory))
  1582. (feedmail-queue-express-to-queue)
  1583. )
  1584. )
  1585. (defun feedmail-message-action-send-strong ()
  1586. (feedmail-say-debug ">in-> feedmail-message-action-send-strong")
  1587. (let ((feedmail-confirm-outgoing nil)) (feedmail-message-action-send)))
  1588. (defun feedmail-message-action-edit ()
  1589. (feedmail-say-debug ">in-> feedmail-message-action-edit")
  1590. (error "FQM: Message not queued; returning to edit"))
  1591. (defun feedmail-message-action-draft ()
  1592. (feedmail-say-debug ">in-> feedmail-message-action-draft")
  1593. (feedmail-dump-message-to-queue feedmail-queue-draft-directory 'after-draft))
  1594. (defun feedmail-message-action-draft-strong ()
  1595. (feedmail-say-debug ">in-> feedmail-message-action-draft-strong")
  1596. (let ((buffer-file-name nil))
  1597. (feedmail-message-action-draft)))
  1598. (defun feedmail-message-action-queue ()
  1599. (feedmail-say-debug ">in-> feedmail-message-action-queue")
  1600. (feedmail-dump-message-to-queue feedmail-queue-directory 'after-queue))
  1601. (defun feedmail-message-action-queue-strong ()
  1602. (feedmail-say-debug ">in-> feedmail-message-action-queue-strong")
  1603. (let ((buffer-file-name nil))
  1604. (feedmail-message-action-queue)))
  1605. (defun feedmail-message-action-toggle-spray ()
  1606. (feedmail-say-debug ">in-> feedmail-message-action-toggle-spray")
  1607. (let ((feedmail-enable-spray (not feedmail-enable-spray)))
  1608. (if feedmail-enable-spray
  1609. (message "FQM: For this message, spray toggled ON")
  1610. (message "FQM: For this message, spray toggled OFF"))
  1611. (sit-for 3)
  1612. ;; recursion, but harmless
  1613. (feedmail-send-it)))
  1614. (defconst feedmail-p-h-b-n "*FQM Help*")
  1615. (defun feedmail-message-action-help ()
  1616. (feedmail-say-debug ">in-> feedmail-message-action-help")
  1617. (let ((d-string " ")
  1618. (fqm-help (get-buffer feedmail-p-h-b-n)))
  1619. (if (stringp feedmail-ask-before-queue-default)
  1620. (setq d-string feedmail-ask-before-queue-default)
  1621. (setq d-string (char-to-string feedmail-ask-before-queue-default)))
  1622. (if (and fqm-help (get-buffer-window fqm-help))
  1623. (feedmail-scroll-buffer 'up fqm-help)
  1624. (feedmail-message-action-help-blat d-string))
  1625. ;; recursive, but no worries (it goes deeper on user action)
  1626. (feedmail-send-it)))
  1627. (defun feedmail-message-action-help-blat (d-string)
  1628. (feedmail-say-debug ">in-> feedmail-message-action-help-blat")
  1629. (with-output-to-temp-buffer feedmail-p-h-b-n
  1630. (princ "You're dispatching a message and feedmail queuing is enabled.
  1631. Typing ? again will normally scroll this help buffer.
  1632. Choices:
  1633. q QUEUE for later sending \(via feedmail-run-the-queue\)
  1634. Q QUEUE! like \"q\", but always make a new file
  1635. i IMMEDIATELY send this \(but not the other queued messages\)
  1636. I IMMEDIATELY! like \"i\", but skip following confirmation prompt
  1637. d DRAFT queue in the draft directory
  1638. D DRAFT! like \"d\", but always make a new file
  1639. e EDIT return to the message edit buffer \(don't send or queue\)
  1640. * SPRAY toggle spray mode \(individual message transmissions\)
  1641. > SCROLL UP scroll message up \(toward end of message\)
  1642. < SCROLL DOWN scroll message down \(toward beginning of message\)
  1643. ? HELP show or scroll this help buffer
  1644. Synonyms:
  1645. s SEND immediately \(same as \"i\"\)
  1646. S SEND! immediately \(same as \"I\"\)
  1647. r ROUGH draft \(same as \"d\"\)
  1648. R ROUGH! draft \(same as \"D\"\)
  1649. n NOPE didn't mean it \(same as \"e\"\)
  1650. y YUP do the default behavior \(same as \"C-m\"\)
  1651. SPC SCROLL UP \(same as \">\"\)
  1652. The user-configurable default is currently \"")
  1653. (princ d-string)
  1654. (princ "\". For other possibilities,
  1655. see the variable feedmail-prompt-before-queue-user-alist.
  1656. ")
  1657. (and (stringp feedmail-prompt-before-queue-help-supplement)
  1658. (princ feedmail-prompt-before-queue-help-supplement))
  1659. (with-current-buffer standard-output
  1660. (if (fboundp 'help-mode) (help-mode)))))
  1661. (defun feedmail-message-action-scroll-up ()
  1662. (feedmail-say-debug ">in-> feedmail-message-action-scroll-up")
  1663. (feedmail-scroll-buffer 'up)
  1664. ;; recursive, but no worries (it goes deeper on user action)
  1665. (feedmail-send-it))
  1666. (defun feedmail-message-action-scroll-down ()
  1667. (feedmail-say-debug ">in-> feedmail-message-action-scroll-down")
  1668. (feedmail-scroll-buffer 'down)
  1669. ;; recursive, but no worries (it goes deeper on user action)
  1670. (feedmail-send-it))
  1671. ;;;###autoload
  1672. (defun feedmail-run-the-queue-no-prompts (&optional arg)
  1673. "Like `feedmail-run-the-queue', but suppress confirmation prompts."
  1674. (interactive "p")
  1675. (feedmail-say-debug ">in-> feedmail-run-the-queue-no-prompts")
  1676. (let ((feedmail-confirm-outgoing nil)) (feedmail-run-the-queue arg)))
  1677. ;;;###autoload
  1678. (defun feedmail-run-the-queue-global-prompt (&optional arg)
  1679. "Like `feedmail-run-the-queue', but with a global confirmation prompt.
  1680. This is generally most useful if run non-interactively, since you can
  1681. bail out with an appropriate answer to the global confirmation prompt."
  1682. (interactive "p")
  1683. (feedmail-say-debug ">in-> feedmail-run-the-queue-global-prompts")
  1684. (let ((feedmail-queue-runner-confirm-global t)) (feedmail-run-the-queue arg)))
  1685. ;; letf fools the byte-compiler.
  1686. (defvar file-name-buffer-file-type-alist)
  1687. ;;;###autoload
  1688. (defun feedmail-run-the-queue (&optional arg)
  1689. "Visit each message in the feedmail queue directory and send it out.
  1690. Return value is a list of three things: number of messages sent, number of
  1691. messages skipped, and number of non-message things in the queue (commonly
  1692. backup file names and the like)."
  1693. (interactive "p")
  1694. (feedmail-say-debug ">in-> feedmail-run-the-queue")
  1695. ;; avoid matching trouble over slash vs backslash by getting canonical
  1696. (if feedmail-queue-directory
  1697. (setq feedmail-queue-directory (expand-file-name feedmail-queue-directory)))
  1698. (if feedmail-queue-draft-directory
  1699. (setq feedmail-queue-draft-directory (expand-file-name feedmail-queue-draft-directory)))
  1700. (let* ((maybe-file)
  1701. (qlist (feedmail-look-at-queue-directory feedmail-queue-directory))
  1702. (dlist (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
  1703. (q-cnt (nth 0 qlist))
  1704. (q-oth (nth 1 qlist))
  1705. (d-cnt (nth 0 dlist))
  1706. (d-oth (nth 1 dlist))
  1707. (messages-sent 0)
  1708. (messages-skipped 0)
  1709. (blobby-buffer)
  1710. (already-buffer)
  1711. (do-the-run t)
  1712. (list-of-possible-fqms))
  1713. (if (and (> q-cnt 0) feedmail-queue-runner-confirm-global)
  1714. (setq do-the-run
  1715. (if (fboundp 'y-or-n-p-with-timeout)
  1716. (y-or-n-p-with-timeout (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
  1717. d-cnt d-oth q-cnt q-oth)
  1718. 5 nil)
  1719. (y-or-n-p (format "FQM: Draft: %dm+%d, Queue: %dm+%d; run the queue? "
  1720. d-cnt d-oth q-cnt q-oth))
  1721. )))
  1722. (if (not do-the-run)
  1723. (setq messages-skipped q-cnt)
  1724. (save-window-excursion
  1725. (setq list-of-possible-fqms (directory-files feedmail-queue-directory t))
  1726. (if feedmail-queue-run-orderer
  1727. (setq list-of-possible-fqms (funcall feedmail-queue-run-orderer list-of-possible-fqms)))
  1728. (mapc
  1729. (lambda (blobby)
  1730. (setq maybe-file (expand-file-name blobby feedmail-queue-directory))
  1731. (cond
  1732. ((file-directory-p maybe-file) nil) ; don't care about subdirs
  1733. ((feedmail-fqm-p blobby)
  1734. (setq blobby-buffer (generate-new-buffer (concat "FQM " blobby)))
  1735. (setq already-buffer
  1736. (if (fboundp 'find-buffer-visiting) ; missing from XEmacs
  1737. (find-buffer-visiting maybe-file)
  1738. (get-file-buffer maybe-file)))
  1739. (if (and already-buffer (buffer-modified-p already-buffer))
  1740. (save-window-excursion
  1741. (display-buffer (set-buffer already-buffer))
  1742. (if (fboundp 'y-or-n-p-with-timeout)
  1743. ;; make a guess that the user just forgot to save
  1744. (if (y-or-n-p-with-timeout (format "FQM: Visiting %s; save before send? " blobby) 10 t)
  1745. (save-buffer))
  1746. (if (y-or-n-p (format "FQM: Visiting %s; save before send? " blobby))
  1747. (save-buffer))
  1748. )))
  1749. (set-buffer blobby-buffer)
  1750. (setq buffer-offer-save nil)
  1751. (buffer-disable-undo blobby-buffer)
  1752. (insert-file-contents-literally maybe-file)
  1753. (setq buffer-file-type t) ; binary
  1754. (goto-char (point-min))
  1755. ;; if at least two line-endings with CRLF, translate the file
  1756. (if (looking-at ".*\r\n.*\r\n")
  1757. (while (search-forward "\r\n" nil t)
  1758. (replace-match "\n" nil t)))
  1759. ;; ;; work around text-vs-binary weirdness
  1760. ;; ;; if we don't find the normal M-H-S, try reading the file a different way
  1761. ;; (if (not (feedmail-find-eoh t))
  1762. ;; (let ((file-name-buffer-file-type-alist nil) (default-buffer-file-type nil))
  1763. ;; (erase-buffer)
  1764. ;; (insert-file-contents maybe-file)))
  1765. (funcall feedmail-queue-runner-mode-setter arg)
  1766. (condition-case signal-stuff ; don't give up the loop if user skips some
  1767. (let ((feedmail-enable-queue nil)
  1768. (feedmail-queue-runner-is-active maybe-file))
  1769. ;; if can't find EOH, this is no message!
  1770. (unless (feedmail-find-eoh t)
  1771. (feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file)
  1772. (error "FQM: you should never see this message"))
  1773. (feedmail-say-debug "Prepping %s" maybe-file)
  1774. ;; the catch is a way out for users to voluntarily skip sending a message
  1775. (catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg))
  1776. (set-buffer blobby-buffer)
  1777. (if (buffer-modified-p) ; still modified, means wasn't sent
  1778. (progn
  1779. (setq messages-skipped (1+ messages-skipped))
  1780. (feedmail-say-chatter "%s wasn't sent by %s" maybe-file feedmail-buffer-eating-function))
  1781. (setq messages-sent (1+ messages-sent))
  1782. (funcall feedmail-queue-runner-cleaner-upper maybe-file arg)
  1783. (if (and already-buffer (not (file-exists-p maybe-file)))
  1784. ;; we have gotten rid of the file associated with the
  1785. ;; buffer, so update the buffer's notion of that
  1786. (with-current-buffer already-buffer
  1787. (setq buffer-file-name nil)))))
  1788. ;; the handler for the condition-case
  1789. (error (setq messages-skipped (1+ messages-skipped))
  1790. (ding t)
  1791. (message "FQM: Trapped '%s', message left in queue." (car signal-stuff))
  1792. (sit-for 3)
  1793. (message "FQM: Trap details: \"%s\""
  1794. (mapconcat 'identity (cdr signal-stuff) "\" \""))
  1795. (sit-for 3)))
  1796. (kill-buffer blobby-buffer)
  1797. (feedmail-say-chatter
  1798. "%d to go, %d sent, %d skipped (%d other files ignored)"
  1799. (- q-cnt messages-sent messages-skipped)
  1800. messages-sent messages-skipped q-oth)
  1801. )))
  1802. list-of-possible-fqms)))
  1803. (if feedmail-queue-chatty
  1804. (progn
  1805. (feedmail-say-chatter "%d sent, %d skipped (%d other files ignored)"
  1806. messages-sent messages-skipped q-oth)
  1807. (feedmail-queue-reminder 'after-run)
  1808. (sit-for feedmail-queue-chatty-sit-for)))
  1809. (list messages-sent messages-skipped q-oth)))
  1810. ;;;###autoload
  1811. (defun feedmail-queue-reminder (&optional what-event)
  1812. "Perform some kind of reminder activity about queued and draft messages.
  1813. Called with an optional symbol argument which says what kind of event
  1814. is triggering the reminder activity. The default is 'on-demand, which
  1815. is what you typically would use if you were putting this in your Emacs start-up
  1816. or mail hook code. Other recognized values for WHAT-EVENT (these are passed
  1817. internally by feedmail):
  1818. after-immediate (a message has just been sent in immediate mode)
  1819. after-queue (a message has just been queued)
  1820. after-draft (a message has just been placed in the draft directory)
  1821. after-run (the queue has just been run, possibly sending messages)
  1822. WHAT-EVENT is used as a key into the table `feedmail-queue-reminder-alist'. If
  1823. the associated value is a function, it is called without arguments and is expected
  1824. to perform the reminder activity. You can supply your own reminder functions
  1825. by redefining `feedmail-queue-reminder-alist'. If you don't want any reminders,
  1826. you can set `feedmail-queue-reminder-alist' to nil."
  1827. (interactive "p")
  1828. (feedmail-say-debug ">in-> feedmail-queue-reminder %s" what-event)
  1829. (let ((key (if (and what-event (symbolp what-event)) what-event 'on-demand)) entry reminder)
  1830. (setq entry (assoc key feedmail-queue-reminder-alist))
  1831. (setq reminder (cdr entry))
  1832. (if (fboundp reminder) (funcall reminder)))
  1833. )
  1834. (defun feedmail-queue-reminder-brief ()
  1835. "Brief display of draft and queued message counts in minibuffer."
  1836. (interactive)
  1837. (feedmail-say-debug ">in-> feedmail-queue-reminder-brief")
  1838. (let (q-cnt d-cnt q-lis d-lis)
  1839. (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
  1840. (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
  1841. (setq q-cnt (car q-lis))
  1842. (setq d-cnt (car d-lis))
  1843. (if (or (> q-cnt 0) (> d-cnt 0))
  1844. (progn
  1845. (message "FQM: [D: %d, Q: %d]" d-cnt q-cnt))))
  1846. )
  1847. (defun feedmail-queue-reminder-medium ()
  1848. "Verbose display of draft and queued message counts in minibuffer."
  1849. (interactive)
  1850. (feedmail-say-debug ">in-> feedmail-queue-reminder-medium")
  1851. (let (q-cnt d-cnt q-oth d-oth q-lis d-lis)
  1852. (setq q-lis (feedmail-look-at-queue-directory feedmail-queue-directory))
  1853. (setq d-lis (feedmail-look-at-queue-directory feedmail-queue-draft-directory))
  1854. (setq q-cnt (car q-lis))
  1855. (setq d-cnt (car d-lis))
  1856. (setq q-oth (nth 1 q-lis))
  1857. (setq d-oth (nth 1 d-lis))
  1858. (if (or (> q-cnt 0) (> d-cnt 0))
  1859. (progn
  1860. (message "FQM: Draft: %dm+%d in \"%s\", Queue: %dm+%d in \"%s\""
  1861. d-cnt d-oth (file-name-nondirectory feedmail-queue-draft-directory)
  1862. q-cnt q-oth (file-name-nondirectory feedmail-queue-directory)))))
  1863. )
  1864. (defun feedmail-queue-send-edit-prompt ()
  1865. "Ask whether to queue, send immediately, or return to editing a message, etc."
  1866. (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt")
  1867. (feedmail-queue-send-edit-prompt-inner
  1868. feedmail-ask-before-queue-default
  1869. feedmail-ask-before-queue-prompt
  1870. feedmail-ask-before-queue-reprompt
  1871. 'feedmail-message-action-help
  1872. feedmail-prompt-before-queue-standard-alist
  1873. feedmail-prompt-before-queue-user-alist
  1874. ))
  1875. (defun feedmail-queue-runner-prompt ()
  1876. "Ask whether to queue, send immediately, or return to editing a message, etc."
  1877. (feedmail-say-debug ">in-> feedmail-queue-runner-prompt")
  1878. (feedmail-queue-send-edit-prompt-inner
  1879. feedmail-ask-before-queue-default
  1880. feedmail-ask-before-queue-prompt
  1881. feedmail-ask-before-queue-reprompt
  1882. 'feedmail-message-action-help
  1883. feedmail-prompt-before-queue-standard-alist
  1884. feedmail-prompt-before-queue-user-alist
  1885. ))
  1886. (defun feedmail-queue-send-edit-prompt-inner (default prompt reprompt helper
  1887. standard-alist user-alist)
  1888. (feedmail-say-debug ">in-> feedmail-queue-send-edit-prompt-inner")
  1889. ;; Some implementation ideas here came from the userlock.el code
  1890. (or defining-kbd-macro (discard-input))
  1891. (save-window-excursion
  1892. (let ((answer) (d-char) (d-string " "))
  1893. (if (stringp default)
  1894. (progn
  1895. (setq d-char (string-to-char default)
  1896. d-string default))
  1897. (setq d-string (char-to-string default))
  1898. (setq d-char default)
  1899. )
  1900. (while (null answer)
  1901. (message prompt d-string)
  1902. (let ((user-sez
  1903. (let ((inhibit-quit t) (cursor-in-echo-area t) (echo-keystrokes 0))
  1904. (read-char-exclusive))))
  1905. (if (= user-sez help-char)
  1906. (setq answer '(^ . helper))
  1907. (if (or (eq user-sez ?\C-m) (eq user-sez ?\C-j) (eq user-sez ?y))
  1908. (setq user-sez d-char))
  1909. ;; these char-to-int things are because of some
  1910. ;; incomprehensible difference between the two in
  1911. ;; byte-compiled stuff between Emacs and XEmacs
  1912. ;; (well, I'm sure someone could comprehend it,
  1913. ;; but I say 'uncle')
  1914. (setq answer (or (assoc user-sez user-alist)
  1915. (and (fboundp 'char-to-int)
  1916. (assoc (char-to-int user-sez) user-alist))
  1917. (assoc user-sez standard-alist)
  1918. (and (fboundp 'char-to-int)
  1919. (assoc (char-to-int user-sez) standard-alist))))
  1920. (if (or (null answer) (null (cdr answer)))
  1921. (progn
  1922. (beep)
  1923. (message reprompt d-string)
  1924. (sit-for 3)))
  1925. )))
  1926. (cdr answer)
  1927. )))
  1928. (defun feedmail-scroll-buffer (direction &optional buffy)
  1929. ;; scrolling fun
  1930. ;; emacs convention is that scroll-up moves text up, window down
  1931. (feedmail-say-debug ">in-> feedmail-scroll-buffer %s" direction)
  1932. (save-selected-window
  1933. (let ((signal-error-on-buffer-boundary nil)
  1934. (fqm-window (display-buffer (if buffy buffy (current-buffer)))))
  1935. (select-window fqm-window)
  1936. (if (eq direction 'up)
  1937. (if (pos-visible-in-window-p (point-max) fqm-window)
  1938. ;; originally just (goto-char (point-min)), but
  1939. ;; pos-visible-in-window-p seems oblivious to that
  1940. (scroll-down 999999)
  1941. (scroll-up))
  1942. (if (pos-visible-in-window-p (point-min) fqm-window)
  1943. (scroll-up 999999)
  1944. (scroll-down))))))
  1945. (defun feedmail-look-at-queue-directory (queue-directory)
  1946. "Find out some things about a queue directory.
  1947. Result is a list containing a count of queued messages in the
  1948. directory, a count of other files in the directory, and a high water
  1949. mark for prefix sequence numbers. Subdirectories are not included in
  1950. the counts."
  1951. (feedmail-say-debug ">in-> feedmail-look-at-queue-directory %s" queue-directory)
  1952. (let ((q-cnt 0) (q-oth 0) (high-water 0) (blobbet))
  1953. ;; iterate, counting things we find along the way in the directory
  1954. (if (file-directory-p queue-directory)
  1955. (mapc
  1956. (lambda (blobby)
  1957. (cond
  1958. ((file-directory-p blobby) nil) ; don't care about subdirs
  1959. ((feedmail-fqm-p blobby)
  1960. (setq blobbet (file-name-nondirectory blobby))
  1961. (if (string-match "^[0-9][0-9][0-9]-" blobbet)
  1962. (let ((water-mark))
  1963. (setq water-mark (string-to-number (substring blobbet 0 3)))
  1964. (if (> water-mark high-water) (setq high-water water-mark))))
  1965. (setq q-cnt (1+ q-cnt)))
  1966. (t (setq q-oth (1+ q-oth)))
  1967. ))
  1968. (directory-files queue-directory t)))
  1969. (list q-cnt q-oth high-water)))
  1970. (defun feedmail-tidy-up-slug (slug)
  1971. "Utility for mapping out suspect characters in a potential filename."
  1972. (feedmail-say-debug ">in-> feedmail-tidy-up-slug %s" slug)
  1973. ;; even programmers deserve a break sometimes, so cover nil for them
  1974. (if (null slug) (setq slug ""))
  1975. ;; replace all non-alphanumerics with hyphen for safety
  1976. (while (string-match feedmail-queue-slug-suspect-regexp slug) (setq slug (replace-match "-" nil nil slug)))
  1977. ;; collapse multiple hyphens to one
  1978. (while (string-match "--+" slug) (setq slug (replace-match "-" nil nil slug)))
  1979. ;; for tidiness, peel off leading hyphens
  1980. (if (string-match "^-*" slug) (setq slug (replace-match "" nil nil slug)))
  1981. ;; for tidiness, peel off trailing hyphens
  1982. (if (string-match "-*$" slug) (setq slug (replace-match "" nil nil slug)))
  1983. slug
  1984. )
  1985. (defun feedmail-queue-subject-slug-maker (&optional queue-directory)
  1986. "Create a name for storing the message in the queue.
  1987. Optional argument QUEUE-DIRECTORY specifies into which directory the
  1988. file will be placed. The name is based on the Subject: header (if
  1989. there is one). If there is no subject,
  1990. `feedmail-queue-default-file-slug' is consulted. Special characters are
  1991. mapped to mostly alphanumerics for safety."
  1992. (feedmail-say-debug ">in-> feedmail-queue-subject-slug-maker %s" queue-directory)
  1993. (let ((eoh-marker) (case-fold-search t) (subject "") (s-point))
  1994. (setq eoh-marker (feedmail-find-eoh))
  1995. (goto-char (point-min))
  1996. ;; get raw subject value (first line, anyhow)
  1997. (if (re-search-forward "^Subject:" eoh-marker t)
  1998. (progn (setq s-point (point))
  1999. (end-of-line)
  2000. (setq subject (buffer-substring-no-properties s-point (point)))))
  2001. (setq subject (feedmail-tidy-up-slug subject))
  2002. (if (zerop (length subject))
  2003. (setq subject
  2004. (cond
  2005. ((stringp feedmail-queue-default-file-slug) feedmail-queue-default-file-slug)
  2006. ((fboundp feedmail-queue-default-file-slug)
  2007. (save-excursion (funcall feedmail-queue-default-file-slug)))
  2008. ((eq feedmail-queue-default-file-slug 'ask)
  2009. (file-name-nondirectory
  2010. (read-file-name "FQM: Message filename slug? "
  2011. (file-name-as-directory queue-directory) subject nil subject)))
  2012. (t "no subject"))
  2013. ))
  2014. ;; one more time, with feeling
  2015. (feedmail-tidy-up-slug subject)
  2016. ))
  2017. (defun feedmail-create-queue-filename (queue-directory)
  2018. (feedmail-say-debug ">in-> feedmail-create-queue-filename %s" queue-directory)
  2019. (let ((slug "wjc"))
  2020. (cond
  2021. (feedmail-queue-slug-maker
  2022. (save-excursion (setq slug (funcall feedmail-queue-slug-maker queue-directory))))
  2023. (feedmail-ask-for-queue-slug
  2024. (setq slug (file-name-nondirectory
  2025. (read-file-name (concat "FQM: Message filename slug? [" slug "]? ")
  2026. (file-name-as-directory queue-directory) slug nil slug))))
  2027. )
  2028. (setq slug (feedmail-tidy-up-slug slug))
  2029. (setq slug (format "%03d-%s" (1+ (nth 2 (feedmail-look-at-queue-directory queue-directory))) slug))
  2030. (concat
  2031. (expand-file-name slug queue-directory)
  2032. feedmail-queue-fqm-suffix)
  2033. ))
  2034. (defun feedmail-dump-message-to-queue (queue-directory what-event)
  2035. (feedmail-say-debug ">in-> feedmail-dump-message-to-queue %s %s" queue-directory what-event)
  2036. (or (file-accessible-directory-p queue-directory)
  2037. ;; progn to get nil result no matter what
  2038. (progn (make-directory queue-directory t) nil)
  2039. (file-accessible-directory-p queue-directory)
  2040. (error "FQM: Message not queued; trouble with directory %s" queue-directory))
  2041. (let ((filename)
  2042. (is-fqm)
  2043. (is-in-this-dir)
  2044. (previous-buffer-file-name buffer-file-name))
  2045. (if buffer-file-name
  2046. (progn
  2047. (setq is-fqm (feedmail-fqm-p buffer-file-name))
  2048. (setq is-in-this-dir (string-equal
  2049. (directory-file-name
  2050. (expand-file-name queue-directory))
  2051. (directory-file-name (expand-file-name (file-name-directory buffer-file-name)))))))
  2052. ;; if visiting a queued message, just save
  2053. (if (and is-fqm is-in-this-dir)
  2054. (setq filename buffer-file-name)
  2055. (setq filename (feedmail-create-queue-filename queue-directory)))
  2056. ;; make binary file on DOS/Win95/WinNT, etc
  2057. (let ((buffer-file-type feedmail-force-binary-write))
  2058. (write-file filename))
  2059. ;; convenient for moving from draft to q, for example
  2060. (if (and previous-buffer-file-name (or (not is-fqm) (not is-in-this-dir))
  2061. (let (d b s)
  2062. (setq b (file-name-nondirectory previous-buffer-file-name))
  2063. (setq d (file-name-directory previous-buffer-file-name))
  2064. (setq s (substring d (1- (length d))))
  2065. (setq d (substring d 0 (1- (length d))))
  2066. (setq d (file-name-nondirectory d))
  2067. (y-or-n-p (format "FQM: Was previously %s%s%s; delete that? "
  2068. d s b))))
  2069. (delete-file previous-buffer-file-name))
  2070. (if feedmail-nuke-buffer-after-queue
  2071. (let ((a-s-file-name buffer-auto-save-file-name))
  2072. ;; be aggressive in nuking auto-save files
  2073. (and (kill-buffer (current-buffer))
  2074. delete-auto-save-files
  2075. (file-exists-p a-s-file-name)
  2076. (delete-file a-s-file-name))))
  2077. (feedmail-say-chatter "Queued in %s" filename)
  2078. (if feedmail-queue-chatty
  2079. (progn
  2080. (feedmail-queue-reminder what-event)
  2081. (sit-for feedmail-queue-chatty-sit-for)))))
  2082. ;; from a similar function in mail-utils.el
  2083. (defun feedmail-rfc822-time-zone (time)
  2084. (feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
  2085. (let* ((sec (or (car (current-time-zone time)) 0))
  2086. (absmin (/ (abs sec) 60)))
  2087. (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
  2088. (defun feedmail-rfc822-date (arg-time)
  2089. (feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
  2090. (let ((time (if arg-time arg-time (current-time)))
  2091. (system-time-locale "C"))
  2092. (concat
  2093. (format-time-string "%a, %e %b %Y %T " time)
  2094. (feedmail-rfc822-time-zone time)
  2095. )))
  2096. (defun feedmail-send-it-immediately-wrapper ()
  2097. "Wrapper to catch skip-me-i"
  2098. (if (eq 'skip-me-i (catch 'skip-me-i (feedmail-send-it-immediately)))
  2099. (error "FQM: Sending...abandoned!")))
  2100. (declare-function expand-mail-aliases "mailalias" (beg end &optional exclude))
  2101. (defun feedmail-send-it-immediately ()
  2102. "Handle immediate sending, including during a queue run."
  2103. (feedmail-say-debug ">in-> feedmail-send-it-immediately")
  2104. (let ((feedmail-error-buffer (get-buffer-create " *FQM Outgoing Email Errors*"))
  2105. (feedmail-prepped-text-buffer (get-buffer-create " *FQM Outgoing Email Text*"))
  2106. (feedmail-raw-text-buffer (current-buffer))
  2107. (feedmail-address-list)
  2108. (eoh-marker)
  2109. (bcc-holder)
  2110. (resent-bcc-holder)
  2111. (a-re-rtcb "^Resent-\\(To\\|Cc\\|Bcc\\):")
  2112. (a-re-rtc "^Resent-\\(To\\|Cc\\):")
  2113. (a-re-rb "^Resent-Bcc:")
  2114. (a-re-dtcb "^\\(To\\|Cc\\|Bcc\\):")
  2115. (a-re-dtc "^\\(To\\|Cc\\):")
  2116. (a-re-db "^Bcc:")
  2117. ;; to get a temporary changeable copy
  2118. (mail-header-separator mail-header-separator)
  2119. )
  2120. (unwind-protect
  2121. (save-current-buffer
  2122. (set-buffer feedmail-error-buffer) (erase-buffer)
  2123. (set-buffer feedmail-prepped-text-buffer) (erase-buffer)
  2124. ;; jam contents of user-supplied mail buffer into our scratch buffer
  2125. (insert-buffer-substring feedmail-raw-text-buffer)
  2126. ;; require one newline at the end.
  2127. (goto-char (point-max))
  2128. (or (= (preceding-char) ?\n) (insert ?\n))
  2129. (let ((case-fold-search nil))
  2130. ;; Change header-delimiter to be what mailers expect (empty line).
  2131. ;; leaves match data in place or signals error
  2132. (feedmail-say-debug "looking for m-h-s \"%s\""
  2133. mail-header-separator)
  2134. (setq eoh-marker (feedmail-find-eoh))
  2135. (feedmail-say-debug "found m-h-s %s" eoh-marker)
  2136. (setq mail-header-separator "")
  2137. (replace-match ""))
  2138. ;; (replace-match "\\1")) ;; might be empty or "\r"
  2139. ;; mail-aliases nil = mail-abbrevs.el
  2140. (feedmail-say-debug "expanding mail aliases")
  2141. (if (or feedmail-force-expand-mail-aliases
  2142. (and (fboundp 'expand-mail-aliases) mail-aliases))
  2143. (expand-mail-aliases (point-min) eoh-marker))
  2144. ;; make it pretty
  2145. (if feedmail-fill-to-cc (feedmail-fill-to-cc-function eoh-marker))
  2146. ;; ignore any blank lines in the header
  2147. (goto-char (point-min))
  2148. (while (and (re-search-forward "\n\n\n*" eoh-marker t) (< (point) eoh-marker))
  2149. (replace-match "\n"))
  2150. (let ((case-fold-search t) (addr-regexp))
  2151. (goto-char (point-min))
  2152. ;; there are some RFC-822 combinations/cases missed here,
  2153. ;; but probably good enough and what users expect
  2154. ;;
  2155. ;; use resent-* stuff only if there is at least one non-empty one
  2156. (setq feedmail-is-a-resend
  2157. (re-search-forward
  2158. ;; header name, followed by optional whitespace, followed by
  2159. ;; non-whitespace, followed by anything, followed by newline;
  2160. ;; the idea is empty Resent-* headers are ignored
  2161. "^\\(Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)\\s-*\\S-+.*$"
  2162. eoh-marker t))
  2163. ;; if we say so, gather the Bcc stuff before the main course
  2164. (if (eq feedmail-deduce-bcc-where 'first)
  2165. (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
  2166. (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
  2167. ;; the main course
  2168. (if (or (eq feedmail-deduce-bcc-where 'first) (eq feedmail-deduce-bcc-where 'last))
  2169. ;; handled by first or last cases, so don't get Bcc stuff
  2170. (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtc) (setq addr-regexp a-re-dtc))
  2171. (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list)))
  2172. ;; not handled by first or last cases, so also get Bcc stuff
  2173. (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rtcb) (setq addr-regexp a-re-dtcb))
  2174. (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
  2175. ;; if we say so, gather the Bcc stuff after the main course
  2176. (if (eq feedmail-deduce-bcc-where 'last)
  2177. (progn (if feedmail-is-a-resend (setq addr-regexp a-re-rb) (setq addr-regexp a-re-db))
  2178. (setq feedmail-address-list (feedmail-deduce-address-list feedmail-prepped-text-buffer (point-min) eoh-marker addr-regexp feedmail-address-list))))
  2179. (if (not feedmail-address-list) (error "FQM: Sending...abandoned, no addressees"))
  2180. ;; not needed, but meets user expectations
  2181. (setq feedmail-address-list (nreverse feedmail-address-list))
  2182. ;; Find and handle any Bcc fields.
  2183. (setq bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Bcc:"))
  2184. (setq resent-bcc-holder (feedmail-accume-n-nuke-header eoh-marker "^Resent-Bcc:"))
  2185. (if (and bcc-holder (not feedmail-nuke-bcc))
  2186. (progn (goto-char (point-min))
  2187. (insert bcc-holder)))
  2188. (if (and resent-bcc-holder (not feedmail-nuke-resent-bcc))
  2189. (progn (goto-char (point-min))
  2190. (insert resent-bcc-holder)))
  2191. (goto-char (point-min))
  2192. ;; fiddle about, fiddle about, fiddle about....
  2193. (feedmail-fiddle-from)
  2194. (feedmail-fiddle-sender)
  2195. (feedmail-fiddle-x-mailer)
  2196. (feedmail-fiddle-message-id
  2197. (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
  2198. (feedmail-fiddle-date
  2199. (or feedmail-queue-runner-is-active (buffer-file-name feedmail-raw-text-buffer)))
  2200. (feedmail-fiddle-list-of-fiddle-plexes feedmail-fiddle-plex-user-list)
  2201. ;; don't send out a blank headers of various sorts
  2202. ;; (this loses on continued line with a blank first line)
  2203. (goto-char (point-min))
  2204. (and feedmail-nuke-empty-headers ; hey, who's an empty-header?
  2205. (while (re-search-forward "^[A-Za-z0-9-]+:[ \t]*\n" eoh-marker t)
  2206. (replace-match ""))))
  2207. (feedmail-say-debug "last chance hook: %s" feedmail-last-chance-hook)
  2208. (run-hooks 'feedmail-last-chance-hook)
  2209. (save-window-excursion
  2210. (let ((fcc (feedmail-accume-n-nuke-header eoh-marker "^Fcc:"))
  2211. (also-file)
  2212. (confirm (cond
  2213. ((eq feedmail-confirm-outgoing 'immediate)
  2214. (not feedmail-queue-runner-is-active))
  2215. ((eq feedmail-confirm-outgoing 'queued) feedmail-queue-runner-is-active)
  2216. (t feedmail-confirm-outgoing)))
  2217. (fullframe (cond
  2218. ((eq feedmail-display-full-frame 'immediate)
  2219. (not feedmail-queue-runner-is-active))
  2220. ((eq feedmail-display-full-frame 'queued) feedmail-queue-runner-is-active)
  2221. (t feedmail-display-full-frame))))
  2222. (if fullframe
  2223. (progn
  2224. (switch-to-buffer feedmail-prepped-text-buffer t)
  2225. (delete-other-windows)))
  2226. (if (or (not confirm) (feedmail-one-last-look feedmail-prepped-text-buffer))
  2227. (let ((user-mail-address (feedmail-envelope-deducer eoh-marker)))
  2228. (feedmail-say-debug "give it to buffer-eater")
  2229. (feedmail-give-it-to-buffer-eater)
  2230. (feedmail-say-debug "gave it to buffer-eater")
  2231. (if (and (not feedmail-queue-runner-is-active) (setq also-file (buffer-file-name feedmail-raw-text-buffer)))
  2232. (progn ; if a file but not running the queue, offer to delete it
  2233. (setq also-file (expand-file-name also-file))
  2234. (when (or feedmail-queue-auto-file-nuke
  2235. (y-or-n-p
  2236. (format "FQM: Delete message file %s? "
  2237. also-file)))
  2238. ;; if we delete the affiliated file, get rid
  2239. ;; of the file name association and make sure we
  2240. ;; don't annoy people with a prompt on exit
  2241. (delete-file also-file)
  2242. (with-current-buffer feedmail-raw-text-buffer
  2243. (setq buffer-offer-save nil)
  2244. (setq buffer-file-name nil)))))
  2245. (goto-char (point-min))
  2246. ;; re-insert and handle any Fcc fields (and, optionally, any Bcc).
  2247. (if fcc (letf (((default-value 'buffer-file-type)
  2248. feedmail-force-binary-write))
  2249. (insert fcc)
  2250. (if (not feedmail-nuke-bcc-in-fcc)
  2251. (progn (if bcc-holder (insert bcc-holder))
  2252. (if resent-bcc-holder (insert resent-bcc-holder))))
  2253. (run-hooks 'feedmail-before-fcc-hook)
  2254. (if feedmail-nuke-body-in-fcc
  2255. (progn (goto-char eoh-marker)
  2256. (if (natnump feedmail-nuke-body-in-fcc)
  2257. (forward-line feedmail-nuke-body-in-fcc))
  2258. (delete-region (point) (point-max))
  2259. ))
  2260. (mail-do-fcc eoh-marker)
  2261. )))
  2262. ;; user bailed out of one-last-look
  2263. (if feedmail-queue-runner-is-active
  2264. (throw 'skip-me-q 'skip-me-q)
  2265. (throw 'skip-me-i 'skip-me-i))
  2266. )))) ; unwind-protect body (save-excursion)
  2267. ;; unwind-protect cleanup forms
  2268. (kill-buffer feedmail-prepped-text-buffer)
  2269. (set-buffer feedmail-error-buffer)
  2270. (if (zerop (buffer-size)) (kill-buffer feedmail-error-buffer)
  2271. (progn (display-buffer feedmail-error-buffer)
  2272. ;; read fast ... the meter is running
  2273. (if feedmail-queue-runner-is-active
  2274. (progn
  2275. (ding t)
  2276. (feedmail-say-chatter "Sending...failed")))
  2277. (error "FQM: Sending...failed")))
  2278. (set-buffer feedmail-raw-text-buffer))
  2279. ) ; let
  2280. (if (and feedmail-queue-chatty (not feedmail-queue-runner-is-active))
  2281. (progn
  2282. (feedmail-queue-reminder 'after-immediate)
  2283. (sit-for feedmail-queue-chatty-sit-for)))
  2284. )
  2285. (defun feedmail-fiddle-header (name value &optional action folding)
  2286. "Internal feedmail function for jamming fields into message header.
  2287. NAME, VALUE, ACTION, and FOLDING are the four elements of a
  2288. fiddle-plex, as described in the documentation for the variable
  2289. `feedmail-fiddle-plex-blurb'."
  2290. (feedmail-say-debug ">in-> feedmail-fiddle-header %s %s %s %s"
  2291. name value action folding)
  2292. (let ((case-fold-search t)
  2293. (header-colon (concat (regexp-quote name) ":"))
  2294. header-regexp eoh-marker has-like ag-like val-like that-point)
  2295. (setq header-regexp (concat "^" header-colon))
  2296. (setq eoh-marker (feedmail-find-eoh))
  2297. (goto-char (point-min))
  2298. (setq has-like (re-search-forward header-regexp eoh-marker t))
  2299. (if (not action) (setq action 'supplement))
  2300. (cond
  2301. ((eq action 'supplement)
  2302. ;; trim leading/trailing whitespace
  2303. (if (string-match "\\`[ \t\n]+" value)
  2304. (setq value (substring value (match-end 0))))
  2305. (if (string-match "[ \t\n]+\\'" value)
  2306. (setq value (substring value 0 (match-beginning 0))))
  2307. (if (> (length value) 0)
  2308. (progn
  2309. (if feedmail-fiddle-headers-upwardly
  2310. (goto-char (point-min))
  2311. (goto-char eoh-marker))
  2312. (setq that-point (point))
  2313. (insert name ": " value "\n")
  2314. (if folding (feedmail-fill-this-one that-point (point))))))
  2315. ((eq action 'replace)
  2316. (if has-like (feedmail-accume-n-nuke-header eoh-marker header-regexp))
  2317. (feedmail-fiddle-header name value 'supplement folding))
  2318. ((eq action 'create)
  2319. (if (not has-like) (feedmail-fiddle-header name value 'supplement folding)))
  2320. ((eq action 'combine)
  2321. (setq val-like (nth 1 value))
  2322. (setq ag-like (or (feedmail-accume-n-nuke-header eoh-marker header-regexp) ""))
  2323. ;; get rid of initial header name from first instance (front of string)
  2324. (if (string-match (concat header-regexp "[ \t\n]+") ag-like)
  2325. (setq ag-like (replace-match "" t t ag-like)))
  2326. ;; get rid of embedded header names from subsequent instances
  2327. (while (string-match (concat "\n" header-colon "[ \t\n]+") ag-like)
  2328. (setq ag-like (replace-match "\n\t" t t ag-like)))
  2329. ;; trim leading/trailing whitespace
  2330. (if (string-match "\\`[ \t\n]+" ag-like)
  2331. (setq ag-like (substring ag-like (match-end 0))))
  2332. (if (string-match "[ \t\n]+\\'" ag-like)
  2333. (setq ag-like (substring ag-like 0 (match-beginning 0))))
  2334. ;; if ag-like is not nil and not an empty string, transform it via a function
  2335. ;; call or format operation
  2336. (if (> (length ag-like) 0)
  2337. (setq ag-like
  2338. (cond
  2339. ((and (symbolp val-like) (fboundp val-like))
  2340. (funcall val-like name ag-like))
  2341. ((stringp val-like)
  2342. (format val-like ag-like))
  2343. (t nil))))
  2344. (feedmail-fiddle-header name (concat (nth 0 value) ag-like (nth 2 value)) 'supplement folding)))
  2345. ))
  2346. (defun feedmail-give-it-to-buffer-eater ()
  2347. (feedmail-say-debug ">in-> feedmail-give-it-to-buffer-eater")
  2348. (save-excursion
  2349. (if feedmail-enable-spray
  2350. (mapcar
  2351. (lambda (feedmail-spray-this-address)
  2352. (let ((spray-buffer (get-buffer-create " *FQM Outgoing Email Spray*")))
  2353. (with-current-buffer spray-buffer
  2354. (erase-buffer)
  2355. ;; not life's most efficient methodology, but spraying isn't
  2356. ;; an every-5-minutes event either
  2357. (insert-buffer-substring feedmail-prepped-text-buffer)
  2358. ;; There's a good case to me made that each separate
  2359. ;; transmission of a message in the spray should
  2360. ;; have a distinct Message-Id:. There is also a less
  2361. ;; compelling argument in the other direction.
  2362. ;; I think they technically should have distinct
  2363. ;; Message-Id:s, but I doubt that anyone cares,
  2364. ;; practically. If someone complains about it, I'll
  2365. ;; add it.
  2366. (feedmail-fiddle-list-of-spray-fiddle-plexes feedmail-spray-address-fiddle-plex-list)
  2367. ;; this (let ) is just in case some buffer eater
  2368. ;; is cheating and using the global variable name instead
  2369. ;; of its argument to find the buffer
  2370. (let ((feedmail-prepped-text-buffer spray-buffer))
  2371. (funcall feedmail-buffer-eating-function
  2372. feedmail-prepped-text-buffer
  2373. feedmail-error-buffer
  2374. (list feedmail-spray-this-address))))
  2375. (kill-buffer spray-buffer)
  2376. ))
  2377. feedmail-address-list)
  2378. (feedmail-say-debug "calling buffer-eater %s"
  2379. feedmail-buffer-eating-function)
  2380. (funcall feedmail-buffer-eating-function
  2381. feedmail-prepped-text-buffer
  2382. feedmail-error-buffer
  2383. feedmail-address-list))))
  2384. (defun feedmail-envelope-deducer (eoh-marker)
  2385. "If `feedmail-deduce-envelope-from' is false, simply return `user-mail-address'.
  2386. Else, look for Sender: or From: (or Resent-*) and
  2387. return that value."
  2388. (feedmail-say-debug ">in-> feedmail-envelope-deducer %s" eoh-marker)
  2389. (if (not feedmail-deduce-envelope-from)
  2390. user-mail-address
  2391. (let ((from-list))
  2392. (setq from-list
  2393. (feedmail-deduce-address-list
  2394. (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-Sender:" "^Sender:")
  2395. from-list))
  2396. (if (not from-list)
  2397. (setq from-list
  2398. (feedmail-deduce-address-list
  2399. (current-buffer) (point-min) eoh-marker (if feedmail-is-a-resend "^Resent-From:" "^From:")
  2400. from-list)))
  2401. (if (and from-list (car from-list)) (car from-list) user-mail-address))))
  2402. (defun feedmail-fiddle-from ()
  2403. "Fiddle From:."
  2404. (feedmail-say-debug ">in-> feedmail-fiddle-from")
  2405. ;; default is to fall off the end of the list and do nothing
  2406. (cond
  2407. ;; nil means do nothing
  2408. ((eq nil feedmail-from-line) nil)
  2409. ;; t is the same a using the default computation, so compute it and recurse
  2410. ;; user-full-name suggested by kpc@ptolemy.arc.nasa.gov (=Kimball Collins)
  2411. ;; improvement using user-mail-address suggested by
  2412. ;; gray@austin.apc.slb.com (Douglas Gray Stephens)
  2413. ;; improvement using mail-host-address suggested by "Jason Eisner" <jason@cs.jhu.edu>
  2414. ;; ((this situation really is hopeless, though)
  2415. ((eq t feedmail-from-line)
  2416. (let ((feedmail-from-line
  2417. (let ((at-stuff
  2418. (if user-mail-address user-mail-address
  2419. (concat (user-login-name) "@"
  2420. (or mail-host-address (system-name))))))
  2421. (cond
  2422. ((eq mail-from-style nil) at-stuff)
  2423. ((eq mail-from-style 'parens) (concat at-stuff " (" (user-full-name) ")"))
  2424. ((eq mail-from-style 'angles) (concat "\"" (user-full-name) "\" <" at-stuff ">"))
  2425. ))))
  2426. (feedmail-fiddle-from)))
  2427. ;; if it's a string, simply make a fiddle-plex out of it and recurse
  2428. ((stringp feedmail-from-line)
  2429. (let ((feedmail-from-line (list "ignored" feedmail-from-line 'create)))
  2430. (feedmail-fiddle-from)))
  2431. ;; if it's a function, call it and recurse with the resulting value
  2432. ((and (symbolp feedmail-from-line) (fboundp feedmail-from-line))
  2433. (let ((feedmail-from-line (funcall feedmail-from-line)))
  2434. (feedmail-fiddle-from)))
  2435. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2436. ((listp feedmail-from-line)
  2437. (feedmail-fiddle-header
  2438. (if feedmail-is-a-resend "Resent-From" "From")
  2439. (nth 1 feedmail-from-line) ; value
  2440. (nth 2 feedmail-from-line) ; action
  2441. (nth 3 feedmail-from-line))))) ; folding
  2442. (defun feedmail-fiddle-sender ()
  2443. "Fiddle Sender:."
  2444. (feedmail-say-debug ">in-> feedmail-fiddle-sender")
  2445. ;; default is to fall off the end of the list and do nothing
  2446. (cond
  2447. ;; nil means do nothing
  2448. ((eq nil feedmail-sender-line) nil)
  2449. ;; t is not allowed, but handled it just to avoid bugs later
  2450. ((eq t feedmail-sender-line) nil)
  2451. ;; if it's a string, simply make a fiddle-plex out of it and recurse
  2452. ((stringp feedmail-sender-line)
  2453. (let ((feedmail-sender-line (list "ignored" feedmail-sender-line 'create)))
  2454. (feedmail-fiddle-sender)))
  2455. ;; if it's a function, call it and recurse with the resulting value
  2456. ((and (symbolp feedmail-sender-line) (fboundp feedmail-sender-line))
  2457. (let ((feedmail-sender-line (funcall feedmail-sender-line)))
  2458. (feedmail-fiddle-sender)))
  2459. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2460. ((listp feedmail-sender-line)
  2461. (feedmail-fiddle-header
  2462. (if feedmail-is-a-resend "Resent-Sender" "Sender")
  2463. (nth 1 feedmail-sender-line) ; value
  2464. (nth 2 feedmail-sender-line) ; action
  2465. (nth 3 feedmail-sender-line))))) ; folding
  2466. (defun feedmail-default-date-generator (maybe-file)
  2467. "Default function for generating Date: header contents."
  2468. (feedmail-say-debug ">in-> feedmail-default-date-generator")
  2469. (when maybe-file
  2470. (feedmail-say-debug (concat "4 cre " (feedmail-rfc822-date (nth 4 (file-attributes maybe-file)))))
  2471. (feedmail-say-debug (concat "5 mod " (feedmail-rfc822-date (nth 5 (file-attributes maybe-file)))))
  2472. (feedmail-say-debug (concat "6 sta " (feedmail-rfc822-date (nth 6 (file-attributes maybe-file))))))
  2473. (let ((date-time))
  2474. (if (and (not feedmail-queue-use-send-time-for-date) maybe-file)
  2475. (setq date-time (nth 5 (file-attributes maybe-file))))
  2476. (feedmail-rfc822-date date-time))
  2477. )
  2478. (defun feedmail-fiddle-date (maybe-file)
  2479. "Fiddle Date:. See documentation of `feedmail-date-generator'."
  2480. (feedmail-say-debug ">in-> feedmail-fiddle-date")
  2481. ;; default is to fall off the end of the list and do nothing
  2482. (cond
  2483. ;; nil means do nothing
  2484. ((eq nil feedmail-date-generator) nil)
  2485. ;; t is the same a using the function feedmail-default-date-generator, so let it and recurse
  2486. ((eq t feedmail-date-generator)
  2487. (let ((feedmail-date-generator (feedmail-default-date-generator maybe-file)))
  2488. (feedmail-fiddle-date maybe-file)))
  2489. ;; if it's a string, simply make a fiddle-plex out of it and recurse
  2490. ((stringp feedmail-date-generator)
  2491. (let ((feedmail-date-generator (list "ignored" feedmail-date-generator 'create)))
  2492. (feedmail-fiddle-date maybe-file)))
  2493. ;; if it's a function, call it and recurse with the resulting value
  2494. ((and (symbolp feedmail-date-generator) (fboundp feedmail-date-generator))
  2495. (let ((feedmail-date-generator (funcall feedmail-date-generator maybe-file)))
  2496. (feedmail-fiddle-date maybe-file)))
  2497. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2498. ((listp feedmail-date-generator)
  2499. (feedmail-fiddle-header
  2500. (if feedmail-is-a-resend "Resent-Date" "Date")
  2501. (nth 1 feedmail-date-generator) ; value
  2502. (nth 2 feedmail-date-generator) ; action
  2503. (nth 3 feedmail-date-generator))))) ; folding
  2504. (defun feedmail-default-message-id-generator (maybe-file)
  2505. "Default function for generating Message-Id: header contents.
  2506. Based on a date and a sort of random number for tie breaking. Unless
  2507. `feedmail-message-id-suffix' is defined, uses `user-mail-address', so be
  2508. sure it's set. If both are nil, creates a quasi-random suffix that is
  2509. probably not appropriate for you."
  2510. (feedmail-say-debug ">in-> feedmail-default-message-id-generator %s"
  2511. maybe-file)
  2512. (let ((date-time)
  2513. (system-time-locale "C")
  2514. (end-stuff (if feedmail-message-id-suffix feedmail-message-id-suffix user-mail-address)))
  2515. (if (not end-stuff) (setq end-stuff (format "%d.example.com" (random))))
  2516. (if (string-match "^\\(.*\\)@" end-stuff)
  2517. (setq end-stuff
  2518. (concat (if (equal (match-beginning 1) (match-end 1)) "" "-") end-stuff))
  2519. (setq end-stuff (concat "@" end-stuff)))
  2520. (if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
  2521. (setq date-time (nth 5 (file-attributes maybe-file))))
  2522. (format "<%d-%s%s%s>"
  2523. (mod (random) 10000)
  2524. (format-time-string "%a%d%b%Y%H%M%S" date-time)
  2525. (feedmail-rfc822-time-zone date-time)
  2526. end-stuff))
  2527. )
  2528. (defun feedmail-fiddle-message-id (maybe-file)
  2529. "Fiddle Message-Id:. See documentation of `feedmail-message-id-generator'."
  2530. (feedmail-say-debug ">in-> feedmail-fiddle-message-id %s" maybe-file)
  2531. ;; default is to fall off the end of the list and do nothing
  2532. (cond
  2533. ;; nil means do nothing
  2534. ((eq nil feedmail-message-id-generator) nil)
  2535. ;; t is the same a using the function feedmail-default-message-id-generator, so let it and recurse
  2536. ((eq t feedmail-message-id-generator)
  2537. (let ((feedmail-message-id-generator (feedmail-default-message-id-generator maybe-file)))
  2538. (feedmail-fiddle-message-id maybe-file)))
  2539. ;; if it's a string, simply make a fiddle-plex out of it and recurse
  2540. ((stringp feedmail-message-id-generator)
  2541. (let ((feedmail-message-id-generator (list "ignored" feedmail-message-id-generator 'create)))
  2542. (feedmail-fiddle-message-id maybe-file)))
  2543. ;; if it's a function, call it and recurse with the resulting value
  2544. ((and (symbolp feedmail-message-id-generator) (fboundp feedmail-message-id-generator))
  2545. (let ((feedmail-message-id-generator (funcall feedmail-message-id-generator maybe-file)))
  2546. (feedmail-fiddle-message-id maybe-file)))
  2547. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2548. ((listp feedmail-message-id-generator)
  2549. (feedmail-fiddle-header
  2550. (if feedmail-is-a-resend "Resent-Message-Id" "Message-Id")
  2551. (nth 1 feedmail-message-id-generator) ; value
  2552. (nth 2 feedmail-message-id-generator) ; action
  2553. (nth 3 feedmail-message-id-generator))))) ; folding
  2554. (defun feedmail-default-x-mailer-generator ()
  2555. "Default function for generating X-Mailer: header contents."
  2556. (concat
  2557. (let ((case-fold-search t)) (if (string-match "emacs" emacs-version) "" "emacs "))
  2558. emacs-version " (via feedmail " feedmail-patch-level
  2559. (if feedmail-queue-runner-is-active " Q" " I")
  2560. (if feedmail-enable-spray "S" "")
  2561. (if feedmail-x-mailer-line-user-appendage ") " ")")
  2562. feedmail-x-mailer-line-user-appendage))
  2563. (defun feedmail-fiddle-x-mailer ()
  2564. "Fiddle X-Mailer:. See documentation of `feedmail-x-mailer-line'."
  2565. (feedmail-say-debug ">in-> feedmail-fiddle-x-mailer")
  2566. ;; default is to fall off the end of the list and do nothing
  2567. (cond
  2568. ;; nil means do nothing
  2569. ((eq nil feedmail-x-mailer-line) nil)
  2570. ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse
  2571. ((eq t feedmail-x-mailer-line)
  2572. (let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator)))
  2573. (feedmail-fiddle-x-mailer)))
  2574. ;; if it's a string, simply make a fiddle-plex out of it and recurse
  2575. ((stringp feedmail-x-mailer-line)
  2576. (let ((feedmail-x-mailer-line (list "ignored" (list feedmail-x-mailer-line ";\n\t%s") 'combine)))
  2577. (feedmail-fiddle-x-mailer)))
  2578. ;; if it's a function, call it and recurse with the resulting value
  2579. ((and (symbolp feedmail-x-mailer-line) (fboundp feedmail-x-mailer-line))
  2580. (let ((feedmail-x-mailer-line (funcall feedmail-x-mailer-line)))
  2581. (feedmail-fiddle-x-mailer)))
  2582. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2583. ((listp feedmail-x-mailer-line)
  2584. (feedmail-fiddle-header
  2585. (if feedmail-is-a-resend "X-Resent-Mailer" "X-Mailer")
  2586. (nth 1 feedmail-x-mailer-line) ; value
  2587. (nth 2 feedmail-x-mailer-line) ; action
  2588. (nth 3 feedmail-x-mailer-line))))) ; folding
  2589. (defun feedmail-fiddle-spray-address (addy-plex)
  2590. "Fiddle header for single spray address. Uses `feedmail-spray-this-address'."
  2591. (feedmail-say-debug ">in-> feedmail-fiddle-spray-address %s" addy-plex)
  2592. ;; default is to fall off the end of the list and do nothing
  2593. (cond
  2594. ;; nil means do nothing
  2595. ((eq nil addy-plex) nil)
  2596. ;; t means the same as using "To:" and unembellished addy
  2597. ((eq t addy-plex)
  2598. (let ((addy-plex (list "To" feedmail-spray-this-address)))
  2599. (feedmail-fiddle-spray-address addy-plex)))
  2600. ;; if it's a string, simply make a fiddle-plex out of it and recurse, assuming
  2601. ;; the string names a header field (e.g., "To")
  2602. ((stringp addy-plex)
  2603. (let ((addy-plex (list addy-plex feedmail-spray-this-address)))
  2604. (feedmail-fiddle-spray-address addy-plex)))
  2605. ;; if it's a function, call it and recurse with the resulting value
  2606. ((and (symbolp addy-plex) (fboundp addy-plex))
  2607. (let ((addy-plex (funcall addy-plex)))
  2608. (feedmail-fiddle-spray-address addy-plex)))
  2609. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2610. ((listp addy-plex)
  2611. (feedmail-fiddle-header
  2612. (nth 0 addy-plex) ; name
  2613. (nth 1 addy-plex) ; value
  2614. (nth 2 addy-plex) ; action
  2615. (nth 3 addy-plex))))) ; folding
  2616. (defun feedmail-fiddle-list-of-spray-fiddle-plexes (list-of-fiddle-plexes)
  2617. "Fiddling based on a list of fiddle-plexes for spraying."
  2618. (feedmail-say-debug ">in-> feedmail-fiddle-list-of-spray-fiddle-plexes")
  2619. ;; default is to fall off the end of the list and do nothing
  2620. (let ((lofp list-of-fiddle-plexes) fp)
  2621. (if (listp lofp)
  2622. (while lofp
  2623. (setq fp (car lofp))
  2624. (setq lofp (cdr lofp))
  2625. (feedmail-fiddle-spray-address fp))
  2626. (feedmail-fiddle-spray-address lofp))))
  2627. (defun feedmail-fiddle-list-of-fiddle-plexes (list-of-fiddle-plexes)
  2628. "Fiddling based on a list of fiddle-plexes. Values t, nil, and string are pointless."
  2629. (feedmail-say-debug ">in-> feedmail-fiddle-list-of-fiddle-plexes")
  2630. ;; default is to fall off the end of the list and do nothing
  2631. (let ((lofp list-of-fiddle-plexes) fp)
  2632. (while lofp
  2633. (setq fp (car lofp))
  2634. (setq lofp (cdr lofp))
  2635. (cond
  2636. ;; if it's a function, call it and recurse with the resulting value
  2637. ((and (symbolp fp) (fboundp fp))
  2638. (let ((lofp (list (funcall fp)))) (feedmail-fiddle-list-of-fiddle-plexes lofp)))
  2639. ;; if it's a list, it must be a fiddle-plex -- so fiddle, man, fiddle
  2640. ((listp fp)
  2641. (feedmail-fiddle-header
  2642. (nth 0 fp)
  2643. (nth 1 fp) ; value
  2644. (nth 2 fp) ; action
  2645. (nth 3 fp))))))) ; folding
  2646. (defun feedmail-accume-n-nuke-header (header-end header-regexp)
  2647. "Delete headers matching a regexp and their continuation lines.
  2648. There may be multiple such lines, and each may have arbitrarily
  2649. many continuation lines. Return an accumulation of the deleted
  2650. headers, including the intervening newlines."
  2651. (feedmail-say-debug ">in-> feedmail-accume-n-nuke-header %s %s"
  2652. header-end header-regexp)
  2653. (let ((case-fold-search t) (dropout))
  2654. (save-excursion
  2655. (goto-char (point-min))
  2656. ;; iterate over all matching lines
  2657. (while (re-search-forward header-regexp header-end t)
  2658. (forward-line 1)
  2659. (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
  2660. (delete-region (match-beginning 0) (point))
  2661. ;; get rid of any continuation lines
  2662. (while (and (looking-at "^[ \t].*\n") (< (point) header-end))
  2663. (forward-line 1)
  2664. (setq dropout (concat dropout (buffer-substring-no-properties (match-beginning 0) (point))))
  2665. (replace-match ""))))
  2666. (identity dropout)))
  2667. (defun feedmail-fill-to-cc-function (header-end)
  2668. "Smart filling of address headers (don't be fooled by the name).
  2669. The filling tries to avoid splitting lines except at commas. This
  2670. avoids, in particular, splitting within parenthesized comments in
  2671. addresses. Headers filled include From:, Reply-To:, To:, Cc:, Bcc:,
  2672. Resent-To:, Resent-Cc:, and Resent-Bcc:."
  2673. (feedmail-say-debug ">in-> feedmail-fill-to-cc-function")
  2674. (let ((case-fold-search t)
  2675. this-line
  2676. this-line-end)
  2677. (save-excursion
  2678. (goto-char (point-min))
  2679. ;; iterate over all To:/Cc:, etc, lines
  2680. (while
  2681. (re-search-forward
  2682. "^\\(From:\\|Reply-To:\\|To:\\|Cc:\\|Bcc:\\|Resent-To:\\|Resent-Cc:\\|Resent-Bcc:\\)"
  2683. header-end t)
  2684. (setq this-line (match-beginning 0))
  2685. ;; replace 0 or more leading spaces with a single space
  2686. (and (looking-at "[ \t]*") (replace-match " "))
  2687. (forward-line 1)
  2688. ;; get any continuation lines
  2689. (while (and (looking-at "[ \t]+") (< (point) header-end))
  2690. (forward-line 1))
  2691. (setq this-line-end (point-marker))
  2692. (save-excursion (feedmail-fill-this-one this-line this-line-end))
  2693. ))))
  2694. (defun feedmail-fill-this-one (this-line this-line-end)
  2695. "In-place smart filling of the region bounded by the two arguments."
  2696. (feedmail-say-debug ">in-> feedmail-fill-this-one")
  2697. (let ((fill-prefix "\t")
  2698. (fill-column feedmail-fill-to-cc-fill-column))
  2699. ;; The general idea is to break only on commas. Collapse
  2700. ;; multiple whitespace to a single blank; change
  2701. ;; all the blanks to something unprintable; change the
  2702. ;; commas to blanks; fill the region; change it back.
  2703. (goto-char this-line)
  2704. (while (re-search-forward "\\s-+" (1- this-line-end) t)
  2705. (replace-match " "))
  2706. (subst-char-in-region this-line this-line-end ? 2 t) ; blank->C-b
  2707. (subst-char-in-region this-line this-line-end ?, ? t) ; comma->blank
  2708. (fill-region-as-paragraph this-line this-line-end)
  2709. (subst-char-in-region this-line this-line-end ? ?, t) ; comma<-blank
  2710. (subst-char-in-region this-line this-line-end 2 ? t) ; blank<-C-b
  2711. ;; look out for missing commas before continuation lines
  2712. (goto-char this-line)
  2713. (while (re-search-forward "\\([^,]\\)\n\t[ ]*" this-line-end t)
  2714. (replace-match "\\1,\n\t"))
  2715. ))
  2716. (defun feedmail-deduce-address-list (message-buffer header-start header-end addr-regexp address-list)
  2717. "Get address list with all comments and other excitement trimmed.
  2718. Addresses are collected only from headers whose names match the fourth
  2719. argument. Returns a list of strings. Duplicate addresses will have
  2720. been weeded out."
  2721. (feedmail-say-debug ">in-> feedmail-deduce-address-list %s %s" addr-regexp address-list)
  2722. (let ((simple-address)
  2723. (address-blob)
  2724. (this-line)
  2725. (this-line-end))
  2726. (unwind-protect
  2727. (with-current-buffer (get-buffer-create " *FQM scratch*")
  2728. (erase-buffer)
  2729. (insert-buffer-substring message-buffer header-start header-end)
  2730. (goto-char (point-min))
  2731. (let ((case-fold-search t))
  2732. (while (re-search-forward addr-regexp (point-max) t)
  2733. (replace-match "")
  2734. (setq this-line (match-beginning 0))
  2735. (forward-line 1)
  2736. ;; get any continuation lines
  2737. (while (and (looking-at "^[ \t]+") (< (point) (point-max)))
  2738. (forward-line 1))
  2739. (setq this-line-end (point-marker))
  2740. ;; only keep if we don't have it already
  2741. (setq address-blob
  2742. (mail-strip-quoted-names (buffer-substring-no-properties this-line this-line-end)))
  2743. (while (string-match "\\([, \t\n\r]*\\)\\([^, \t\n\r]+\\)" address-blob)
  2744. (setq simple-address (substring address-blob (match-beginning 2) (match-end 2)))
  2745. (setq address-blob (replace-match "" t t address-blob))
  2746. (if (not (member simple-address address-list))
  2747. (add-to-list 'address-list simple-address)))
  2748. ))
  2749. (kill-buffer nil)))
  2750. (identity address-list)))
  2751. (defun feedmail-one-last-look (feedmail-prepped-text-buffer)
  2752. "Offer the user one last chance to give it up."
  2753. (feedmail-say-debug ">in-> feedmail-one-last-look")
  2754. (save-excursion
  2755. (save-window-excursion
  2756. (switch-to-buffer feedmail-prepped-text-buffer)
  2757. (if (and (fboundp 'y-or-n-p-with-timeout) (numberp feedmail-confirm-outgoing-timeout))
  2758. (y-or-n-p-with-timeout
  2759. "FQM: Send this email? "
  2760. (abs feedmail-confirm-outgoing-timeout)
  2761. (> feedmail-confirm-outgoing-timeout 0))
  2762. (y-or-n-p "FQM: Send this email? "))
  2763. )))
  2764. (defun feedmail-fqm-p (might-be)
  2765. "Internal; does filename end with FQM suffix?"
  2766. (feedmail-say-debug ">in-> feedmail-fqm-p %s" might-be)
  2767. (string-match (concat (regexp-quote feedmail-queue-fqm-suffix) "$") might-be))
  2768. (defun feedmail-say-debug (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
  2769. "Internal; emits debug messages in standard format."
  2770. (when feedmail-debug
  2771. (funcall 'message (concat "FQM DB: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
  2772. (and feedmail-debug-sit-for (not (= 0 feedmail-debug-sit-for))
  2773. (sit-for feedmail-debug-sit-for))))
  2774. (defun feedmail-say-chatter (format &optional a1 a2 a3 a4 a5 a6 a7 a8 a9)
  2775. "Internal; emits queue chatter messages in standard format."
  2776. (when feedmail-queue-chatty
  2777. (funcall 'message (concat "FQM: " format) a1 a2 a3 a4 a5 a6 a7 a8 a9)
  2778. (and feedmail-queue-chatty-sit-for (not (= 0 feedmail-queue-chatty-sit-for))
  2779. (sit-for feedmail-queue-chatty-sit-for))))
  2780. (defun feedmail-find-eoh (&optional noerror)
  2781. "Internal; finds the end of message header fields, returns mark just before it"
  2782. ;; all this funny business with line endings is to account for CRLF
  2783. ;; weirdness that I don't think I'll ever figure out
  2784. (feedmail-say-debug ">in-> feedmail-find-eoh %s" noerror)
  2785. (let ((mhs mail-header-separator)
  2786. (alt-mhs feedmail-queue-alternative-mail-header-separator)
  2787. r-mhs r-alt-mhs)
  2788. (setq r-mhs (concat "^" (regexp-quote mhs) "$"))
  2789. (setq r-alt-mhs (concat "^" (regexp-quote (or alt-mhs "")) "$"))
  2790. (save-excursion
  2791. (goto-char (point-min))
  2792. (if (or (re-search-forward r-mhs nil t)
  2793. (and alt-mhs (re-search-forward r-alt-mhs nil t)))
  2794. (progn
  2795. (beginning-of-line)
  2796. (point-marker))
  2797. (if noerror
  2798. nil
  2799. (error "FQM: Can't find message-header-separator or alternate"))))))
  2800. (provide 'feedmail)
  2801. ;;; feedmail.el ends here