nnmail.el 72 KB

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