nnmail.el 72 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097
  1. ;;; nnmail.el --- mail support functions for the Gnus mail backends
  2. ;; Copyright (C) 1995-2015 Free Software Foundation, Inc.
  3. ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
  4. ;; Keywords: news, mail
  5. ;; This file is part of GNU Emacs.
  6. ;; GNU Emacs is free software: you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation, either version 3 of the License, or
  9. ;; (at your option) any later version.
  10. ;; GNU Emacs is distributed in the hope that it will be useful,
  11. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. ;; GNU General Public License for more details.
  14. ;; You should have received a copy of the GNU General Public License
  15. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  16. ;;; Commentary:
  17. ;;; Code:
  18. (eval-when-compile (require 'cl))
  19. (require 'gnus) ; for macro gnus-kill-buffer, at least
  20. (require 'nnheader)
  21. (require 'message)
  22. (require 'gnus-util)
  23. (require 'mail-source)
  24. (require 'mm-util)
  25. (require 'gnus-int)
  26. (autoload 'gnus-add-buffer "gnus")
  27. (autoload 'gnus-kill-buffer "gnus")
  28. (autoload 'mail-send-and-exit "sendmail" nil t)
  29. (defgroup nnmail nil
  30. "Reading mail with Gnus."
  31. :group 'gnus)
  32. (defgroup nnmail-retrieve nil
  33. "Retrieving new mail."
  34. :group 'nnmail)
  35. (defgroup nnmail-prepare nil
  36. "Preparing (or mangling) new mail after retrieval."
  37. :group 'nnmail)
  38. (defgroup nnmail-duplicate nil
  39. "Handling of duplicate mail messages."
  40. :group 'nnmail)
  41. (defgroup nnmail-split nil
  42. "Organizing the incoming mail in folders."
  43. :group 'nnmail)
  44. (defgroup nnmail-files nil
  45. "Mail files."
  46. :group 'gnus-files
  47. :group 'nnmail)
  48. (defgroup nnmail-expire nil
  49. "Expiring old mail."
  50. :group 'nnmail)
  51. (defgroup nnmail-procmail nil
  52. "Interfacing with procmail and other mail agents."
  53. :group 'nnmail)
  54. (defgroup nnmail-various nil
  55. "Various mail options."
  56. :group 'nnmail)
  57. (defcustom nnmail-split-methods '(("mail.misc" ""))
  58. "*Incoming mail will be split according to this variable.
  59. If you'd like, for instance, one mail group for mail from the
  60. \"4ad-l\" mailing list, one group for junk mail and one for everything
  61. else, you could do something like this:
  62. (setq nnmail-split-methods
  63. \\='((\"mail.4ad\" \"From:.*4ad\")
  64. (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
  65. (\"mail.misc\" \"\")))
  66. As you can see, this variable is a list of lists, where the first
  67. element in each \"rule\" is the name of the group (which, by the way,
  68. does not have to be called anything beginning with \"mail\",
  69. \"yonka.zow\" is a fine, fine name), and the second is a regexp that
  70. nnmail will try to match on the header to find a fit.
  71. The second element can also be a function. In that case, it will be
  72. called narrowed to the headers with the first element of the rule as
  73. the argument. It should return a non-nil value if it thinks that the
  74. mail belongs in that group.
  75. The last element should always have \"\" as the regexp.
  76. This variable can also have a function as its value, and it can
  77. also have a fancy split method as its value. See
  78. `nnmail-split-fancy' for an explanation of that syntax."
  79. :group 'nnmail-split
  80. :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
  81. (choice regexp function)))
  82. (function-item nnmail-split-fancy)
  83. (function :tag "Other")))
  84. ;; Suggested by Erik Selberg <speed@cs.washington.edu>.
  85. (defcustom nnmail-crosspost t
  86. "If non-nil, do crossposting if several split methods match the mail.
  87. If nil, the first match found will be used."
  88. :group 'nnmail-split
  89. :type 'boolean)
  90. (defcustom nnmail-split-fancy-with-parent-ignore-groups nil
  91. "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
  92. This can also be a list of regexps."
  93. :version "22.1"
  94. :group 'nnmail-split
  95. :type '(choice (const :tag "none" nil)
  96. (regexp :value ".*")
  97. (repeat :value (".*") regexp)))
  98. (defcustom nnmail-cache-ignore-groups nil
  99. "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
  100. This can also be a list of regexps."
  101. :version "22.1"
  102. :group 'nnmail-split
  103. :type '(choice (const :tag "none" nil)
  104. (regexp :value ".*")
  105. (repeat :value (".*") regexp)))
  106. ;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
  107. (defcustom nnmail-keep-last-article nil
  108. "If non-nil, nnmail will never delete/move a group's last article.
  109. It can be marked expirable, so it will be deleted when it is no longer last.
  110. You may need to set this variable if other programs are putting
  111. new mail into folder numbers that Gnus has marked as expired."
  112. :group 'nnmail-procmail
  113. :group 'nnmail-various
  114. :type 'boolean)
  115. (defcustom nnmail-use-long-file-names nil
  116. "If non-nil the mail backends will use long file and directory names.
  117. If nil, groups like \"mail.misc\" will end up in directories like
  118. \"mail/misc/\"."
  119. :group 'nnmail-files
  120. :type 'boolean)
  121. (defcustom nnmail-default-file-modes 384
  122. "Set the mode bits of all new mail files to this integer."
  123. :group 'nnmail-files
  124. :type 'integer)
  125. (defcustom nnmail-expiry-wait 7
  126. "*Expirable articles that are older than this will be expired.
  127. This variable can either be a number (which will be interpreted as a
  128. number of days) -- this doesn't have to be an integer. This variable
  129. can also be `immediate' and `never'."
  130. :group 'nnmail-expire
  131. :type '(choice (const immediate)
  132. (number :tag "days")
  133. (const never)))
  134. (defcustom nnmail-expiry-wait-function nil
  135. "Variable that holds function to specify how old articles should be before they are expired.
  136. The function will be called with the name of the group that the expiry
  137. is to be performed in, and it should return an integer that says how
  138. many days an article can be stored before it is considered \"old\".
  139. It can also return the values `never' and `immediate'.
  140. E.g.:
  141. \(setq nnmail-expiry-wait-function
  142. (lambda (newsgroup)
  143. (cond ((string-match \"private\" newsgroup) 31)
  144. ((string-match \"junk\" newsgroup) 1)
  145. ((string-match \"important\" newsgroup) \\='never)
  146. (t 7))))"
  147. :group 'nnmail-expire
  148. :type '(choice (const :tag "nnmail-expiry-wait" nil)
  149. (function :format "%v" nnmail-)))
  150. (defcustom nnmail-expiry-target 'delete
  151. "*Variable that says where expired messages should end up.
  152. The default value is `delete' (which says to delete the messages),
  153. but it can also be a string or a function. If it is a string, expired
  154. messages end up in that group. If it is a function, the function is
  155. called in a buffer narrowed to the message in question. The function
  156. receives one argument, the name of the group the message comes from.
  157. The return value should be `delete' or a group name (a string)."
  158. :version "21.1"
  159. :group 'nnmail-expire
  160. :type '(choice (const delete)
  161. function
  162. string))
  163. (defcustom nnmail-fancy-expiry-targets nil
  164. "Determine expiry target based on articles using fancy techniques.
  165. This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If
  166. `nnmail-expiry-target' is set to the function
  167. `nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
  168. the message will be expired to a group determined by invoking
  169. `format-time-string' with TARGET used as the format string and the
  170. time extracted from the articles' Date header (if missing the current
  171. time is used).
  172. In the special cases that HEADER is the symbol `to-from', the regexp
  173. will try to match against both the From and the To header.
  174. Example:
  175. \(setq nnmail-fancy-expiry-targets
  176. \\='((to-from \"boss\" \"nnfolder:Work\")
  177. (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
  178. (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
  179. In this case, articles containing the string \"boss\" in the To or the
  180. From header will be expired to the group \"nnfolder:Work\";
  181. articles containing the string \"IMPORTANT\" in the Subject header will
  182. be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
  183. everything else will be expired to \"nnfolder:Archive-YYYY\"."
  184. :version "22.1"
  185. :group 'nnmail-expire
  186. :type '(repeat (list (choice :tag "Match against"
  187. (string :tag "Header")
  188. (const to-from))
  189. regexp
  190. (string :tag "Target group format string"))))
  191. (defcustom nnmail-cache-accepted-message-ids nil
  192. "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
  193. If non-nil, also update the cache when copy or move articles."
  194. :group 'nnmail
  195. :type 'boolean)
  196. (make-obsolete-variable 'nnmail-spool-file 'mail-sources
  197. "Gnus 5.9 (Emacs 22.1)")
  198. ;; revision 5.29 / p0-85 / Gnus 5.9
  199. ;; Variable removed in No Gnus v0.7
  200. (defcustom nnmail-resplit-incoming nil
  201. "*If non-nil, re-split incoming procmail sorted mail."
  202. :group 'nnmail-procmail
  203. :type 'boolean)
  204. (defcustom nnmail-scan-directory-mail-source-once nil
  205. "*If non-nil, scan all incoming procmail sorted mails once.
  206. It scans low-level sorted spools even when not required."
  207. :version "21.1"
  208. :group 'nnmail-procmail
  209. :type 'boolean)
  210. (defcustom nnmail-delete-file-function 'delete-file
  211. "Function called to delete files in some mail backends."
  212. :group 'nnmail-files
  213. :type 'function)
  214. (defcustom nnmail-crosspost-link-function
  215. (if (string-match "windows-nt" (symbol-name system-type))
  216. 'copy-file
  217. 'add-name-to-file)
  218. "*Function called to create a copy of a file.
  219. This is `add-name-to-file' by default, which means that crossposts
  220. will use hard links. If your file system doesn't allow hard
  221. links, you could set this variable to `copy-file' instead."
  222. :group 'nnmail-files
  223. :type '(radio (function-item add-name-to-file)
  224. (function-item copy-file)
  225. (function :tag "Other")))
  226. (defcustom nnmail-read-incoming-hook
  227. (if (eq system-type 'windows-nt)
  228. '(nnheader-ms-strip-cr)
  229. nil)
  230. "*Hook that will be run after the incoming mail has been transferred.
  231. The incoming mail is moved from the specified spool file (which normally is
  232. something like \"/usr/spool/mail/$user\") to the user's home
  233. directory. This hook is called after the incoming mail box has been
  234. emptied, and can be used to call any mail box programs you have
  235. running (\"xwatch\", etc.)
  236. E.g.:
  237. \(add-hook \\='nnmail-read-incoming-hook
  238. (lambda ()
  239. (call-process \"/local/bin/mailsend\" nil nil nil
  240. \"read\"
  241. ;; The incoming mail box file.
  242. (expand-file-name (user-login-name)
  243. rmail-spool-directory))))
  244. If you have xwatch running, this will alert it that mail has been
  245. read.
  246. If you use `display-time', you could use something like this:
  247. \(add-hook \\='nnmail-read-incoming-hook
  248. (lambda ()
  249. ;; Update the displayed time, since that will clear out
  250. ;; the flag that says you have mail.
  251. (when (eq (process-status \"display-time\") \\='run)
  252. (display-time-filter display-time-process \"\"))))"
  253. :group 'nnmail-prepare
  254. :type 'hook)
  255. (defcustom nnmail-prepare-incoming-hook nil
  256. "Hook called before treating incoming mail.
  257. The hook is run in a buffer with all the new, incoming mail."
  258. :group 'nnmail-prepare
  259. :type 'hook)
  260. (defcustom nnmail-prepare-incoming-header-hook nil
  261. "Hook called narrowed to the headers of each message.
  262. This can be used to remove excessive spaces (and stuff like
  263. that) from the headers before splitting and saving the messages."
  264. :group 'nnmail-prepare
  265. :type 'hook)
  266. (defcustom nnmail-prepare-incoming-message-hook nil
  267. "Hook called narrowed to each message."
  268. :group 'nnmail-prepare
  269. :type 'hook)
  270. (defcustom nnmail-list-identifiers nil
  271. "Regexp that matches list identifiers to be removed.
  272. This can also be a list of regexps."
  273. :group 'nnmail-prepare
  274. :type '(choice (const :tag "none" nil)
  275. (regexp :value ".*")
  276. (repeat :value (".*") regexp)))
  277. (defcustom nnmail-pre-get-new-mail-hook nil
  278. "Hook called just before starting to handle new incoming mail."
  279. :group 'nnmail-retrieve
  280. :type 'hook)
  281. (defcustom nnmail-post-get-new-mail-hook nil
  282. "Hook called just after finishing handling new incoming mail."
  283. :group 'nnmail-retrieve
  284. :type 'hook)
  285. (defcustom nnmail-split-hook nil
  286. "Hook called before deciding where to split an article.
  287. The functions in this hook are free to modify the buffer
  288. contents in any way they choose -- the buffer contents are
  289. discarded after running the split process."
  290. :group 'nnmail-split
  291. :type 'hook)
  292. (defcustom nnmail-spool-hook nil
  293. "*A hook called when a new article is spooled."
  294. :version "22.1"
  295. :group 'nnmail
  296. :type 'hook)
  297. (defcustom nnmail-large-newsgroup 50
  298. "*The number of articles which indicates a large newsgroup or nil.
  299. If the number of articles is greater than the value, verbose
  300. messages will be shown to indicate the current status."
  301. :group 'nnmail-various
  302. :type '(choice (const :tag "infinite" nil)
  303. (number :tag "count")))
  304. (define-widget 'nnmail-lazy 'default
  305. "Base widget for recursive data structures.
  306. This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
  307. :format "%{%t%}: %v"
  308. :convert-widget 'widget-value-convert-widget
  309. :value-create (lambda (widget)
  310. (let ((value (widget-get widget :value))
  311. (type (widget-get widget :type)))
  312. (widget-put widget :children
  313. (list (widget-create-child-value
  314. widget (widget-convert type) value)))))
  315. :value-delete 'widget-children-value-delete
  316. :value-get (lambda (widget)
  317. (widget-value (car (widget-get widget :children))))
  318. :value-inline (lambda (widget)
  319. (widget-apply (car (widget-get widget :children))
  320. :value-inline))
  321. :default-get (lambda (widget)
  322. (widget-default-get
  323. (widget-convert (widget-get widget :type))))
  324. :match (lambda (widget value)
  325. (widget-apply (widget-convert (widget-get widget :type))
  326. :match value))
  327. :validate (lambda (widget)
  328. (widget-apply (car (widget-get widget :children)) :validate)))
  329. (define-widget 'nnmail-split-fancy 'nnmail-lazy
  330. "Widget for customizing splits in the variable of the same name."
  331. :tag "Split"
  332. :type '(menu-choice :value (any ".*value.*" "misc")
  333. :tag "Type"
  334. (string :tag "Destination")
  335. (list :tag "Use first match (|)" :value (|)
  336. (const :format "" |)
  337. (editable-list :inline t nnmail-split-fancy))
  338. (list :tag "Use all matches (&)" :value (&)
  339. (const :format "" &)
  340. (editable-list :inline t nnmail-split-fancy))
  341. (list :tag "Function with fixed arguments (:)"
  342. :value (:)
  343. (const :format "" :value :)
  344. function
  345. (editable-list :inline t (sexp :tag "Arg"))
  346. )
  347. (list :tag "Function with split arguments (!)"
  348. :value (!)
  349. (const :format "" !)
  350. function
  351. (editable-list :inline t nnmail-split-fancy))
  352. (list :tag "Field match"
  353. (choice :tag "Field"
  354. regexp symbol)
  355. (choice :tag "Match"
  356. regexp
  357. (symbol :value mail))
  358. (repeat :inline t
  359. :tag "Restrictions"
  360. (group :inline t
  361. (const :format "" -)
  362. regexp))
  363. nnmail-split-fancy)
  364. (const :tag "Junk (delete mail)" junk)))
  365. (defcustom nnmail-split-fancy "mail.misc"
  366. "Incoming mail can be split according to this fancy variable.
  367. To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
  368. The format of this variable is SPLIT, where SPLIT can be one of
  369. the following:
  370. GROUP: Mail will be stored in GROUP (a string).
  371. \(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
  372. field FIELD (a regexp) contains VALUE (a regexp), store the messages
  373. as specified by SPLIT. If RESTRICT (a regexp) matches some string
  374. after FIELD and before the end of the matched VALUE, return nil,
  375. otherwise process SPLIT. Multiple RESTRICTs add up, further
  376. restricting the possibility of processing SPLIT.
  377. \(| SPLIT...): Process each SPLIT expression until one of them matches.
  378. A SPLIT expression is said to match if it will cause the mail
  379. message to be stored in one or more groups.
  380. \(& SPLIT...): Process each SPLIT expression.
  381. \(: FUNCTION optional args): Call FUNCTION with the optional args, in
  382. the buffer containing the message headers. The return value FUNCTION
  383. should be a split, which is then recursively processed.
  384. \(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The
  385. return value FUNCTION should be a split, which is then recursively
  386. processed.
  387. junk: Mail will be deleted. Use with care! Do not submerge in water!
  388. Example:
  389. (setq nnmail-split-fancy
  390. \\='(| (\"Subject\" \"MAKE MONEY FAST\" junk)
  391. ...other.rules.omitted...))
  392. FIELD must match a complete field name. VALUE must match a complete
  393. word according to the `nnmail-split-fancy-syntax-table' syntax table.
  394. You can use \".*\" in the regexps to match partial field names or words.
  395. FIELD and VALUE can also be Lisp symbols, in that case they are expanded
  396. as specified in `nnmail-split-abbrev-alist'.
  397. GROUP can contain \\& and \\N which will substitute from matching
  398. \\(\\) patterns in the previous VALUE.
  399. Example:
  400. \(setq nnmail-split-methods \\='nnmail-split-fancy
  401. nnmail-split-fancy
  402. ;; Messages from the mailer daemon are not crossposted to any of
  403. ;; the ordinary groups. Warnings are put in a separate group
  404. ;; from real errors.
  405. \\='(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
  406. \"mail.misc\"))
  407. ;; Non-error messages are crossposted to all relevant
  408. ;; groups, but we don't crosspost between the group for the
  409. ;; (ding) list and the group for other (ding) related mail.
  410. (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
  411. (\"subject\" \"ding\" \"ding.misc\"))
  412. ;; Other mailing lists...
  413. (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
  414. (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
  415. ;; Both lists below have the same suffix, so prevent
  416. ;; cross-posting to mkpkg.list of messages posted only to
  417. ;; the bugs- list, but allow cross-posting when the
  418. ;; message was really cross-posted.
  419. (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
  420. (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
  421. ;;
  422. ;; People...
  423. (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
  424. ;; Unmatched mail goes to the catch all group.
  425. \"misc.misc\"))"
  426. :group 'nnmail-split
  427. :type 'nnmail-split-fancy)
  428. (defcustom nnmail-split-abbrev-alist
  429. '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
  430. (mail . "mailer-daemon\\|postmaster\\|uucp")
  431. (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
  432. (from . "from\\|sender\\|resent-from")
  433. (nato . "to\\|cc\\|resent-to\\|resent-cc")
  434. (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
  435. "*Alist of abbreviations allowed in `nnmail-split-fancy'."
  436. :group 'nnmail-split
  437. :type '(repeat (cons :format "%v" symbol regexp)))
  438. (defcustom nnmail-message-id-cache-length 1000
  439. "*The approximate number of Message-IDs nnmail will keep in its cache.
  440. If this variable is nil, no checking on duplicate messages will be
  441. performed."
  442. :group 'nnmail-duplicate
  443. :type '(choice (const :tag "disable" nil)
  444. (integer :format "%v")))
  445. (defcustom nnmail-message-id-cache-file
  446. (nnheader-concat gnus-home-directory ".nnmail-cache")
  447. "The file name of the nnmail Message-ID cache."
  448. :group 'nnmail-duplicate
  449. :group 'nnmail-files
  450. :type 'file)
  451. (defcustom nnmail-treat-duplicates 'warn
  452. "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
  453. Three values are valid: nil, which means that nnmail is not to keep a
  454. Message-ID cache; `warn', which means that nnmail should insert extra
  455. headers to warn the user about the duplication (this is the default);
  456. and `delete', which means that nnmail will delete duplicated mails.
  457. This variable can also be a function. It will be called from a buffer
  458. narrowed to the article in question with the Message-ID as a
  459. parameter. It should return nil, `warn' or `delete'."
  460. :group 'nnmail-duplicate
  461. :type '(choice (const :tag "off" nil)
  462. (const warn)
  463. (const delete)))
  464. (defcustom nnmail-extra-headers '(To Newsgroups Cc)
  465. "Extra headers to parse.
  466. In addition to the standard headers, these extra headers will be
  467. included in NOV headers (and the like) when backends parse headers."
  468. :version "24.3"
  469. :group 'nnmail
  470. :type '(repeat symbol))
  471. (defcustom nnmail-split-header-length-limit 2048
  472. "Header lines longer than this limit are excluded from the split function."
  473. :version "21.1"
  474. :group 'nnmail
  475. :type 'integer)
  476. (defcustom nnmail-mail-splitting-charset nil
  477. "Default charset to be used when splitting incoming mail."
  478. :version "22.1"
  479. :group 'nnmail
  480. :type 'symbol)
  481. (defcustom nnmail-mail-splitting-decodes nil
  482. "Whether the nnmail splitting functionality should MIME decode headers."
  483. :version "22.1"
  484. :group 'nnmail
  485. :type 'boolean)
  486. (defcustom nnmail-split-fancy-match-partial-words nil
  487. "Whether to match partial words when fancy splitting.
  488. Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
  489. by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
  490. surrounded
  491. by anything."
  492. :version "22.1"
  493. :group 'nnmail
  494. :type 'boolean)
  495. (defcustom nnmail-split-lowercase-expanded t
  496. "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
  497. This avoids the creation of multiple groups when users send to an address
  498. using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
  499. :version "22.1"
  500. :group 'nnmail
  501. :type 'boolean)
  502. ;;; Internal variables.
  503. (defvar nnmail-article-buffer " *nnmail incoming*"
  504. "The buffer used for splitting incoming mails.")
  505. (defvar nnmail-split-history nil
  506. "List of group/article elements that say where the previous split put messages.")
  507. (defvar nnmail-split-fancy-syntax-table
  508. (let ((table (make-syntax-table)))
  509. ;; support the %-hack
  510. (modify-syntax-entry ?\% "." table)
  511. table)
  512. "Syntax table used by `nnmail-split-fancy'.")
  513. (defvar nnmail-prepare-save-mail-hook nil
  514. "Hook called before saving mail.")
  515. (defvar nnmail-split-tracing nil)
  516. (defvar nnmail-split-trace nil)
  517. (defvar nnmail-inhibit-default-split-group nil)
  518. (defun nnmail-request-post (&optional server)
  519. (mail-send-and-exit nil))
  520. (defvar nnmail-file-coding-system 'raw-text
  521. "Coding system used in nnmail.")
  522. (defvar nnmail-incoming-coding-system
  523. mm-text-coding-system
  524. "Coding system used in reading inbox")
  525. (defvar nnmail-pathname-coding-system
  526. ;; This causes Emacs 22.2 and 22.3 to issue a useless warning.
  527. ;;(if (and (featurep 'xemacs) (featurep 'file-coding))
  528. (if (featurep 'xemacs)
  529. (if (featurep 'file-coding)
  530. ;; Work around a bug in many XEmacs 21.5 betas.
  531. ;; Cf. http://thread.gmane.org/gmane.emacs.gnus.general/68134
  532. (setq file-name-coding-system (coding-system-aliasee 'file-name))))
  533. "*Coding system for file name.")
  534. (defun nnmail-find-file (file)
  535. "Insert FILE in server buffer safely."
  536. (set-buffer nntp-server-buffer)
  537. (delete-region (point-min) (point-max))
  538. (let ((format-alist nil)
  539. (after-insert-file-functions nil))
  540. (condition-case ()
  541. (let ((coding-system-for-read nnmail-file-coding-system)
  542. (auto-mode-alist (mm-auto-mode-alist))
  543. (file-name-coding-system nnmail-pathname-coding-system))
  544. (insert-file-contents file)
  545. t)
  546. (file-error nil))))
  547. (defun nnmail-group-pathname (group dir &optional file)
  548. "Make file name for GROUP."
  549. (concat
  550. (let ((dir (file-name-as-directory (expand-file-name dir))))
  551. (setq group (nnheader-replace-duplicate-chars-in-string
  552. (nnheader-replace-chars-in-string group ?/ ?_)
  553. ?. ?_))
  554. (setq group (nnheader-translate-file-chars group))
  555. ;; If this directory exists, we use it directly.
  556. (file-name-as-directory
  557. (if (or nnmail-use-long-file-names
  558. (file-directory-p (concat dir group)))
  559. (expand-file-name group dir)
  560. ;; If not, we translate dots into slashes.
  561. (expand-file-name
  562. (nnheader-replace-chars-in-string group ?. ?/)
  563. dir))))
  564. (or file "")))
  565. (defun nnmail-get-active ()
  566. "Returns an assoc of group names and active ranges.
  567. nn*-request-list should have been called before calling this function."
  568. ;; Go through all groups from the active list.
  569. (with-current-buffer nntp-server-buffer
  570. (nnmail-parse-active)))
  571. (defun nnmail-parse-active ()
  572. "Parse the active file in the current buffer and return an alist."
  573. (goto-char (point-min))
  574. (unless (re-search-forward "[\\\"]" nil t)
  575. (goto-char (point-max))
  576. (while (re-search-backward "[][';?()#]" nil t)
  577. (insert ?\\)))
  578. (goto-char (point-min))
  579. (let ((buffer (current-buffer))
  580. group-assoc group max min)
  581. (while (not (eobp))
  582. (condition-case err
  583. (progn
  584. (narrow-to-region (point) (point-at-eol))
  585. (setq group (read buffer))
  586. (unless (stringp group)
  587. (setq group (symbol-name group)))
  588. (if (and (numberp (setq max (read buffer)))
  589. (numberp (setq min (read buffer))))
  590. (push (list (mm-string-as-unibyte group) (cons min max))
  591. group-assoc)))
  592. (error nil))
  593. (widen)
  594. (forward-line 1))
  595. group-assoc))
  596. (defvar nnmail-active-file-coding-system 'raw-text
  597. "*Coding system for active file.")
  598. (defun nnmail-save-active (group-assoc file-name)
  599. "Save GROUP-ASSOC in ACTIVE-FILE."
  600. (let ((coding-system-for-write nnmail-active-file-coding-system))
  601. (when file-name
  602. (with-temp-file file-name
  603. (mm-disable-multibyte)
  604. (nnmail-generate-active group-assoc)))))
  605. (defun nnmail-generate-active (alist)
  606. "Generate an active file from group-alist ALIST."
  607. (erase-buffer)
  608. (let (group)
  609. (while (setq group (pop alist))
  610. (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
  611. (caadr group))))
  612. (goto-char (point-max))
  613. (while (search-backward "\\." nil t)
  614. (delete-char 1))))
  615. (defun nnmail-get-split-group (file source)
  616. "Find out whether this FILE is to be split into GROUP only.
  617. If SOURCE is a directory spec, try to return the group name component."
  618. (if (eq (car source) 'directory)
  619. (let ((file (file-name-nondirectory file)))
  620. (mail-source-bind (directory source)
  621. (if (string-match (concat (regexp-quote suffix) "$") file)
  622. (substring file 0 (match-beginning 0))
  623. nil)))
  624. nil))
  625. (defun nnmail-process-babyl-mail-format (func artnum-func)
  626. (let ((case-fold-search t)
  627. (count 0)
  628. start message-id content-length do-search end)
  629. (while (not (eobp))
  630. (goto-char (point-min))
  631. (re-search-forward
  632. " \n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
  633. (goto-char (match-end 0))
  634. (delete-region (match-beginning 0) (match-end 0))
  635. (narrow-to-region
  636. (setq start (point))
  637. (progn
  638. ;; Skip all the headers in case there are more "From "s...
  639. (or (search-forward "\n\n" nil t)
  640. (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
  641. (search-forward " "))
  642. (point)))
  643. ;; Unquote the ">From " line, if any.
  644. (goto-char (point-min))
  645. (when (looking-at ">From ")
  646. (replace-match "X-From-Line: ") )
  647. (run-hooks 'nnmail-prepare-incoming-header-hook)
  648. (goto-char (point-max))
  649. ;; Find the Message-ID header.
  650. (save-excursion
  651. (if (re-search-backward
  652. "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
  653. (setq message-id (buffer-substring (match-beginning 1)
  654. (match-end 1)))
  655. ;; There is no Message-ID here, so we create one.
  656. (save-excursion
  657. (when (re-search-backward "^Message-ID[ \t]*:" nil t)
  658. (beginning-of-line)
  659. (insert "Original-")))
  660. (forward-line -1)
  661. (insert "Message-ID: " (setq message-id (nnmail-message-id))
  662. "\n")))
  663. ;; Look for a Content-Length header.
  664. (if (not (save-excursion
  665. (and (re-search-backward
  666. "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
  667. (setq content-length (string-to-number
  668. (buffer-substring
  669. (match-beginning 1)
  670. (match-end 1))))
  671. ;; We destroy the header, since none of
  672. ;; the backends ever use it, and we do not
  673. ;; want to confuse other mailers by having
  674. ;; a (possibly) faulty header.
  675. (progn (insert "X-") t))))
  676. (setq do-search t)
  677. (widen)
  678. (if (or (= (+ (point) content-length) (point-max))
  679. (save-excursion
  680. (goto-char (+ (point) content-length))
  681. (looking-at "")))
  682. (progn
  683. (goto-char (+ (point) content-length))
  684. (setq do-search nil))
  685. (setq do-search t)))
  686. (widen)
  687. ;; Go to the beginning of the next article - or to the end
  688. ;; of the buffer.
  689. (when do-search
  690. (if (re-search-forward "^" nil t)
  691. (goto-char (match-beginning 0))
  692. (goto-char (1- (point-max)))))
  693. (delete-char 1) ; delete ^_
  694. (save-excursion
  695. (save-restriction
  696. (narrow-to-region start (point))
  697. (goto-char (point-min))
  698. (nnmail-check-duplication message-id func artnum-func)
  699. (incf count)
  700. (setq end (point-max))))
  701. (goto-char end))
  702. count))
  703. (defsubst nnmail-search-unix-mail-delim ()
  704. "Put point at the beginning of the next Unix mbox message."
  705. ;; Algorithm used to find the next article in the
  706. ;; brain-dead Unix mbox format:
  707. ;;
  708. ;; 1) Search for "^From ".
  709. ;; 2) If we find it, then see whether the previous
  710. ;; line is blank and the next line looks like a header.
  711. ;; Then it's possible that this is a mail delim, and we use it.
  712. (let ((case-fold-search nil)
  713. found)
  714. (while (not found)
  715. (if (not (re-search-forward "^From " nil t))
  716. (setq found 'no)
  717. (save-excursion
  718. (beginning-of-line)
  719. (when (and (or (bobp)
  720. (save-excursion
  721. (forward-line -1)
  722. (eq (char-after) ?\n)))
  723. (save-excursion
  724. (forward-line 1)
  725. (while (looking-at ">From \\|From ")
  726. (forward-line 1))
  727. (looking-at "[^ \n\t:]+[ \n\t]*:")))
  728. (setq found 'yes)))))
  729. (beginning-of-line)
  730. (eq found 'yes)))
  731. (defun nnmail-search-unix-mail-delim-backward ()
  732. "Put point at the beginning of the current Unix mbox message."
  733. ;; Algorithm used to find the next article in the
  734. ;; brain-dead Unix mbox format:
  735. ;;
  736. ;; 1) Search for "^From ".
  737. ;; 2) If we find it, then see whether the previous
  738. ;; line is blank and the next line looks like a header.
  739. ;; Then it's possible that this is a mail delim, and we use it.
  740. (let ((case-fold-search nil)
  741. found)
  742. (while (not found)
  743. (if (not (re-search-backward "^From " nil t))
  744. (setq found 'no)
  745. (save-excursion
  746. (beginning-of-line)
  747. (when (and (or (bobp)
  748. (save-excursion
  749. (forward-line -1)
  750. (eq (char-after) ?\n)))
  751. (save-excursion
  752. (forward-line 1)
  753. (while (looking-at ">From \\|From ")
  754. (forward-line 1))
  755. (looking-at "[^ \n\t:]+[ \n\t]*:")))
  756. (setq found 'yes)))))
  757. (beginning-of-line)
  758. (eq found 'yes)))
  759. (defun nnmail-process-unix-mail-format (func artnum-func)
  760. (let ((case-fold-search t)
  761. (count 0)
  762. start message-id content-length end skip head-end)
  763. (goto-char (point-min))
  764. (if (not (and (re-search-forward "^From " nil t)
  765. (goto-char (match-beginning 0))))
  766. ;; Possibly wrong format?
  767. (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
  768. (if (buffer-file-name) "file" "buffer")
  769. (or (buffer-file-name) (buffer-name)))
  770. ;; Carry on until the bitter end.
  771. (while (not (eobp))
  772. (setq start (point)
  773. end nil)
  774. ;; Find the end of the head.
  775. (narrow-to-region
  776. start
  777. (if (search-forward "\n\n" nil t)
  778. (1- (point))
  779. ;; This will never happen, but just to be on the safe side --
  780. ;; if there is no head-body delimiter, we search a bit manually.
  781. (while (and (looking-at "From \\|[^ \t]+:")
  782. (not (eobp)))
  783. (forward-line 1))
  784. (point)))
  785. ;; Find the Message-ID header.
  786. (goto-char (point-min))
  787. (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
  788. (setq message-id (match-string 1))
  789. (save-excursion
  790. (when (re-search-forward "^Message-ID[ \t]*:" nil t)
  791. (beginning-of-line)
  792. (insert "Original-")))
  793. ;; There is no Message-ID here, so we create one.
  794. (forward-line 1)
  795. (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
  796. ;; Look for a Content-Length header.
  797. (goto-char (point-min))
  798. (if (not (re-search-forward
  799. "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
  800. (setq content-length nil)
  801. (setq content-length (string-to-number (match-string 1)))
  802. ;; We destroy the header, since none of the backends ever
  803. ;; use it, and we do not want to confuse other mailers by
  804. ;; having a (possibly) faulty header.
  805. (beginning-of-line)
  806. (insert "X-"))
  807. (run-hooks 'nnmail-prepare-incoming-header-hook)
  808. ;; Find the end of this article.
  809. (goto-char (point-max))
  810. (widen)
  811. (setq head-end (point))
  812. ;; We try the Content-Length value. The idea: skip over the header
  813. ;; separator, then check what happens content-length bytes into the
  814. ;; message body. This should be either the end of the buffer, the
  815. ;; message separator or a blank line followed by the separator.
  816. ;; The blank line should probably be deleted. If neither of the
  817. ;; three is met, the content-length header is probably invalid.
  818. (when content-length
  819. (forward-line 1)
  820. (setq skip (+ (point) content-length))
  821. (goto-char skip)
  822. (cond ((or (= skip (point-max))
  823. (= (1+ skip) (point-max)))
  824. (setq end (point-max)))
  825. ((looking-at "From ")
  826. (setq end skip))
  827. ((looking-at "[ \t]*\n\\(From \\)")
  828. (setq end (match-beginning 1)))
  829. (t (setq end nil))))
  830. (if end
  831. (goto-char end)
  832. ;; No Content-Length, so we find the beginning of the next
  833. ;; article or the end of the buffer.
  834. (goto-char head-end)
  835. (or (nnmail-search-unix-mail-delim)
  836. (goto-char (point-max))))
  837. ;; Allow the backend to save the article.
  838. (save-excursion
  839. (save-restriction
  840. (narrow-to-region start (point))
  841. (goto-char (point-min))
  842. (incf count)
  843. (nnmail-check-duplication message-id func artnum-func)
  844. (setq end (point-max))))
  845. (goto-char end)))
  846. count))
  847. (defun nnmail-process-mmdf-mail-format (func artnum-func &optional junk-func)
  848. (let ((delim "^\^A\^A\^A\^A$")
  849. (case-fold-search t)
  850. (count 0)
  851. start message-id end)
  852. (goto-char (point-min))
  853. (if (not (and (re-search-forward delim nil t)
  854. (forward-line 1)))
  855. ;; Possibly wrong format?
  856. (error "Error, unknown mail format! (Possibly corrupted.)")
  857. ;; Carry on until the bitter end.
  858. (while (not (eobp))
  859. (setq start (point))
  860. ;; Find the end of the head.
  861. (narrow-to-region
  862. start
  863. (if (search-forward "\n\n" nil t)
  864. (1- (point))
  865. ;; This will never happen, but just to be on the safe side --
  866. ;; if there is no head-body delimiter, we search a bit manually.
  867. (while (and (looking-at "From \\|[^ \t]+:")
  868. (not (eobp)))
  869. (forward-line 1))
  870. (point)))
  871. ;; Find the Message-ID header.
  872. (goto-char (point-min))
  873. (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
  874. (setq message-id (match-string 1))
  875. ;; There is no Message-ID here, so we create one.
  876. (save-excursion
  877. (when (re-search-backward "^Message-ID[ \t]*:" nil t)
  878. (beginning-of-line)
  879. (insert "Original-")))
  880. (forward-line 1)
  881. (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
  882. (run-hooks 'nnmail-prepare-incoming-header-hook)
  883. ;; Find the end of this article.
  884. (goto-char (point-max))
  885. (widen)
  886. (if (re-search-forward delim nil t)
  887. (beginning-of-line)
  888. (goto-char (point-max)))
  889. ;; Allow the backend to save the article.
  890. (save-excursion
  891. (save-restriction
  892. (narrow-to-region start (point))
  893. (goto-char (point-min))
  894. (incf count)
  895. (nnmail-check-duplication message-id func artnum-func junk-func)
  896. (setq end (point-max))))
  897. (goto-char end)
  898. (forward-line 2)))
  899. count))
  900. (defun nnmail-process-maildir-mail-format (func artnum-func)
  901. ;; In a maildir, every file contains exactly one mail.
  902. (let ((case-fold-search t)
  903. message-id)
  904. (goto-char (point-min))
  905. ;; Find the end of the head.
  906. (narrow-to-region
  907. (point-min)
  908. (if (search-forward "\n\n" nil t)
  909. (1- (point))
  910. ;; This will never happen, but just to be on the safe side --
  911. ;; if there is no head-body delimiter, we search a bit manually.
  912. (while (and (looking-at "From \\|[^ \t]+:")
  913. (not (eobp)))
  914. (forward-line 1))
  915. (point)))
  916. ;; Find the Message-ID header.
  917. (goto-char (point-min))
  918. (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
  919. (setq message-id (match-string 1))
  920. ;; There is no Message-ID here, so we create one.
  921. (save-excursion
  922. (when (re-search-backward "^Message-ID[ \t]*:" nil t)
  923. (beginning-of-line)
  924. (insert "Original-")))
  925. (forward-line 1)
  926. (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
  927. (run-hooks 'nnmail-prepare-incoming-header-hook)
  928. ;; Allow the backend to save the article.
  929. (widen)
  930. (save-excursion
  931. (goto-char (point-min))
  932. (nnmail-check-duplication message-id func artnum-func))
  933. 1))
  934. (defvar nnmail-group-names-not-encoded-p nil
  935. "Non-nil means group names are not encoded.")
  936. (defun nnmail-split-incoming (incoming func &optional exit-func
  937. group artnum-func junk-func)
  938. "Go through the entire INCOMING file and pick out each individual mail.
  939. FUNC will be called with the buffer narrowed to each mail.
  940. INCOMING can also be a buffer object. In that case, the mail
  941. will be copied over from that buffer."
  942. (let ( ;; If this is a group-specific split, we bind the split
  943. ;; methods to just this group.
  944. (nnmail-split-methods (if (and group
  945. (not nnmail-resplit-incoming))
  946. (list (list group ""))
  947. nnmail-split-methods))
  948. (nnmail-group-names-not-encoded-p t))
  949. ;; Insert the incoming file.
  950. (with-current-buffer (get-buffer-create nnmail-article-buffer)
  951. (erase-buffer)
  952. (if (bufferp incoming)
  953. (insert-buffer-substring incoming)
  954. (let ((coding-system-for-read nnmail-incoming-coding-system))
  955. (mm-insert-file-contents incoming)))
  956. (prog1
  957. (if (zerop (buffer-size))
  958. 0
  959. (goto-char (point-min))
  960. (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
  961. ;; Handle both babyl, MMDF and unix mail formats, since
  962. ;; movemail will use the former when fetching from a
  963. ;; mailbox, the latter when fetching from a file.
  964. (cond ((or (looking-at "\^L")
  965. (looking-at "BABYL OPTIONS:"))
  966. (nnmail-process-babyl-mail-format func artnum-func))
  967. ((looking-at "\^A\^A\^A\^A")
  968. (nnmail-process-mmdf-mail-format
  969. func artnum-func junk-func))
  970. ((looking-at "Return-Path:")
  971. (nnmail-process-maildir-mail-format func artnum-func))
  972. (t
  973. (nnmail-process-unix-mail-format func artnum-func))))
  974. (when exit-func
  975. (funcall exit-func))
  976. (kill-buffer (current-buffer))))))
  977. (defun nnmail-article-group (func &optional trace junk-func)
  978. "Look at the headers and return an alist of groups that match.
  979. FUNC will be called with the group name to determine the article number."
  980. (let ((methods (or nnmail-split-methods '(("bogus" ""))))
  981. (obuf (current-buffer))
  982. group-art method grp)
  983. (if (and (sequencep methods)
  984. (= (length methods) 1)
  985. (not nnmail-inhibit-default-split-group))
  986. ;; If there is only just one group to put everything in, we
  987. ;; just return a list with just this one method in.
  988. (setq group-art
  989. (list (cons (caar methods) (funcall func (caar methods)))))
  990. ;; We do actual comparison.
  991. ;; Copy the article into the work buffer.
  992. (with-current-buffer nntp-server-buffer
  993. (erase-buffer)
  994. (insert-buffer-substring obuf)
  995. ;; Narrow to headers.
  996. (narrow-to-region
  997. (goto-char (point-min))
  998. (if (search-forward "\n\n" nil t)
  999. (point)
  1000. (point-max)))
  1001. (goto-char (point-min))
  1002. ;; Decode MIME headers and charsets.
  1003. (when nnmail-mail-splitting-decodes
  1004. (let ((mail-parse-charset nnmail-mail-splitting-charset))
  1005. (mail-decode-encoded-word-region (point-min) (point-max))))
  1006. ;; Fold continuation lines.
  1007. (goto-char (point-min))
  1008. (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  1009. (replace-match " " t t))
  1010. ;; Nuke pathologically long headers. Since Gnus applies
  1011. ;; pathologically complex regexps to the buffer, lines
  1012. ;; that are looong will take longer than the Universe's
  1013. ;; existence to process.
  1014. (goto-char (point-min))
  1015. (while (not (eobp))
  1016. (unless (< (move-to-column nnmail-split-header-length-limit)
  1017. nnmail-split-header-length-limit)
  1018. (delete-region (point) (point-at-eol)))
  1019. (forward-line 1))
  1020. ;; Allow washing.
  1021. (goto-char (point-min))
  1022. (run-hooks 'nnmail-split-hook)
  1023. (when (setq nnmail-split-tracing trace)
  1024. (setq nnmail-split-trace nil))
  1025. (if (or (and (symbolp nnmail-split-methods)
  1026. (fboundp nnmail-split-methods))
  1027. (not (consp (car-safe nnmail-split-methods)))
  1028. (and (listp nnmail-split-methods)
  1029. ;; Not a regular split method, so it has to be a
  1030. ;; fancy one.
  1031. (not (let ((top-element (car-safe nnmail-split-methods)))
  1032. (and (= 2 (length top-element))
  1033. (stringp (nth 0 top-element))
  1034. (stringp (nth 1 top-element)))))))
  1035. (let* ((method-function
  1036. (if (and (symbolp nnmail-split-methods)
  1037. (fboundp nnmail-split-methods))
  1038. nnmail-split-methods
  1039. 'nnmail-split-fancy))
  1040. (split
  1041. (condition-case error-info
  1042. ;; `nnmail-split-methods' is a function, so we
  1043. ;; just call this function here and use the
  1044. ;; result.
  1045. (or (funcall method-function)
  1046. (and (not nnmail-inhibit-default-split-group)
  1047. '("bogus")))
  1048. (error
  1049. (nnheader-message
  1050. 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
  1051. (sit-for 1)
  1052. '("bogus")))))
  1053. (setq split (mm-delete-duplicates split))
  1054. ;; The article may be "cross-posted" to `junk'. What
  1055. ;; to do? Just remove the `junk' spec. Don't really
  1056. ;; see anything else to do...
  1057. (when (and (memq 'junk split)
  1058. junk-func)
  1059. (funcall junk-func 'junk))
  1060. (setq split (delq 'junk split))
  1061. (when split
  1062. (setq group-art
  1063. (mapcar
  1064. (lambda (group) (cons group (funcall func group)))
  1065. split))))
  1066. ;; Go through the split methods to find a match.
  1067. (while (and methods
  1068. (or nnmail-crosspost
  1069. (not group-art)))
  1070. (goto-char (point-max))
  1071. (setq method (pop methods)
  1072. grp (car method))
  1073. (if (or methods
  1074. (not (equal "" (nth 1 method))))
  1075. (when (and
  1076. (ignore-errors
  1077. (if (stringp (nth 1 method))
  1078. (let ((expand (string-match "\\\\[0-9&]" grp))
  1079. (pos (re-search-backward (cadr method)
  1080. nil t)))
  1081. (and expand
  1082. (setq grp (nnmail-expand-newtext grp)))
  1083. pos)
  1084. ;; Function to say whether this is a match.
  1085. (funcall (nth 1 method) grp)))
  1086. ;; Don't enter the article into the same
  1087. ;; group twice.
  1088. (not (assoc grp group-art)))
  1089. (push (cons grp (funcall func grp))
  1090. group-art))
  1091. ;; This is the final group, which is used as a
  1092. ;; catch-all.
  1093. (when (and (not group-art)
  1094. (or (equal "" (nth 1 method))
  1095. (not nnmail-inhibit-default-split-group)))
  1096. (setq group-art
  1097. (list (cons (car method)
  1098. (funcall func (car method))))))))
  1099. ;; Fall back on "bogus" if all else fails.
  1100. (when (and (not group-art)
  1101. (not nnmail-inhibit-default-split-group))
  1102. (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
  1103. ;; Produce a trace if non-empty.
  1104. (when (and trace nnmail-split-trace)
  1105. (let ((restore (current-buffer)))
  1106. (nnheader-set-temp-buffer "*Split Trace*")
  1107. (gnus-add-buffer)
  1108. (dolist (trace (nreverse nnmail-split-trace))
  1109. (prin1 trace (current-buffer))
  1110. (insert "\n"))
  1111. (goto-char (point-min))
  1112. (gnus-configure-windows 'split-trace)
  1113. (set-buffer restore)))
  1114. (widen)
  1115. ;; See whether the split methods returned `junk'.
  1116. (if (equal group-art '(junk))
  1117. nil
  1118. ;; The article may be "cross-posted" to `junk'. What
  1119. ;; to do? Just remove the `junk' spec. Don't really
  1120. ;; see anything else to do...
  1121. (let (elem)
  1122. (while (setq elem (car (memq 'junk group-art)))
  1123. (setq group-art (delq elem group-art)))
  1124. (nreverse group-art)))))))
  1125. (defun nnmail-insert-lines ()
  1126. "Insert how many lines there are in the body of the mail.
  1127. Return the number of characters in the body."
  1128. (let (lines chars)
  1129. (save-excursion
  1130. (goto-char (point-min))
  1131. (unless (search-forward "\n\n" nil t)
  1132. (goto-char (point-max))
  1133. (insert "\n"))
  1134. (setq chars (- (point-max) (point)))
  1135. (setq lines (count-lines (point) (point-max)))
  1136. (forward-char -1)
  1137. (save-excursion
  1138. (when (re-search-backward "^Lines: " nil t)
  1139. (delete-region (point) (progn (forward-line 1) (point)))))
  1140. (beginning-of-line)
  1141. (insert (format "Lines: %d\n" (max lines 0)))
  1142. chars)))
  1143. (defun nnmail-insert-xref (group-alist)
  1144. "Insert an Xref line based on the (group . article) alist."
  1145. (save-excursion
  1146. (goto-char (point-min))
  1147. (unless (search-forward "\n\n" nil t)
  1148. (goto-char (point-max))
  1149. (insert "\n"))
  1150. (forward-char -1)
  1151. (when (re-search-backward "^Xref: " nil t)
  1152. (delete-region (match-beginning 0)
  1153. (progn (forward-line 1) (point))))
  1154. (insert (format "Xref: %s" (system-name)))
  1155. (while group-alist
  1156. (insert (if (mm-multibyte-p)
  1157. (mm-string-as-multibyte
  1158. (format " %s:%d" (caar group-alist) (cdar group-alist)))
  1159. (mm-string-as-unibyte
  1160. (format " %s:%d" (caar group-alist) (cdar group-alist)))))
  1161. (setq group-alist (cdr group-alist)))
  1162. (insert "\n")))
  1163. ;;; Message washing functions
  1164. (defun nnmail-remove-leading-whitespace ()
  1165. "Remove excessive whitespace from all headers."
  1166. (goto-char (point-min))
  1167. (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
  1168. (replace-match "\\1" t)))
  1169. (defun nnmail-remove-list-identifiers ()
  1170. "Remove list identifiers from Subject headers."
  1171. (let ((regexp
  1172. (if (consp nnmail-list-identifiers)
  1173. (mapconcat 'identity nnmail-list-identifiers " *\\|")
  1174. nnmail-list-identifiers)))
  1175. (when regexp
  1176. (goto-char (point-min))
  1177. (while (re-search-forward
  1178. (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
  1179. nil t)
  1180. (delete-region (match-beginning 2) (match-end 0))
  1181. (beginning-of-line))
  1182. (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
  1183. nil t)
  1184. (delete-region (match-beginning 1) (match-end 1))
  1185. (beginning-of-line)))))
  1186. (defun nnmail-remove-tabs ()
  1187. "Translate TAB characters into SPACE characters."
  1188. (subst-char-in-region (point-min) (point-max) ?\t ? t))
  1189. (defcustom nnmail-broken-references-mailers
  1190. "^X-Mailer:.*\\(Eudora\\|Pegasus\\)"
  1191. "Header line matching mailer producing bogus References lines.
  1192. See `nnmail-ignore-broken-references'."
  1193. :group 'nnmail-prepare
  1194. :version "23.1" ;; No Gnus
  1195. :type 'regexp)
  1196. (defun nnmail-ignore-broken-references ()
  1197. "Ignore the References line and use In-Reply-To
  1198. Eudora has a broken References line, but an OK In-Reply-To."
  1199. (goto-char (point-min))
  1200. (when (re-search-forward nnmail-broken-references-mailers nil t)
  1201. (goto-char (point-min))
  1202. (when (re-search-forward "^References:" nil t)
  1203. (beginning-of-line)
  1204. (insert "X-Gnus-Broken-Eudora-"))
  1205. (goto-char (point-min))
  1206. (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
  1207. (replace-match "\\1" t))))
  1208. (defalias 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references)
  1209. (make-obsolete 'nnmail-fix-eudora-headers 'nnmail-ignore-broken-references "Emacs 23.1")
  1210. (custom-add-option 'nnmail-prepare-incoming-header-hook
  1211. 'nnmail-ignore-broken-references)
  1212. ;;; Utility functions
  1213. (declare-function gnus-activate-group "gnus-start"
  1214. (group &optional scan dont-check method dont-sub-check))
  1215. (defun nnmail-do-request-post (accept-func &optional server)
  1216. "Utility function to directly post a message to an nnmail-derived group.
  1217. Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
  1218. to actually put the message in the right group."
  1219. (let ((success t))
  1220. (dolist (mbx (message-unquote-tokens
  1221. (message-tokenize-header
  1222. (message-fetch-field "Newsgroups") ", ")) success)
  1223. (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
  1224. (or (gnus-active to-newsgroup)
  1225. (gnus-activate-group to-newsgroup)
  1226. (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
  1227. to-newsgroup))
  1228. (or (and (gnus-request-create-group
  1229. to-newsgroup gnus-command-method)
  1230. (gnus-activate-group to-newsgroup nil nil
  1231. gnus-command-method))
  1232. (error "Couldn't create group %s" to-newsgroup)))
  1233. (error "No such group: %s" to-newsgroup))
  1234. (unless (funcall accept-func mbx (nth 1 gnus-command-method))
  1235. (setq success nil))))))
  1236. (defun nnmail-split-fancy ()
  1237. "Fancy splitting method.
  1238. See the documentation for the variable `nnmail-split-fancy' for details."
  1239. (with-syntax-table nnmail-split-fancy-syntax-table
  1240. (nnmail-split-it nnmail-split-fancy)))
  1241. (defvar nnmail-split-cache nil)
  1242. ;; Alist of split expressions their equivalent regexps.
  1243. (defun nnmail-split-it (split)
  1244. ;; Return a list of groups matching SPLIT.
  1245. (let (cached-pair)
  1246. (cond
  1247. ;; nil split
  1248. ((null split)
  1249. nil)
  1250. ;; A group name. Do the \& and \N subs into the string.
  1251. ((stringp split)
  1252. (when nnmail-split-tracing
  1253. (push split nnmail-split-trace))
  1254. (list (nnmail-expand-newtext split t)))
  1255. ;; Junk the message.
  1256. ((eq split 'junk)
  1257. (when nnmail-split-tracing
  1258. (push "junk" nnmail-split-trace))
  1259. (list 'junk))
  1260. ;; Builtin & operation.
  1261. ((eq (car split) '&)
  1262. (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
  1263. ;; Builtin | operation.
  1264. ((eq (car split) '|)
  1265. (let (done)
  1266. (while (and (not done) (cdr split))
  1267. (setq split (cdr split)
  1268. done (nnmail-split-it (car split))))
  1269. done))
  1270. ;; Builtin : operation.
  1271. ((eq (car split) ':)
  1272. (when nnmail-split-tracing
  1273. (push split nnmail-split-trace))
  1274. (nnmail-split-it (save-excursion (eval (cdr split)))))
  1275. ;; Builtin ! operation.
  1276. ((eq (car split) '!)
  1277. (funcall (cadr split) (nnmail-split-it (caddr split))))
  1278. ;; Check the cache for the regexp for this split.
  1279. ((setq cached-pair (assq split nnmail-split-cache))
  1280. (let (split-result
  1281. match-data
  1282. (end-point (point-max))
  1283. (value (nth 1 split)))
  1284. (if (symbolp value)
  1285. (setq value (cdr (assq value nnmail-split-abbrev-alist))))
  1286. (while (and (goto-char end-point)
  1287. (re-search-backward (cdr cached-pair) nil t))
  1288. (setq match-data (match-data))
  1289. (when nnmail-split-tracing
  1290. (push split nnmail-split-trace))
  1291. (let ((split-rest (cddr split))
  1292. (end (match-end 0))
  1293. ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
  1294. ;; So, start-of-value is the point just before the
  1295. ;; beginning of the value, whereas after-header-name
  1296. ;; is the point just after the field name.
  1297. (start-of-value (match-end 1))
  1298. (after-header-name (match-end 2)))
  1299. ;; Start the next search just before the beginning of the
  1300. ;; VALUE match.
  1301. (setq end-point (1- start-of-value))
  1302. ;; Handle - RESTRICTs
  1303. (while (eq (car split-rest) '-)
  1304. ;; RESTRICT must start after-header-name and
  1305. ;; end after start-of-value, so that, for
  1306. ;; (any "foo" - "x-foo" "foo.list")
  1307. ;; we do not exclude foo.list just because
  1308. ;; the header is: ``To: x-foo, foo''
  1309. (goto-char end)
  1310. (if (and (re-search-backward (cadr split-rest)
  1311. after-header-name t)
  1312. (> (match-end 0) start-of-value))
  1313. (setq split-rest nil)
  1314. (setq split-rest (cddr split-rest))))
  1315. (when split-rest
  1316. (goto-char end)
  1317. ;; Someone might want to do a \N sub on this match, so
  1318. ;; restore the match data.
  1319. (set-match-data match-data)
  1320. (dolist (sp (nnmail-split-it (car split-rest)))
  1321. (unless (member sp split-result)
  1322. (push sp split-result))))))
  1323. split-result))
  1324. ;; Not in cache, compute a regexp for the field/value pair.
  1325. (t
  1326. (let ((field (nth 0 split))
  1327. (value (nth 1 split))
  1328. (split-rest (cddr split))
  1329. partial-front
  1330. partial-rear
  1331. regexp)
  1332. (if (symbolp value)
  1333. (setq value (cdr (assq value nnmail-split-abbrev-alist))))
  1334. (if (and (>= (length value) 2)
  1335. (string= ".*" (substring value 0 2)))
  1336. (setq value (substring value 2)
  1337. partial-front ""))
  1338. ;; Same trick for the rear of the regexp
  1339. (if (and (>= (length value) 2)
  1340. (string= ".*" (substring value -2)))
  1341. (setq value (substring value 0 -2)
  1342. partial-rear ""))
  1343. ;; Invert the match-partial-words behavior if the optional
  1344. ;; last element is specified.
  1345. (while (eq (car split-rest) '-)
  1346. (setq split-rest (cddr split-rest)))
  1347. (when (if (cadr split-rest)
  1348. (not nnmail-split-fancy-match-partial-words)
  1349. nnmail-split-fancy-match-partial-words)
  1350. (setq partial-front ""
  1351. partial-rear ""))
  1352. (setq regexp (concat "^\\(\\("
  1353. (if (symbolp field)
  1354. (cdr (assq field nnmail-split-abbrev-alist))
  1355. field)
  1356. "\\):.*\\)"
  1357. (or partial-front "\\<")
  1358. "\\("
  1359. value
  1360. "\\)"
  1361. (or partial-rear "\\>")))
  1362. (push (cons split regexp) nnmail-split-cache)
  1363. ;; Now that it's in the cache, just call nnmail-split-it again
  1364. ;; on the same split, which will find it immediately in the cache.
  1365. (nnmail-split-it split))))))
  1366. (defun nnmail-expand-newtext (newtext &optional fancyp)
  1367. (let ((len (length newtext))
  1368. (pos 0)
  1369. c expanded beg N did-expand)
  1370. (while (< pos len)
  1371. (setq beg pos)
  1372. (while (and (< pos len)
  1373. (not (= (aref newtext pos) ?\\)))
  1374. (setq pos (1+ pos)))
  1375. (unless (= beg pos)
  1376. (push (substring newtext beg pos) expanded))
  1377. (when (< pos len)
  1378. ;; We hit a \; expand it.
  1379. (setq did-expand t
  1380. pos (1+ pos)
  1381. c (aref newtext pos))
  1382. (if (not (or (= c ?\&)
  1383. (and (>= c ?1)
  1384. (<= c ?9))))
  1385. ;; \ followed by some character we don't expand.
  1386. (push (char-to-string c) expanded)
  1387. ;; \& or \N
  1388. (if (= c ?\&)
  1389. (setq N 0)
  1390. (setq N (- c ?0)))
  1391. ;; We wrapped the searches in parentheses, so we have to
  1392. ;; add some parentheses here...
  1393. (when fancyp
  1394. (setq N (+ N 3)))
  1395. (when (match-beginning N)
  1396. (push (if nnmail-split-lowercase-expanded
  1397. (downcase (buffer-substring (match-beginning N)
  1398. (match-end N)))
  1399. (buffer-substring (match-beginning N) (match-end N)))
  1400. expanded))))
  1401. (setq pos (1+ pos)))
  1402. (if did-expand
  1403. (apply 'concat (nreverse expanded))
  1404. newtext)))
  1405. ;; Activate a backend only if it isn't already activated.
  1406. ;; If FORCE, re-read the active file even if the backend is
  1407. ;; already activated.
  1408. (defun nnmail-activate (backend &optional force)
  1409. (nnheader-init-server-buffer)
  1410. (let (file timestamp file-time)
  1411. (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
  1412. force
  1413. (and (setq file (ignore-errors
  1414. (symbol-value (intern (format "%s-active-file"
  1415. backend)))))
  1416. (setq file-time (nth 5 (file-attributes file)))
  1417. (or (not
  1418. (setq timestamp
  1419. (condition-case ()
  1420. (symbol-value (intern
  1421. (format "%s-active-timestamp"
  1422. backend)))
  1423. (error 'none))))
  1424. (not (consp timestamp))
  1425. (equal timestamp '(0 0))
  1426. (> (nth 0 file-time) (nth 0 timestamp))
  1427. (and (= (nth 0 file-time) (nth 0 timestamp))
  1428. (> (nth 1 file-time) (nth 1 timestamp))))))
  1429. (save-excursion
  1430. (or (eq timestamp 'none)
  1431. (set (intern (format "%s-active-timestamp" backend))
  1432. file-time))
  1433. (funcall (intern (format "%s-request-list" backend)))))
  1434. t))
  1435. (defun nnmail-message-id ()
  1436. (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
  1437. ;;;
  1438. ;;; nnmail duplicate handling
  1439. ;;;
  1440. (defvar nnmail-cache-buffer nil)
  1441. (defun nnmail-cache-open ()
  1442. (if (or (not nnmail-treat-duplicates)
  1443. (and nnmail-cache-buffer
  1444. (buffer-name nnmail-cache-buffer)))
  1445. () ; The buffer is open.
  1446. (with-current-buffer
  1447. (setq nnmail-cache-buffer
  1448. (get-buffer-create " *nnmail message-id cache*"))
  1449. (gnus-add-buffer)
  1450. (when (file-exists-p nnmail-message-id-cache-file)
  1451. (nnheader-insert-file-contents nnmail-message-id-cache-file))
  1452. (set-buffer-modified-p nil)
  1453. (current-buffer))))
  1454. (defun nnmail-cache-close ()
  1455. (when (and nnmail-cache-buffer
  1456. nnmail-treat-duplicates
  1457. (buffer-name nnmail-cache-buffer)
  1458. (buffer-modified-p nnmail-cache-buffer))
  1459. (with-current-buffer nnmail-cache-buffer
  1460. ;; Weed out the excess number of Message-IDs.
  1461. (goto-char (point-max))
  1462. (when (search-backward "\n" nil t nnmail-message-id-cache-length)
  1463. (progn
  1464. (beginning-of-line)
  1465. (delete-region (point-min) (point))))
  1466. ;; Save the buffer.
  1467. (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
  1468. (make-directory (file-name-directory nnmail-message-id-cache-file)
  1469. t))
  1470. (nnmail-write-region (point-min) (point-max)
  1471. nnmail-message-id-cache-file nil 'silent)
  1472. (set-buffer-modified-p nil)
  1473. (setq nnmail-cache-buffer nil)
  1474. (gnus-kill-buffer (current-buffer)))))
  1475. (defun nnmail-cache-insert (id grp &optional subject sender)
  1476. (when (stringp id)
  1477. ;; this will handle cases like `B r' where the group is nil
  1478. (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
  1479. (run-hook-with-args 'nnmail-spool-hook
  1480. id grp subject sender))
  1481. (when nnmail-treat-duplicates
  1482. ;; Store some information about the group this message is written
  1483. ;; to. This is passed in as the grp argument -- all locations this
  1484. ;; has been called from have been checked and the group is available.
  1485. ;; The only ambiguous case is nnmail-check-duplication which will only
  1486. ;; pass the first (of possibly >1) group which matches. -Josh
  1487. (unless (gnus-buffer-live-p nnmail-cache-buffer)
  1488. (nnmail-cache-open))
  1489. (with-current-buffer nnmail-cache-buffer
  1490. (goto-char (point-max))
  1491. (if (and grp (not (string= "" grp))
  1492. (gnus-methods-equal-p gnus-command-method
  1493. (nnmail-cache-primary-mail-backend)))
  1494. (let ((regexp (if (consp nnmail-cache-ignore-groups)
  1495. (mapconcat 'identity nnmail-cache-ignore-groups
  1496. "\\|")
  1497. nnmail-cache-ignore-groups)))
  1498. (unless (and regexp (string-match regexp grp))
  1499. (insert id "\t" grp "\n")))
  1500. (insert id "\n"))))))
  1501. (defun nnmail-cache-primary-mail-backend ()
  1502. (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
  1503. (be nil)
  1504. (res nil)
  1505. (get-new-mail nil))
  1506. (while (and (null res) be-list)
  1507. (setq be (car be-list))
  1508. (setq be-list (cdr be-list))
  1509. (when (and (gnus-method-option-p be 'respool)
  1510. (setq get-new-mail
  1511. (intern (format "%s-get-new-mail" (car be))))
  1512. (boundp get-new-mail)
  1513. (symbol-value get-new-mail))
  1514. (setq res be)))
  1515. res))
  1516. ;; Fetch the group name corresponding to the message id stored in the
  1517. ;; cache.
  1518. (defun nnmail-cache-fetch-group (id)
  1519. (when (and nnmail-treat-duplicates nnmail-cache-buffer)
  1520. (with-current-buffer nnmail-cache-buffer
  1521. (goto-char (point-max))
  1522. (when (search-backward id nil t)
  1523. (beginning-of-line)
  1524. (skip-chars-forward "^\n\r\t")
  1525. (unless (looking-at "[\r\n]")
  1526. (forward-char 1)
  1527. (buffer-substring (point) (point-at-eol)))))))
  1528. ;; Function for nnmail-split-fancy: look up all references in the
  1529. ;; cache and if a match is found, return that group.
  1530. (defun nnmail-split-fancy-with-parent ()
  1531. "Split this message into the same group as its parent.
  1532. This function can be used as an entry in `nnmail-split-fancy', for
  1533. example like this: (: nnmail-split-fancy-with-parent)
  1534. For a message to be split, it looks for the parent message in the
  1535. References or In-Reply-To header and then looks in the message id
  1536. cache file (given by the variable `nnmail-message-id-cache-file') to
  1537. see which group that message was put in. This group is returned.
  1538. See the Info node `(gnus)Fancy Mail Splitting' for more details."
  1539. (let* ((refstr (or (message-fetch-field "references")
  1540. (message-fetch-field "in-reply-to")))
  1541. (references nil)
  1542. (res nil)
  1543. (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
  1544. (mapconcat
  1545. (lambda (x) (format "\\(%s\\)" x))
  1546. nnmail-split-fancy-with-parent-ignore-groups
  1547. "\\|")
  1548. nnmail-split-fancy-with-parent-ignore-groups)))
  1549. (when refstr
  1550. (setq references (nreverse (gnus-split-references refstr)))
  1551. (unless (gnus-buffer-live-p nnmail-cache-buffer)
  1552. (nnmail-cache-open))
  1553. (dolist (x references)
  1554. (setq res (or (nnmail-cache-fetch-group x) res))
  1555. (when (or (member res '("delayed" "drafts" "queue"))
  1556. (and regexp res (string-match regexp res)))
  1557. (setq res nil)))
  1558. res)))
  1559. (defun nnmail-cache-id-exists-p (id)
  1560. (when nnmail-treat-duplicates
  1561. (with-current-buffer nnmail-cache-buffer
  1562. (goto-char (point-max))
  1563. (search-backward id nil t))))
  1564. (defun nnmail-fetch-field (header)
  1565. (save-excursion
  1566. (save-restriction
  1567. (message-narrow-to-head)
  1568. (message-fetch-field header))))
  1569. (defun nnmail-check-duplication (message-id func artnum-func
  1570. &optional junk-func)
  1571. (run-hooks 'nnmail-prepare-incoming-message-hook)
  1572. ;; If this is a duplicate message, then we do not save it.
  1573. (let* ((duplication (nnmail-cache-id-exists-p message-id))
  1574. (case-fold-search t)
  1575. (action (when duplication
  1576. (cond
  1577. ((memq nnmail-treat-duplicates '(warn delete))
  1578. nnmail-treat-duplicates)
  1579. ((functionp nnmail-treat-duplicates)
  1580. (funcall nnmail-treat-duplicates message-id))
  1581. (t
  1582. nnmail-treat-duplicates))))
  1583. group-art)
  1584. ;; We insert a line that says what the mail source is.
  1585. (let ((case-fold-search t))
  1586. (goto-char (point-min))
  1587. (re-search-forward "^message-id[ \t]*:" nil t)
  1588. (beginning-of-line)
  1589. (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string)))
  1590. ;; Let the backend save the article (or not).
  1591. (cond
  1592. ((not duplication)
  1593. (funcall func (setq group-art
  1594. (nreverse (nnmail-article-group
  1595. artnum-func nil junk-func))))
  1596. (nnmail-cache-insert message-id (caar group-art)))
  1597. ((eq action 'delete)
  1598. (setq group-art nil))
  1599. ((eq action 'warn)
  1600. ;; We insert a warning.
  1601. (let ((case-fold-search t))
  1602. (goto-char (point-min))
  1603. (re-search-forward "^message-id[ \t]*:" nil t)
  1604. (beginning-of-line)
  1605. (insert
  1606. "Gnus-Warning: This is a duplicate of message " message-id "\n")
  1607. (funcall func (setq group-art
  1608. (nreverse (nnmail-article-group artnum-func))))))
  1609. (t
  1610. (funcall func (setq group-art
  1611. (nreverse (nnmail-article-group artnum-func))))))
  1612. ;; Add the group-art list to the history list.
  1613. (if group-art
  1614. (push group-art nnmail-split-history)
  1615. (delete-region (point-min) (point-max)))))
  1616. ;;; Get new mail.
  1617. (defvar nnmail-fetched-sources nil)
  1618. (defun nnmail-get-value (&rest args)
  1619. (let ((sym (intern (apply 'format args))))
  1620. (when (boundp sym)
  1621. (symbol-value sym))))
  1622. (defun nnmail-get-new-mail (method exit-func temp
  1623. &optional group spool-func)
  1624. "Read new incoming mail."
  1625. (nnmail-get-new-mail-1 method exit-func temp group nil spool-func))
  1626. (defun nnmail-get-new-mail-per-group ()
  1627. "Tell us whether the mail-sources specify that `nnmail-get-new-mail' should
  1628. be called once per group or once for all groups."
  1629. (or (assq 'group mail-sources)
  1630. (assq 'directory mail-sources)))
  1631. (defun nnmail-get-new-mail-1 (method exit-func temp
  1632. group in-group spool-func)
  1633. (let* ((sources mail-sources)
  1634. fetching-sources
  1635. (i 0)
  1636. (new 0)
  1637. (total 0)
  1638. source)
  1639. (when (and (nnmail-get-value "%s-get-new-mail" method)
  1640. sources)
  1641. (while (setq source (pop sources))
  1642. ;; Use group's parameter
  1643. (when (and (eq (car source) 'group)
  1644. group)
  1645. (let ((mail-sources
  1646. (list
  1647. (gnus-group-find-parameter
  1648. (concat (symbol-name method) ":" group)
  1649. 'mail-source t))))
  1650. (nnmail-get-new-mail-1 method exit-func temp
  1651. group group spool-func))
  1652. (setq source nil))
  1653. ;; Hack to only fetch the contents of a single group's spool file.
  1654. (when (and (eq (car source) 'directory)
  1655. (null nnmail-scan-directory-mail-source-once)
  1656. group)
  1657. (mail-source-bind (directory source)
  1658. (setq source (append source
  1659. (list
  1660. :predicate
  1661. (gnus-byte-compile
  1662. `(lambda (file)
  1663. (string-equal
  1664. ,(concat group suffix)
  1665. (file-name-nondirectory file)))))))))
  1666. (when nnmail-fetched-sources
  1667. (if (member source nnmail-fetched-sources)
  1668. (setq source nil)
  1669. (push source nnmail-fetched-sources)
  1670. (push source fetching-sources)))))
  1671. (when fetching-sources
  1672. ;; We first activate all the groups.
  1673. (nnmail-activate method)
  1674. ;; Allow the user to hook.
  1675. (run-hooks 'nnmail-pre-get-new-mail-hook)
  1676. ;; Open the message-id cache.
  1677. (nnmail-cache-open)
  1678. ;; The we go through all the existing mail source specification
  1679. ;; and fetch the mail from each.
  1680. (while (setq source (pop fetching-sources))
  1681. (when (setq new
  1682. (condition-case cond
  1683. (mail-source-fetch
  1684. source
  1685. (gnus-byte-compile
  1686. `(lambda (file orig-file)
  1687. (nnmail-split-incoming
  1688. file ',(intern (format "%s-save-mail" method))
  1689. ',spool-func
  1690. (or in-group
  1691. (if (equal file orig-file)
  1692. nil
  1693. (nnmail-get-split-group orig-file
  1694. ',source)))
  1695. ',(intern (format "%s-active-number" method))))))
  1696. ((error quit)
  1697. (message "Mail source %s failed: %s" source cond)
  1698. 0)))
  1699. (incf total new)
  1700. (incf i)))
  1701. ;; If we did indeed read any incoming spools, we save all info.
  1702. (if (zerop total)
  1703. (when mail-source-plugged
  1704. (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
  1705. method (car source)))
  1706. (nnmail-save-active
  1707. (nnmail-get-value "%s-group-alist" method)
  1708. (nnmail-get-value "%s-active-file" method))
  1709. (when exit-func
  1710. (funcall exit-func))
  1711. (run-hooks 'nnmail-read-incoming-hook)
  1712. (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
  1713. total))
  1714. ;; Close the message-id cache.
  1715. (nnmail-cache-close)
  1716. ;; Allow the user to hook.
  1717. (run-hooks 'nnmail-post-get-new-mail-hook))))
  1718. (defun nnmail-expired-article-p (group time force &optional inhibit)
  1719. "Say whether an article that is TIME old in GROUP should be expired.
  1720. If TIME is nil, then return the cutoff time for oldness instead."
  1721. (if force
  1722. (if (null time)
  1723. (current-time)
  1724. t)
  1725. (let ((days (or (and nnmail-expiry-wait-function
  1726. (funcall nnmail-expiry-wait-function group))
  1727. nnmail-expiry-wait)))
  1728. (cond ((or (eq days 'never)
  1729. (and (not force)
  1730. inhibit))
  1731. ;; This isn't an expirable group.
  1732. nil)
  1733. ((eq days 'immediate)
  1734. ;; We expire all articles on sight.
  1735. (if (null time)
  1736. (current-time)
  1737. t))
  1738. ((equal time '(0 0))
  1739. ;; This is an ange-ftp group, and we don't have any dates.
  1740. nil)
  1741. ((numberp days)
  1742. (setq days (days-to-time days))
  1743. ;; Compare the time with the current time.
  1744. (if (null time)
  1745. (time-subtract (current-time) days)
  1746. (ignore-errors (time-less-p days (time-since time)))))))))
  1747. (declare-function gnus-group-mark-article-read "gnus-group" (group article))
  1748. (defun nnmail-expiry-target-group (target group)
  1749. ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears
  1750. ;; that buffer if the nnfolder group isn't selected.
  1751. (let (nnmail-cache-accepted-message-ids)
  1752. ;; Don't enter Message-IDs into cache.
  1753. ;; Let users hack it in TARGET function.
  1754. (when (functionp target)
  1755. (setq target (funcall target group)))
  1756. (unless (eq target 'delete)
  1757. (when (or (gnus-request-group target nil nil (gnus-get-info target))
  1758. (gnus-request-create-group target))
  1759. (let ((group-art (gnus-request-accept-article target nil nil t)))
  1760. (when (and (consp group-art)
  1761. (cdr group-art))
  1762. (gnus-group-mark-article-read target (cdr group-art))))))))
  1763. (defun nnmail-fancy-expiry-target (group)
  1764. "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
  1765. (let* (header
  1766. (case-fold-search nil)
  1767. (from (or (message-fetch-field "from") ""))
  1768. (to (or (message-fetch-field "to") ""))
  1769. (date (message-fetch-field "date"))
  1770. (target 'delete))
  1771. (setq date (if date
  1772. (condition-case err
  1773. (date-to-time date)
  1774. (error
  1775. (message "%s" (error-message-string err))
  1776. (current-time)))
  1777. (current-time)))
  1778. (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
  1779. (setq header (car regexp-target-pair))
  1780. (cond
  1781. ;; If the header is to-from then match against the
  1782. ;; To or From header
  1783. ((and (equal header 'to-from)
  1784. (or (string-match (cadr regexp-target-pair) from)
  1785. (and (string-match (cadr regexp-target-pair) to)
  1786. (let* ((mail-dont-reply-to-names
  1787. (message-dont-reply-to-names))
  1788. (rmail-dont-reply-to-names ; obsolete since 24.1
  1789. mail-dont-reply-to-names))
  1790. (equal (if (fboundp 'rmail-dont-reply-to)
  1791. (rmail-dont-reply-to from)
  1792. (mail-dont-reply-to from)) "")))))
  1793. (setq target (format-time-string (caddr regexp-target-pair) date)))
  1794. ((and (not (equal header 'to-from))
  1795. (string-match (cadr regexp-target-pair)
  1796. (or
  1797. (message-fetch-field header)
  1798. "")))
  1799. (setq target
  1800. (format-time-string (caddr regexp-target-pair) date)))))))
  1801. (defun nnmail-check-syntax ()
  1802. "Check (and modify) the syntax of the message in the current buffer."
  1803. (save-restriction
  1804. (message-narrow-to-head)
  1805. (let ((case-fold-search t))
  1806. (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
  1807. (insert "Message-ID: " (nnmail-message-id) "\n")))))
  1808. (defun nnmail-write-region (start end filename &optional append visit lockname)
  1809. "Do a `write-region', and then set the file modes."
  1810. (let ((coding-system-for-write nnmail-file-coding-system)
  1811. (file-name-coding-system nnmail-pathname-coding-system))
  1812. (write-region start end filename append visit lockname)
  1813. (set-file-modes filename nnmail-default-file-modes)))
  1814. ;;;
  1815. ;;; Status functions
  1816. ;;;
  1817. (defun nnmail-replace-status (name value)
  1818. "Make status NAME and VALUE part of the current status line."
  1819. (save-restriction
  1820. (message-narrow-to-head)
  1821. (let ((status (nnmail-decode-status)))
  1822. (setq status (delq (member name status) status))
  1823. (when value
  1824. (push (cons name value) status))
  1825. (message-remove-header "status")
  1826. (goto-char (point-max))
  1827. (insert "Status: " (nnmail-encode-status status) "\n"))))
  1828. (defun nnmail-decode-status ()
  1829. "Return a status-value alist from STATUS."
  1830. (goto-char (point-min))
  1831. (when (re-search-forward "^Status: " nil t)
  1832. (let (name value status)
  1833. (save-restriction
  1834. ;; Narrow to the status.
  1835. (narrow-to-region
  1836. (point)
  1837. (if (re-search-forward "^[^ \t]" nil t)
  1838. (1- (point))
  1839. (point-max)))
  1840. ;; Go through all elements and add them to the list.
  1841. (goto-char (point-min))
  1842. (while (re-search-forward "[^ \t=]+" nil t)
  1843. (setq name (match-string 0))
  1844. (if (not (eq (char-after) ?=))
  1845. ;; Implied "yes".
  1846. (setq value "yes")
  1847. (forward-char 1)
  1848. (if (not (eq (char-after) ?\"))
  1849. (if (not (looking-at "[^ \t]"))
  1850. ;; Implied "no".
  1851. (setq value "no")
  1852. ;; Unquoted value.
  1853. (setq value (match-string 0))
  1854. (goto-char (match-end 0)))
  1855. ;; Quoted value.
  1856. (setq value (read (current-buffer)))))
  1857. (push (cons name value) status)))
  1858. status)))
  1859. (defun nnmail-encode-status (status)
  1860. "Return a status string from STATUS."
  1861. (mapconcat
  1862. (lambda (elem)
  1863. (concat
  1864. (car elem) "="
  1865. (if (string-match "[ \t]" (cdr elem))
  1866. (prin1-to-string (cdr elem))
  1867. (cdr elem))))
  1868. status " "))
  1869. (defun nnmail-split-history ()
  1870. "Generate an overview of where the last mail split put articles."
  1871. (interactive)
  1872. (unless nnmail-split-history
  1873. (error "No current split history"))
  1874. (with-output-to-temp-buffer "*nnmail split history*"
  1875. (with-current-buffer standard-output
  1876. (fundamental-mode)) ; for Emacs 20.4+
  1877. (dolist (elem nnmail-split-history)
  1878. (princ (mapconcat (lambda (ga)
  1879. (concat (car ga) ":" (int-to-string (cdr ga))))
  1880. elem
  1881. ", "))
  1882. (princ "\n"))))
  1883. (defun nnmail-purge-split-history (group)
  1884. "Remove all instances of GROUP from `nnmail-split-history'."
  1885. (let ((history nnmail-split-history))
  1886. (while history
  1887. (setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
  1888. (car history)))
  1889. (pop history))
  1890. (setq nnmail-split-history (delq nil nnmail-split-history))))
  1891. (defun nnmail-new-mail-p (group)
  1892. "Say whether GROUP has new mail."
  1893. (let ((his nnmail-split-history)
  1894. found)
  1895. (while his
  1896. (when (assoc group (pop his))
  1897. (setq found t
  1898. his nil)))
  1899. found))
  1900. (defun nnmail-within-headers-p ()
  1901. "Check to see if point is within the headers of a unix mail message.
  1902. Doesn't change point."
  1903. (let ((pos (point)))
  1904. (save-excursion
  1905. (and (nnmail-search-unix-mail-delim-backward)
  1906. (not (search-forward "\n\n" pos t))))))
  1907. (run-hooks 'nnmail-load-hook)
  1908. (provide 'nnmail)
  1909. ;;; nnmail.el ends here