nnmairix.el 73 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027
  1. ;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader
  2. ;; Copyright (C) 2007-2012 Free Software Foundation, Inc.
  3. ;; Author: David Engster <dengste@eml.cc>
  4. ;; Keywords: mail searching
  5. ;; Version: 0.6
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; This is a back end for using the mairix search engine with
  19. ;; Gnus. Mairix is a tool for searching words in locally stored
  20. ;; mail. Mairix is very fast which allows using it efficiently for
  21. ;; "smart folders", e.g. folders which are associated with search
  22. ;; queries. Of course, you can also use this back end just for
  23. ;; calling mairix with some search query.
  24. ;;
  25. ;; Mairix is written by Richard Curnow. More information can be found at
  26. ;; http://www.rpcurnow.force9.co.uk/mairix/
  27. ;; Commentary on the code: nnmairix sits between Gnus and the "real"
  28. ;; back end which handles the mail (currently nnml, nnimap and
  29. ;; nnmaildir were tested). I know this is all a bit hacky, but so far
  30. ;; it works for me. This is the first back end I've written for Gnus,
  31. ;; so I'd appreciate any comments, suggestions, bug reports (and, of
  32. ;; course, patches) for improving nnmairix.
  33. ;; nnmairix does not use an active file, since I wanted to contain the
  34. ;; back end "inside Gnus" as much as possible without the need of an
  35. ;; external file. It stores the query/folder information in the group
  36. ;; parameters instead. This also implies that once you kill a mairix
  37. ;; group, it's gone for good. I don't think that this is really
  38. ;; problematic, since I don't see the need in unsubscribing and
  39. ;; re-subscribing search groups
  40. ;; Every mairix server is "responsible" for one mairix installation,
  41. ;; i.e. you can have several mairix servers for different mairix
  42. ;; configurations. Not that I think anyone will actually do this, but
  43. ;; I thought it would be a "nice to have feature"...
  44. ;; KNOWN BUGS:
  45. ;; * Mairix does only support us-ascii characters.
  46. ;; TODO/MISSING FEATURES:
  47. ;; * Support of more back ends (nnmh, nnfolder, nnmbox...)?
  48. ;; * Maybe use an active file instead of group parameters?
  49. ;; * Maybe use "-a" when updating groups which are not newly created?
  50. ;;; Changelog:
  51. ;; 05/30/2008 - version 0.6
  52. ;;
  53. ;; * It is now possible to propagate marks from the nnmairix groups
  54. ;; to the original messages (and for maildir also vice versa). See
  55. ;; the docs for details on this feature - it's pretty delicate
  56. ;; and currently needs a patched mairix binary to work smoothly.
  57. ;;
  58. ;; * Keep messages in nnmairix groups always read/unread
  59. ;; (bound to 'G b r').
  60. ;;
  61. ;; * Recreate back end folder for nnmairix groups in case you
  62. ;; somehow get wrong article counts (bound to 'G b d').
  63. ;;
  64. ;; * New group parameter 'allow-fast'. Toggling of parameter bound
  65. ;; to 'G b a'. The default is nil, meaning that the group will
  66. ;; always be updated with a mairix search, even when only entered.
  67. ;;
  68. ;; * More/Better use of the registry (if available). Can now also
  69. ;; deal with duplicate messages in different groups.
  70. ;;
  71. ;; 02/06/2008 - version 0.5
  72. ;;
  73. ;; * New function: nnmairix-goto-original-article. Uses the
  74. ;; registry or the mail file path for determining original group.
  75. ;;
  76. ;; * Deal with empty Xref header
  77. ;;
  78. ;; * Changed summary mode keybindings since the old ones were
  79. ;; already taken
  80. ;;
  81. ;; (Thanks to Tassilo Horn and Ted Zlatanov for their help)
  82. ;;
  83. ;; 01/07/2008 - version 0.4
  84. ;;
  85. ;; * New/fixed doc strings and code cleanup.
  86. ;;
  87. ;; 11/18/2007 - version 0.3
  88. ;;
  89. ;; * Fixed bugs when dealing with nnml and native servers
  90. ;;
  91. ;; * Make variables customizable
  92. ;;
  93. ;; 10/10/2007 - version 0.2
  94. ;;
  95. ;; * Use nnml-directory/directory server variables for nnml and
  96. ;; nnmaildir back ends as path for search folders. This way it
  97. ;; becomes independent of 'base' setting in .mairixirc (but not for
  98. ;; nnimap).
  99. ;;
  100. ;; * As a result: Changed nnmairix-backend-to-server so that user
  101. ;; is asked when more than one nnmairix server exists and we do not
  102. ;; know which one is responsible for current back end.
  103. ;;
  104. ;; * Rename files when using nnml back ends so that there are no
  105. ;; holes in article numbers. This should fix all problems regarding
  106. ;; wrong article counts with nnml.
  107. ;;
  108. ;; * More commands for creating queries (using widgets or the
  109. ;; minibuffer).
  110. ;;
  111. ;; * Fixed bug in nnmairix-create-search-group-from-message
  112. ;;
  113. ;; * Changed copyright to FSF
  114. ;;
  115. ;; (Thanks to Georg C. F. Greve and Bastien for suggestions and
  116. ;; ideas!)
  117. ;;
  118. ;; 10/03/2007 - version 0.1 - first release
  119. ;;; Code:
  120. (eval-when-compile (require 'cl)) ;For (pop (cdr ogroup)).
  121. (require 'nnoo)
  122. (require 'gnus-group)
  123. (require 'gnus-sum)
  124. (require 'message)
  125. (require 'nnml)
  126. (require 'widget)
  127. (nnoo-declare nnmairix)
  128. ;;; === Keymaps
  129. (eval-when-compile
  130. (when (featurep 'xemacs)
  131. ;; The `kbd' macro requires that the `read-kbd-macro' macro is available.
  132. (require 'edmacro)))
  133. ;; Group mode
  134. (defun nnmairix-group-mode-hook ()
  135. "Nnmairix group mode keymap."
  136. (define-key gnus-group-mode-map
  137. (kbd "G b") (make-sparse-keymap))
  138. (define-key gnus-group-mode-map
  139. (kbd "G b g") 'nnmairix-create-search-group)
  140. (define-key gnus-group-mode-map
  141. (kbd "G b c") 'nnmairix-create-server-and-default-group)
  142. (define-key gnus-group-mode-map
  143. (kbd "G b q") 'nnmairix-group-change-query-this-group)
  144. (define-key gnus-group-mode-map
  145. (kbd "G b t") 'nnmairix-group-toggle-threads-this-group)
  146. (define-key gnus-group-mode-map
  147. (kbd "G b u") 'nnmairix-update-database)
  148. (define-key gnus-group-mode-map
  149. (kbd "G b s") 'nnmairix-search)
  150. (define-key gnus-group-mode-map
  151. (kbd "G b i") 'nnmairix-search-interactive)
  152. (define-key gnus-group-mode-map
  153. (kbd "G b m") 'nnmairix-widget-search)
  154. (define-key gnus-group-mode-map
  155. (kbd "G b p") 'nnmairix-group-toggle-propmarks-this-group)
  156. (define-key gnus-group-mode-map
  157. (kbd "G b r") 'nnmairix-group-toggle-readmarks-this-group)
  158. (define-key gnus-group-mode-map
  159. (kbd "G b d") 'nnmairix-group-delete-recreate-this-group)
  160. (define-key gnus-group-mode-map
  161. (kbd "G b a") 'nnmairix-group-toggle-allowfast-this-group)
  162. (define-key gnus-group-mode-map
  163. (kbd "G b o") 'nnmairix-propagate-marks))
  164. ;; Summary mode
  165. (defun nnmairix-summary-mode-hook ()
  166. "Nnmairix summary mode keymap."
  167. (define-key gnus-summary-mode-map
  168. (kbd "G G t") 'nnmairix-search-thread-this-article)
  169. (define-key gnus-summary-mode-map
  170. (kbd "G G f") 'nnmairix-search-from-this-article)
  171. (define-key gnus-summary-mode-map
  172. (kbd "G G m") 'nnmairix-widget-search-from-this-article)
  173. (define-key gnus-summary-mode-map
  174. (kbd "G G g") 'nnmairix-create-search-group-from-message)
  175. (define-key gnus-summary-mode-map
  176. (kbd "G G o") 'nnmairix-goto-original-article)
  177. (define-key gnus-summary-mode-map
  178. (kbd "G G u") 'nnmairix-remove-tick-mark-original-article))
  179. (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
  180. (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)
  181. ;; ;;;###autoload
  182. ;; (defun nnmairix-initialize (&optional force)
  183. ;; (interactive "P")
  184. ;; (if (not (or (file-readable-p "~/.mairixrc")
  185. ;; force))
  186. ;; (message "No file `~/.mairixrc', skipping nnmairix setup")
  187. ;; (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook)
  188. ;; (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook)))
  189. ;; Customizable stuff
  190. (defgroup nnmairix nil
  191. "Back end for the Mairix mail search engine."
  192. :group 'gnus)
  193. (defcustom nnmairix-group-prefix "zz_mairix"
  194. "Prefix for mairix search groups on back end server.
  195. nnmairix will create these groups automatically on the back end
  196. server for each nnmairix search group. The name on the back end
  197. server will be this prefix plus a random number. You can delete
  198. unused nnmairix groups on the back end using
  199. `nnmairix-purge-old-groups'."
  200. :version "23.1"
  201. :type 'string
  202. :group 'nnmairix)
  203. (defcustom nnmairix-mairix-output-buffer "*mairix output*"
  204. "Buffer used for mairix output."
  205. :version "23.1"
  206. :type 'string
  207. :group 'nnmairix)
  208. (defcustom nnmairix-customize-query-buffer "*mairix query*"
  209. "Name of the buffer for customizing Mairix queries."
  210. :version "23.1"
  211. :type 'string
  212. :group 'nnmairix)
  213. (defcustom nnmairix-mairix-update-options '("-F" "-Q")
  214. "Options when calling mairix for updating the database.
  215. The default is '-F' and '-Q' for making updates faster. You
  216. should call mairix without these options from time to
  217. time (e.g. via cron job)."
  218. :version "23.1"
  219. :type '(repeat string)
  220. :group 'nnmairix)
  221. (defcustom nnmairix-mairix-search-options '("-Q")
  222. "Options when calling mairix for searching.
  223. The default is '-Q' for making searching faster."
  224. :version "23.1"
  225. :type '(repeat string)
  226. :group 'nnmairix)
  227. (defcustom nnmairix-mairix-synchronous-update nil
  228. "Set this to t if you want Emacs to wait for mairix updating the database."
  229. :version "23.1"
  230. :type 'boolean
  231. :group 'nnmairix)
  232. (defcustom nnmairix-rename-files-for-nnml t
  233. "Rename nnml mail files so that they are consecutively numbered.
  234. When using nnml as back end, mairix might produce holes in the
  235. article numbers which will produce wrong article counts by
  236. Gnus. This option controls whether nnmairix should rename the
  237. files consecutively."
  238. :version "23.1"
  239. :type 'boolean
  240. :group 'nnmairix)
  241. (defcustom nnmairix-widget-fields-list
  242. '(("from" "f" "From") ("to" "t" "To") ("cc" "c" "Cc")
  243. ("subject" "s" "Subject") ("to" "tc" "To or Cc")
  244. ("from" "a" "Address") (nil "b" "Body") (nil "n" "Attachment")
  245. ("Message-ID" "m" "Message ID") (nil "s" "Size") (nil "d" "Date"))
  246. "Fields that should be editable during interactive query customization.
  247. Header, corresponding mairix command and description for editable
  248. fields in interactive query customization. The header specifies
  249. which header contents should be inserted into the editable field
  250. when creating a Mairix query based on the current message (can be
  251. nil for disabling this)."
  252. :version "23.1"
  253. :type '(repeat (list
  254. (choice :tag "Field"
  255. (const :tag "none" nil)
  256. (const :tag "From" "from")
  257. (const :tag "To" "to")
  258. (const :tag "Cc" "cc")
  259. (const :tag "Subject" "subject")
  260. (const :tag "Message ID" "Message-ID"))
  261. (string :tag "Command")
  262. (string :tag "Description")))
  263. :group 'nnmairix)
  264. (defcustom nnmairix-widget-select-window-function
  265. (lambda () (select-window (get-largest-window)))
  266. "Function for selecting the window for customizing the mairix query.
  267. The default chooses the largest window in the current frame."
  268. :version "23.1"
  269. :type 'function
  270. :group 'nnmairix)
  271. (defcustom nnmairix-propagate-marks-upon-close t
  272. "Flag if marks should be propagated upon closing a group.
  273. The default of this variable is t. If set to 'ask, the
  274. user will be asked if the flags should be propagated when the
  275. group is closed. If set to nil, the user will have to manually
  276. call 'nnmairix-propagate-marks'."
  277. :version "23.1"
  278. :type '(choice (const :tag "always" t)
  279. (const :tag "ask" 'ask)
  280. (const :tag "never" nil))
  281. :group 'nnmairix)
  282. (defcustom nnmairix-propagate-marks-to-nnmairix-groups nil
  283. "Flag if marks from original articles should be seen in nnmairix groups.
  284. The default is nil since it will only work if the articles are in
  285. maildir format and NOT managed by the nnmaildir back end but
  286. e.g. an IMAP server (which stores the marks in the maildir file
  287. name). You may safely set this to t for testing - the worst that
  288. can happen are wrong marks in nnmairix groups."
  289. :version "23.1"
  290. :type 'boolean
  291. :group 'nnmairix)
  292. (defcustom nnmairix-only-use-registry nil
  293. "Use only the registry for determining original group(s).
  294. If set to t, nnmairix will only use the registry for determining
  295. the original group(s) of an article (which is also necessary for
  296. propagating marks). If set to nil, it will also try to determine
  297. the group from an additional mairix search which might be slow
  298. when propagating lots of marks."
  299. :version "23.1"
  300. :type 'boolean
  301. :group 'nnmairix)
  302. (defcustom nnmairix-allowfast-default nil
  303. "Whether fast entering should be the default for nnmairix groups.
  304. You may set this to t to make entering the group faster, but note that
  305. this might lead to problems, especially when used with marks propagation."
  306. :version "23.1"
  307. :type 'boolean
  308. :group 'nnmairix)
  309. ;; ==== Other variables
  310. (defvar nnmairix-widget-other
  311. '(threads flags)
  312. "Other editable mairix commands when using customization widgets.
  313. Currently there are 'threads and 'flags.")
  314. (defvar nnmairix-interactive-query-parameters
  315. '((?f "from" "f" "From") (?t "to" "t" "To") (?c "to" "tc" "To or Cc")
  316. (?a "from" "a" "Address") (?s "subject" "s" "Subject") (?b nil "b" "Body")
  317. (?d nil "d" "Date") (?n nil "n" "Attachment"))
  318. "Things that should be editable during interactive query generation.
  319. Every list element consists of the following entries: Keystroke,
  320. message field (if any), mairix command and description.")
  321. (defvar nnmairix-delete-and-create-on-change '(nnimap nnmaildir nnml)
  322. "Controls on which back ends groups should be deleted and re-created.
  323. This variable is a list of back ends where the search group
  324. should be completely deleted and re-created when the query or
  325. thread parameter changes. The default is to this for all
  326. currently supported back ends. It usually also corrects the
  327. problem of \"holes\" in the article numbers which often lead to a
  328. wrong count of total articles shown by Gnus.")
  329. ;;; === Server variables
  330. (defvoo nnmairix-backend nil
  331. "Back end where mairix stores its searches.")
  332. (defvoo nnmairix-backend-server nil
  333. "Name of the server where mairix stores its searches.")
  334. (defvoo nnmairix-mairix-command "mairix"
  335. "Command to call mairix for this nnmairix server.")
  336. (defvoo nnmairix-hidden-folders nil
  337. "Set this to t if the back end server uses hidden directories for
  338. its maildir mail folders (e.g. the Dovecot IMAP server or mutt).")
  339. (defvoo nnmairix-default-group nil
  340. "Default search group. This is the group which is used for all
  341. temporary searches, e.g. nnmairix-search.")
  342. ;;; === Internal variables
  343. (defconst nnmairix-group-regexp
  344. (format "%s-\\(.*\\)-[0-9]+" nnmairix-group-prefix)
  345. "Regexp for mairix groups on back end.")
  346. (defconst nnmairix-valid-backends '(nnimap nnml nnmaildir)
  347. "Back ends supported by nnmairix.
  348. Other back ends might or might not work.")
  349. (defvar nnmairix-last-server nil
  350. "Last chosen server.")
  351. (defvar nnmairix-current-server nil
  352. "Current server.")
  353. (defvar nnmairix-marks-cache nil
  354. "Cache for marks which should be set upon closing current group.")
  355. (defvar nnmairix-version-output nil
  356. "Version string of mairix binary.")
  357. ;;; === Gnus back end functions
  358. (nnoo-define-basics nnmairix)
  359. (gnus-declare-backend "nnmairix" 'mail 'address)
  360. (deffoo nnmairix-open-server (server &optional definitions)
  361. ;; just set server variables
  362. (setq nnmairix-current-server server)
  363. (nnoo-change-server 'nnmairix server definitions))
  364. (deffoo nnmairix-request-group (group &optional server fast info)
  365. ;; Call mairix and request group on back end server
  366. (when server (nnmairix-open-server server))
  367. (let* ((qualgroup (if server
  368. (gnus-group-prefixed-name group (list 'nnmairix server))
  369. group))
  370. (folder (gnus-group-get-parameter qualgroup 'folder))
  371. (allowfast (gnus-group-get-parameter qualgroup 'allow-fast))
  372. (query (gnus-group-get-parameter qualgroup 'query t))
  373. (threads (gnus-group-get-parameter qualgroup 'threads))
  374. (backendmethod (gnus-server-to-method
  375. (format "%s:%s" (symbol-name nnmairix-backend)
  376. nnmairix-backend-server)))
  377. rval mfolder folderpath args)
  378. (cond
  379. ((not folder)
  380. ;; No folder parameter -> error
  381. (nnheader-report 'nnmairix "Check folder parameter for group %s" group)
  382. nil)
  383. ((not query)
  384. ;; No query -> return empty group
  385. (with-current-buffer nntp-server-buffer
  386. (erase-buffer)
  387. (insert (concat "211 0 1 0 " group))
  388. t))
  389. (t
  390. ;; For maildir++ folders: create a hidden directory (prepend dot)
  391. (setq mfolder (if (and nnmairix-hidden-folders
  392. (not (string-match "^\\." folder)))
  393. (concat "." folder)
  394. folder))
  395. ;; For nnml and nnmaildir, precede mfolder with directory where mail
  396. ;; is actually stored so that it's independent of 'base' setting
  397. ;; in .mairixrc.
  398. (when (eq nnmairix-backend 'nnml)
  399. (setq folderpath (cadr (assoc 'nnml-directory backendmethod)))
  400. ;; if nnml-directory is not explicitly set, use global value
  401. (when (not folderpath)
  402. (setq folderpath nnml-directory)))
  403. (when (eq nnmairix-backend 'nnmaildir)
  404. (setq folderpath
  405. (cadr (assoc 'directory backendmethod))))
  406. (when folderpath
  407. (setq mfolder
  408. (concat
  409. (file-name-as-directory
  410. (expand-file-name
  411. folderpath))
  412. mfolder)))
  413. ;; If (not fast), call Mairix binary
  414. ;; recreate underlying folder on the back end
  415. (setq rval
  416. (if (and fast allowfast)
  417. 0
  418. (nnmairix-call-mairix-binary
  419. (split-string nnmairix-mairix-command)
  420. mfolder query threads)))
  421. ;; Check return value
  422. (cond
  423. ((zerop rval) ; call was successful
  424. (nnmairix-call-backend
  425. "open-server" nnmairix-backend-server)
  426. ;; If we're dealing with nnml, rename files
  427. ;; consecutively and make new active file for this
  428. ;; group
  429. (when (eq nnmairix-backend 'nnml)
  430. (when nnmairix-rename-files-for-nnml
  431. (nnmairix-rename-files-consecutively mfolder))
  432. (nnml-generate-nov-databases-directory mfolder nil t))
  433. (nnmairix-call-backend
  434. "request-scan" folder nnmairix-backend-server)
  435. (if (and fast allowfast)
  436. t
  437. (nnmairix-request-group-with-article-number-correction
  438. folder qualgroup)))
  439. ((and (= rval 1)
  440. (with-current-buffer nnmairix-mairix-output-buffer
  441. (goto-char (point-min))
  442. (looking-at "^Matched 0 messages")))
  443. ;; No messages found -> return empty group
  444. (nnheader-message 5 "Mairix: No matches found.")
  445. (set-buffer nntp-server-buffer)
  446. (erase-buffer)
  447. (insert (concat "211 0 1 0 " group))
  448. t)
  449. ;; Everything else is an error
  450. (t
  451. (nnheader-report
  452. 'nnmairix "Error running mairix. See buffer %s for details"
  453. nnmairix-mairix-output-buffer)
  454. nil))))))
  455. (deffoo nnmairix-request-create-group (group &optional server args)
  456. (let ((qualgroup (if server (gnus-group-prefixed-name group (list 'nnmairix server))
  457. group))
  458. (exist t)
  459. (count 0)
  460. groupname info)
  461. (when server (nnmairix-open-server server))
  462. (gnus-group-add-parameter qualgroup '(query . nil))
  463. (gnus-group-add-parameter qualgroup '(threads . nil))
  464. (while exist
  465. (setq count (1+ count))
  466. (setq groupname (format "%s-%s-%s" nnmairix-group-prefix group
  467. (number-to-string count)))
  468. (setq exist (nnmairix-call-backend
  469. "request-group" groupname nnmairix-backend-server)))
  470. (nnmairix-call-backend
  471. "request-create-group" groupname nnmairix-backend-server)
  472. (gnus-group-add-parameter qualgroup '(folder . nil))
  473. (when nnmairix-allowfast-default
  474. (gnus-group-add-parameter qualgroup '(allow-fast . t)))
  475. (gnus-group-set-parameter qualgroup 'folder groupname))
  476. t)
  477. (deffoo nnmairix-retrieve-headers (articles group &optional server fetch-old)
  478. (when server (nnmairix-open-server server))
  479. (let* ((folder (nnmairix-get-backend-folder group server))
  480. (corr (nnmairix-get-numcorr group server))
  481. (numcorr 0)
  482. rval)
  483. (when (and corr
  484. (not (zerop (cadr corr)))
  485. (numberp (car articles)))
  486. (setq numcorr (cadr corr))
  487. (setq articles
  488. (mapcar
  489. (lambda (arg) (- arg numcorr))
  490. articles)))
  491. (setq rval
  492. (if (eq nnmairix-backend 'nnimap)
  493. (let ((gnus-nov-is-evil t))
  494. (nnmairix-call-backend
  495. "retrieve-headers" articles folder nnmairix-backend-server fetch-old))
  496. (nnmairix-call-backend
  497. "retrieve-headers" articles folder nnmairix-backend-server fetch-old)))
  498. (nnmairix-replace-group-and-numbers articles folder group numcorr rval)
  499. rval))
  500. (deffoo nnmairix-request-article (article &optional group server to-buffer)
  501. (when server (nnmairix-open-server server))
  502. (let ((folder (nnmairix-get-backend-folder group server))
  503. (corr (nnmairix-get-numcorr group server)))
  504. (when (and
  505. (numberp article)
  506. corr
  507. (not (zerop (cadr corr))))
  508. (setq article (- article (cadr corr))))
  509. (nnmairix-call-backend
  510. "request-article" article folder nnmairix-backend-server to-buffer))
  511. t)
  512. (deffoo nnmairix-request-list (&optional server)
  513. (when server (nnmairix-open-server server))
  514. (if (nnmairix-call-backend "request-list" nnmairix-backend-server)
  515. (let (cpoint cur qualgroup folder)
  516. (with-current-buffer nntp-server-buffer
  517. (goto-char (point-min))
  518. (setq cpoint (point))
  519. (while (re-search-forward nnmairix-group-regexp (point-max) t)
  520. (setq cur (match-string 1)
  521. qualgroup (gnus-group-prefixed-name cur
  522. (list 'nnmairix server)))
  523. (if (and (gnus-group-entry qualgroup)
  524. (string= (match-string 0)
  525. (gnus-group-get-parameter qualgroup 'folder)))
  526. (progn
  527. (replace-match cur)
  528. (delete-region cpoint (point-at-bol))
  529. (forward-line)
  530. (setq cpoint (point)))
  531. (forward-line)))
  532. (delete-region cpoint (point-max)))
  533. t)
  534. nil))
  535. ;; Silence byte-compiler.
  536. (autoload 'gnus-registry-get-id-key "gnus-registry")
  537. (deffoo nnmairix-request-set-mark (group actions &optional server)
  538. (when server
  539. (nnmairix-open-server server))
  540. (let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server)))
  541. (propmarks (gnus-group-get-parameter qualgroup 'propmarks))
  542. (propto (gnus-group-get-parameter qualgroup 'propto t))
  543. (corr (nnmairix-get-numcorr group server))
  544. (folder (nnmairix-get-backend-folder group server)))
  545. (save-excursion
  546. (dolist (cur actions)
  547. (let ((type (nth 1 cur))
  548. (cmdmarks (nth 2 cur))
  549. (range (gnus-uncompress-range (nth 0 cur)))
  550. mid ogroup number method temp)
  551. (when (and corr
  552. (not (zerop (cadr corr))))
  553. (setq range (mapcar (lambda (arg)
  554. (- arg (cadr corr)))
  555. range)))
  556. (when propmarks
  557. (nnheader-message 7 "nnmairix: Setting marks...")
  558. (dolist (article range)
  559. ;; get article (header) and extract message id
  560. ;; we try to determine as many original articles as possible
  561. (catch 'problem
  562. (nnmairix-call-backend "open-server" nnmairix-backend-server)
  563. (unless (gnus-request-head
  564. article
  565. (gnus-group-prefixed-name
  566. folder
  567. (list nnmairix-backend nnmairix-backend-server)))
  568. (nnheader-message
  569. 3 "Unable to set mark: couldn't fetch article header for article number %d"
  570. article)
  571. (throw 'problem nil))
  572. (set-buffer nntp-server-buffer)
  573. (goto-char (point-min))
  574. (let ((case-fold-search t))
  575. (re-search-forward "^message-id:.*\\(<.+>\\)" nil t))
  576. (setq mid (match-string 1))
  577. (unless mid
  578. (nnheader-message
  579. 3 "Unable to set mark: article number %d has no message-id header"
  580. article)
  581. (throw 'problem nil))
  582. ;; get original group. First try registry, then file path
  583. (setq ogroup
  584. (nnmairix-determine-original-group-from-registry mid))
  585. (unless (or ogroup
  586. nnmairix-only-use-registry)
  587. (setq ogroup
  588. (nnmairix-determine-original-group-from-path
  589. mid nnmairix-current-server)))
  590. (unless ogroup
  591. (nnheader-message
  592. 3 "Unable to set mark: couldn't find original group for %s" mid)
  593. (throw 'problem nil))
  594. ;; store original groups with mid's. We cannot get
  595. ;; the article number immediately since this would
  596. ;; generate problems with maildir (articles might
  597. ;; get moved from /new to /cur and further marks
  598. ;; could then not be set)
  599. (dolist (cur ogroup)
  600. (setq temp (assoc cur
  601. nnmairix-marks-cache))
  602. (if temp
  603. (nconc temp (list (list mid type cmdmarks)))
  604. (push (list cur (list mid type cmdmarks))
  605. nnmairix-marks-cache)))))
  606. (nnheader-message 7 "nnmairix: Setting marks... done")))))))
  607. (deffoo nnmairix-close-group (group &optional server)
  608. (when server
  609. (nnmairix-open-server server))
  610. (let* ((qualgroup (gnus-group-prefixed-name group (list 'nnmairix nnmairix-current-server)))
  611. (propmarks (gnus-group-get-parameter qualgroup 'propmarks))
  612. method)
  613. (when (and propmarks
  614. nnmairix-marks-cache)
  615. (when (or (eq nnmairix-propagate-marks-upon-close t)
  616. (and (eq nnmairix-propagate-marks-upon-close 'ask)
  617. (y-or-n-p "Propagate marks to original articles? ")))
  618. (with-current-buffer gnus-group-buffer
  619. (nnmairix-propagate-marks)
  620. ;; update mairix group
  621. (gnus-group-jump-to-group qualgroup)
  622. (gnus-group-get-new-news-this-group))))))
  623. (autoload 'nnimap-request-update-info-internal "nnimap")
  624. (deffoo nnmairix-request-marks (group info &optional server)
  625. ;; propagate info from underlying IMAP folder to nnmairix group
  626. ;; This is currently experimental and must be explicitly activated
  627. ;; with nnmairix-propagate-marks-to-nnmairix-group
  628. (when server
  629. (nnmairix-open-server server))
  630. (let* ((qualgroup (gnus-group-prefixed-name
  631. group
  632. (list 'nnmairix nnmairix-current-server)))
  633. (readmarks (gnus-group-get-parameter qualgroup 'readmarks))
  634. (propmarks (gnus-group-get-parameter qualgroup 'propmarks))
  635. (folder (nnmairix-get-backend-folder group server))
  636. (corr (nnmairix-get-numcorr group server))
  637. (docorr (and corr (not (zerop (cadr corr)))))
  638. (folderinfo `(,group 1 ((1 . 1))))
  639. readrange marks)
  640. (when (and propmarks
  641. nnmairix-propagate-marks-to-nnmairix-groups)
  642. ;; these groups are not subscribed, so we have to ask the back end directly
  643. (if (eq nnmairix-backend 'nnimap)
  644. (nnimap-request-update-info-internal folder folderinfo nnmairix-backend-server)
  645. (nnmairix-call-backend "request-update-info" folder folderinfo nnmairix-backend-server))
  646. ;; set range of read articles
  647. (gnus-info-set-read
  648. info
  649. (if docorr
  650. (nnmairix-map-range
  651. `(lambda (x) (+ x ,(cadr corr)))
  652. (gnus-info-read folderinfo))
  653. (gnus-info-read folderinfo)))
  654. ;; set other marks
  655. (gnus-info-set-marks
  656. info
  657. (if docorr
  658. (mapcar (lambda (cur)
  659. (cons
  660. (car cur)
  661. (nnmairix-map-range
  662. `(lambda (x) (+ x ,(cadr corr)))
  663. (list (cadr cur)))))
  664. (gnus-info-marks folderinfo))
  665. (gnus-info-marks folderinfo))))
  666. (when (eq readmarks 'unread)
  667. (gnus-info-set-read info nil))
  668. (when (eq readmarks 'read)
  669. (gnus-info-set-read info (gnus-active qualgroup))))
  670. t)
  671. (nnoo-define-skeleton nnmairix)
  672. ;;; === Interactive functions
  673. (defun nnmairix-create-search-group (server group query threads)
  674. "Create on SERVER nnmairix search group GROUP with QUERY.
  675. If THREADS is t, include whole threads from found messages. If
  676. called interactively, user will be asked for parameters."
  677. (interactive
  678. (list
  679. (gnus-server-to-method (car (nnmairix-get-server)))
  680. (read-string "Group name: ")
  681. (read-string "Query: ")
  682. (y-or-n-p "Include threads? ")))
  683. (when (and (stringp query)
  684. (string-match "\\s-" query))
  685. (setq query (split-string query)))
  686. (when (not (listp query))
  687. (setq query (list query)))
  688. (when (and server group query)
  689. (save-excursion
  690. (let ((groupname (gnus-group-prefixed-name group server))
  691. info)
  692. (set-buffer gnus-group-buffer)
  693. (gnus-group-make-group group server)
  694. (gnus-group-set-parameter groupname 'query query)
  695. (gnus-group-set-parameter groupname 'threads threads)
  696. (nnmairix-update-and-clear-marks groupname)))))
  697. (defun nnmairix-search-interactive ()
  698. "Create mairix search interactively with the minibuffer."
  699. (interactive)
  700. (let ((char-header nnmairix-interactive-query-parameters)
  701. header finished query achar)
  702. (while (not finished)
  703. (while (not achar)
  704. (message "Query (%s): " (nnmairix-create-message-line-for-search))
  705. (setq achar (read-char))
  706. (when (not (assoc achar char-header))
  707. (setq achar nil)))
  708. (setq header (read-string
  709. (concat "Match " (nth 3 (assoc achar char-header)) " on: ")))
  710. (push (concat (nth 2 (assoc achar char-header)) ":" header) query)
  711. (setq finished (not (y-or-n-p "Add another search query? "))
  712. achar nil))
  713. (nnmairix-search
  714. (mapconcat 'identity query " ")
  715. (car (nnmairix-get-server))
  716. (y-or-n-p "Include whole threads? "))))
  717. (defun nnmairix-create-search-group-from-message ()
  718. "Interactively create search group with query based on current message."
  719. (interactive)
  720. (let ((char-header nnmairix-interactive-query-parameters)
  721. (server (nnmairix-backend-to-server gnus-current-select-method))
  722. query achar header finished group threads cq)
  723. (when (or (not (gnus-buffer-live-p gnus-article-buffer))
  724. (not (gnus-buffer-live-p gnus-summary-buffer)))
  725. (error "No article or summary buffer"))
  726. (when (not server)
  727. (error "No nnmairix server found for back end %s:%s"
  728. (symbol-name (car gnus-current-select-method))
  729. (nth 1 gnus-current-select-method)))
  730. (while (not finished)
  731. (save-excursion
  732. (gnus-summary-toggle-header 1)
  733. (while (not achar)
  734. (message "Query (%s): " (nnmairix-create-message-line-for-search))
  735. (setq achar (read-char))
  736. (when (not (assoc achar char-header))
  737. (setq achar nil)))
  738. (set-buffer gnus-article-buffer)
  739. (setq header nil)
  740. (when (setq cq (nth 1 (assoc achar char-header)))
  741. (setq header
  742. (nnmairix-replace-illegal-chars
  743. (gnus-fetch-field (nth 1 (assoc achar char-header))))))
  744. (setq header (read-string
  745. (concat "Match " (nth 3 (assoc achar char-header)) " on: ")
  746. header))
  747. (push (concat (nth 2 (assoc achar char-header)) ":" header) query)
  748. (setq finished (not (y-or-n-p "Add another search query? "))
  749. achar nil)))
  750. (setq threads (y-or-n-p "Include whole threads? "))
  751. (setq group (read-string "Group name: "))
  752. (set-buffer gnus-summary-buffer)
  753. (message "Creating group %s on server %s with query %s." group
  754. (gnus-method-to-server server) (mapconcat 'identity query " "))
  755. (nnmairix-create-search-group server group query threads)))
  756. (defun nnmairix-create-server-and-default-group ()
  757. "Interactively create new nnmairix server with default search group.
  758. All necessary information will be queried from the user."
  759. (interactive)
  760. (let* ((name (read-string "Name of the mairix server: "))
  761. (server (gnus-completing-read "Back end server"
  762. (nnmairix-get-valid-servers) t))
  763. (mairix (read-string "Command to call mairix: " "mairix"))
  764. (defaultgroup (read-string "Default search group: "))
  765. (backend (symbol-name (car (gnus-server-to-method server))))
  766. (servername (nth 1 (gnus-server-to-method server)))
  767. (hidden (and (string-match "^nn\\(imap\\|maildir\\)$" backend)
  768. (y-or-n-p
  769. "Does the back end server work with maildir++ (i.e. hidden directories)? ")))
  770. create)
  771. (apply (intern (format "%s-%s" backend "open-server"))
  772. (list servername))
  773. (when (and hidden
  774. (string-match "^\\." defaultgroup))
  775. (setq defaultgroup (substring defaultgroup 1)))
  776. ;; Create default search group
  777. (gnus-group-make-group
  778. defaultgroup (list 'nnmairix name (list 'nnmairix-backend (intern backend))
  779. (list 'nnmairix-backend-server servername)
  780. (list 'nnmairix-mairix-command mairix)
  781. (list 'nnmairix-hidden-folders hidden)
  782. (list 'nnmairix-default-group defaultgroup)))))
  783. (defun nnmairix-group-change-query-this-group (&optional query)
  784. "Set QUERY for group under cursor."
  785. (interactive)
  786. (let* ((group (gnus-group-group-name))
  787. (method (gnus-find-method-for-group group))
  788. (oldquery (gnus-group-get-parameter group 'query t)))
  789. (if (eq (car method) 'nnmairix)
  790. (progn
  791. (when (listp oldquery)
  792. (setq oldquery (mapconcat 'identity oldquery " ")))
  793. (setq query (or query
  794. (read-string "New query: " oldquery)))
  795. (when (stringp query)
  796. (setq query (split-string query)))
  797. (when query
  798. (gnus-group-set-parameter group 'query query)
  799. (nnmairix-update-and-clear-marks group)))
  800. (error "This is no nnmairix group"))))
  801. (defun nnmairix-group-toggle-threads-this-group (&optional threads)
  802. "Toggle threads parameter for this group.
  803. If THREADS is a positive number, set threads parameter to t.
  804. If THREADS is a negative number, set it to nil."
  805. (interactive)
  806. (let ((group (gnus-group-group-name)))
  807. (when (nnmairix-group-toggle-parameter
  808. group 'threads "Threads" threads)
  809. (nnmairix-update-and-clear-marks group))))
  810. (defun nnmairix-group-toggle-propmarks-this-group (&optional propmarks)
  811. "Toggle marks propagation for this group.
  812. If PROPMARKS is a positive number, set parameter to t.
  813. If PROPMARKS is a negative number, set it to nil."
  814. (interactive)
  815. (unless (nnmairix-check-mairix-version "maildirpatch")
  816. (error "You need a mairix binary with maildir patch to use this feature. See docs for details"))
  817. (let ((group (gnus-group-group-name)))
  818. (when (or (not (string= (gnus-group-short-name group)
  819. (cadr (assoc 'nnmairix-default-group
  820. (gnus-find-method-for-group group)))))
  821. (y-or-n-p "You should not activate marks propagation for the default \
  822. search group. Are you sure? "))
  823. (nnmairix-group-toggle-parameter
  824. group 'propmarks "Marks propagation" propmarks))))
  825. (defun nnmairix-group-toggle-allowfast-this-group (&optional allowfast)
  826. "Toggle fast entering for this group.
  827. If ALLOWFAST is a positive number, set parameter to t.
  828. If ALLOWFAST is a negative number, set it to nil."
  829. (interactive)
  830. (nnmairix-group-toggle-parameter
  831. (gnus-group-group-name) 'allow-fast "Fast entering" allowfast))
  832. (defun nnmairix-group-toggle-readmarks-this-group (&optional readmarks)
  833. "Toggle read/unread marks for this group.
  834. If READMARKS is a positive number, articles will always be read.
  835. If READMARKS is a negative number, articles will always be unread.
  836. If READMARKS is t or zero, marks will stay unchanged."
  837. (interactive)
  838. (let* ((group (gnus-group-group-name))
  839. (method (gnus-find-method-for-group group))
  840. (readmarks (or readmarks
  841. (gnus-group-get-parameter group 'readmarks))))
  842. (if (eq (car method) 'nnmairix)
  843. (cond
  844. ((or (and (numberp readmarks) (< readmarks 0))
  845. (eq readmarks 'read))
  846. (gnus-group-set-parameter group 'readmarks 'unread)
  847. (nnheader-message 3 "Articles in %s always unread." group))
  848. ((or (and (numberp readmarks) (> readmarks 0))
  849. (not readmarks))
  850. (gnus-group-set-parameter group 'readmarks 'read)
  851. (nnheader-message 3 "Articles in %s always read." group))
  852. (t
  853. (gnus-group-set-parameter group 'readmarks nil)
  854. (nnheader-message 3 "Read marks in %s stay unchanged." group)))
  855. (error "This is no nnmairix group"))))
  856. (defun nnmairix-search (query &optional server threads)
  857. "Sends QUERY to nnmairix backend SERVER, using default its search group.
  858. Default search group is automatically entered and results are shown.
  859. If THREADS is t, enable threads.
  860. If THREADS is a negative number, disable threads.
  861. Otherwise, leave threads parameter as it is."
  862. (interactive (list (read-string "Query: ")))
  863. (when (not server)
  864. (setq server (car (nnmairix-get-server))))
  865. (if (not server)
  866. (error "No opened nnmairix server found")
  867. (setq server (gnus-server-to-method server)))
  868. (nnmairix-open-server (nth 1 server))
  869. (let* ((qualgroup (gnus-group-prefixed-name nnmairix-default-group
  870. (list 'nnmairix (nth 1 server)))))
  871. (set-buffer gnus-group-buffer)
  872. (when (stringp query)
  873. (setq query (split-string query)))
  874. (gnus-group-set-parameter qualgroup 'query query)
  875. (if (symbolp threads)
  876. (when (eq threads 't)
  877. (gnus-group-set-parameter qualgroup 'threads t))
  878. (when (< threads 0)
  879. (gnus-group-set-parameter qualgroup 'threads nil)))
  880. (nnmairix-update-and-clear-marks qualgroup)
  881. (unless (equal (gnus-active qualgroup) '(1 . 0))
  882. (gnus-group-read-group nil t qualgroup))))
  883. (defun nnmairix-search-thread-this-article ()
  884. "Search thread for the current article.
  885. This is effectively a shortcut for calling `nnmairix-search'
  886. with m:msgid of the current article and enabled threads."
  887. (interactive)
  888. (let* ((server
  889. (nnmairix-backend-to-server gnus-current-select-method))
  890. mid)
  891. (if server
  892. (if (gnus-buffer-live-p gnus-article-buffer)
  893. (progn
  894. (with-current-buffer gnus-article-buffer
  895. (gnus-summary-toggle-header 1)
  896. (setq mid (message-fetch-field "Message-ID")))
  897. (while (string-match "[<>]" mid)
  898. (setq mid (replace-match "" t t mid)))
  899. (nnmairix-search (concat "m:" mid) server t))
  900. (message "No article buffer."))
  901. (error "No nnmairix server found for back end %s:%s"
  902. (symbol-name (car gnus-current-select-method))
  903. (nth 1 gnus-current-select-method)))))
  904. (defun nnmairix-search-from-this-article ()
  905. "Search messages from sender of the current article.
  906. This is effectively a shortcut for calling `nnmairix-search' with
  907. f:current_from."
  908. (interactive)
  909. (let* ((server
  910. (nnmairix-backend-to-server gnus-current-select-method))
  911. from)
  912. (if server
  913. (if (gnus-buffer-live-p gnus-article-buffer)
  914. (progn
  915. (with-current-buffer gnus-article-buffer
  916. (gnus-summary-toggle-header 1)
  917. (setq from (cadr (gnus-extract-address-components
  918. (gnus-fetch-field "From"))))
  919. (nnmairix-search (concat "f:" from) server -1)))
  920. (message "No article buffer."))
  921. (error "No nnmairix server found for back end %s:%s"
  922. (symbol-name (car gnus-current-select-method))
  923. (nth 1 gnus-current-select-method)))))
  924. (defun nnmairix-purge-old-groups (&optional dontask server)
  925. "Delete mairix search groups which are no longer used.
  926. You may want to call this from time to time if you are creating
  927. and deleting lots of nnmairix groups. If DONTASK is t, do not ask
  928. before deleting a group on the back end. SERVER specifies nnmairix server."
  929. (interactive)
  930. (let ((server (or server
  931. (gnus-server-to-method (car (nnmairix-get-server))))))
  932. (if (nnmairix-open-server (nth 1 server))
  933. (when (nnmairix-call-backend
  934. "request-list" nnmairix-backend-server)
  935. (let (cur qualgroup folder)
  936. (with-current-buffer nntp-server-buffer
  937. (goto-char (point-min))
  938. (while (re-search-forward nnmairix-group-regexp (point-max) t)
  939. (setq cur (match-string 0)
  940. qualgroup (gnus-group-prefixed-name
  941. (match-string 1) server))
  942. (when (not (and (gnus-group-entry qualgroup)
  943. (string= cur
  944. (gnus-group-get-parameter
  945. qualgroup 'folder))))
  946. (when (or dontask
  947. (y-or-n-p
  948. (concat "Delete group " cur
  949. " on server " nnmairix-backend-server "? ")))
  950. (nnmairix-call-backend
  951. "request-delete-group" cur t nnmairix-backend-server)))))))
  952. (message "Couldn't open server %s" (nth 1 server)))))
  953. (defun nnmairix-update-database (&optional servers)
  954. "Call mairix for updating the database for SERVERS.
  955. If SERVERS is nil, do update for all nnmairix servers. Mairix
  956. will be called asynchronously unless
  957. `nnmairix-mairix-synchronous-update' is t. Mairix will be called
  958. with `nnmairix-mairix-update-options'."
  959. (interactive)
  960. (let ((servers (or servers
  961. (nnmairix-get-nnmairix-servers)))
  962. args cur commandsplit)
  963. (while servers
  964. (setq cur (car (pop servers)))
  965. (nnmairix-open-server
  966. (nth 1 (gnus-server-to-method cur)))
  967. (setq commandsplit (split-string nnmairix-mairix-command))
  968. (nnheader-message 7 "Updating mairix database for %s..." cur)
  969. (if nnmairix-mairix-synchronous-update
  970. (progn
  971. (setq args (append (list (car commandsplit) nil
  972. (get-buffer nnmairix-mairix-output-buffer)
  973. nil)))
  974. (if (> (length commandsplit) 1)
  975. (setq args (append args (cdr commandsplit) nnmairix-mairix-update-options))
  976. (setq args (append args nnmairix-mairix-update-options)))
  977. (apply 'call-process args)
  978. (nnheader-message 7 "Updating mairix database for %s... done" cur))
  979. (progn
  980. (setq args (append (list cur (get-buffer nnmairix-mairix-output-buffer)
  981. (car commandsplit))))
  982. (if (> (length commandsplit) 1)
  983. (setq args (append args (cdr commandsplit) nnmairix-mairix-update-options))
  984. (setq args (append args nnmairix-mairix-update-options)))
  985. (set-process-sentinel (apply 'start-process args)
  986. 'nnmairix-sentinel-mairix-update-finished))))))
  987. (defun nnmairix-group-delete-recreate-this-group ()
  988. "Deletes and recreates group on the back end.
  989. You can use this function on nnmairix groups which continuously
  990. show wrong article counts."
  991. (interactive)
  992. (let* ((group (gnus-group-group-name))
  993. (method (gnus-find-method-for-group group)))
  994. (unless (eq (car method) 'nnmairix)
  995. (error "This is not a nnmairix group"))
  996. (when (y-or-n-p
  997. (format "Really recreate group %s on the back end? " group))
  998. (nnmairix-delete-recreate-group group)
  999. (gnus-group-get-new-news-this-group))))
  1000. (defun nnmairix-propagate-marks (&optional server)
  1001. "Propagate marks from nnmairix group to original articles.
  1002. Unless SERVER is explicitly specified, will use the last opened
  1003. nnmairix server. Only marks from current session will be set."
  1004. (interactive)
  1005. (if server
  1006. (nnmairix-open-server server)
  1007. (unless (eq (car gnus-current-select-method) 'nnmairix)
  1008. (if nnmairix-current-server
  1009. (nnmairix-open-server nnmairix-current-server)
  1010. (error "No opened nnmairix server"))))
  1011. (if nnmairix-marks-cache
  1012. (let (number ogroup number-cache method mid-marks temp)
  1013. ;; first we get the article numbers
  1014. (catch 'problem
  1015. (while (setq ogroup (pop nnmairix-marks-cache))
  1016. (while (setq mid-marks (pop (cdr ogroup)))
  1017. (setq number
  1018. (cdr
  1019. (gnus-request-head (car mid-marks) (car ogroup))))
  1020. (unless number
  1021. (nnheader-message
  1022. 3 "Unable to set mark: couldn't determine article number for %s in %s"
  1023. (car mid-marks) (car ogroup))
  1024. (throw 'problem nil))
  1025. (setq temp (assoc (car ogroup) number-cache))
  1026. (if temp
  1027. (catch 'done
  1028. (dolist (cur (cdr temp))
  1029. (when (equal (cdr cur) (list (nth 1 mid-marks) (nth 2 mid-marks)))
  1030. (nconc (car cur) (list number))
  1031. (throw 'done nil)))
  1032. (nconc temp (list (list (list number) (nth 1 mid-marks) (nth 2 mid-marks)))))
  1033. (push (list (car ogroup) (list (list number) (nth 1 mid-marks) (nth 2 mid-marks)))
  1034. number-cache)))))
  1035. ;; now we set the marks
  1036. (with-current-buffer gnus-group-buffer
  1037. (nnheader-message 5 "nnmairix: Propagating marks...")
  1038. (dolist (cur number-cache)
  1039. (setq method (gnus-find-method-for-group (car cur)))
  1040. (apply (intern (format "%s-%s"
  1041. (symbol-name (car method))
  1042. "request-set-mark"))
  1043. (gnus-group-short-name (car cur))
  1044. (cdr cur)
  1045. (list (nth 1 method)))
  1046. (gnus-group-jump-to-group (car cur))
  1047. (gnus-group-get-new-news-this-group)))
  1048. (nnheader-message 5 "nnmairix: Propagating marks... done"))
  1049. (nnheader-message 3 "No marks to propagate.")))
  1050. (defun nnmairix-update-groups (servername &optional skipdefault updatedb)
  1051. "Update all search groups on SERVERNAME.
  1052. If SKIPDEFAULT is t, the default search group will not be
  1053. updated.
  1054. If UPDATEDB is t, database for SERVERNAME will be updated first."
  1055. (interactive (list (gnus-completing-read "Update groups on server"
  1056. (nnmairix-get-nnmairix-servers))))
  1057. (save-excursion
  1058. (when (string-match ".*:\\(.*\\)" servername)
  1059. (setq servername (match-string 1 servername)))
  1060. (if (not (assoc (format "nnmairix:%s" servername)
  1061. (nnmairix-get-nnmairix-servers)))
  1062. (nnheader-message 3 "Server %s not opened" servername)
  1063. (when updatedb
  1064. (let ((nnmairix-mairix-synchronous-update t))
  1065. (nnmairix-update-database
  1066. (list (list (format "nnmairix:%s" servername))))))
  1067. (let ((groups (nnmairix-get-groups-from-server servername))
  1068. default)
  1069. (when skipdefault
  1070. (setq default
  1071. (format "nnmairix+%s:%s"
  1072. servername
  1073. (cadr
  1074. (assoc 'nnmairix-default-group
  1075. (gnus-server-to-method
  1076. (format "nnmairix:%s" servername)))))))
  1077. (dolist (cur groups)
  1078. (unless (and skipdefault
  1079. (string= (car cur) default))
  1080. (gnus-group-jump-to-group (car cur))
  1081. (gnus-group-mark-group 1)))
  1082. (gnus-group-get-new-news-this-group)))))
  1083. (defun nnmairix-remove-tick-mark-original-article ()
  1084. "Remove tick mark from original article.
  1085. Marks propagation has to be enabled for this to work."
  1086. (interactive)
  1087. (unless (eq (car gnus-current-select-method) 'nnmairix)
  1088. (error "Not in a nnmairix group"))
  1089. (save-excursion
  1090. (let ((mid (mail-header-message-id (gnus-summary-article-header)))
  1091. groups cur)
  1092. (when mid
  1093. (setq groups (nnmairix-determine-original-group-from-registry mid))
  1094. (unless (or groups
  1095. nnmairix-only-use-registry)
  1096. (setq groups
  1097. (nnmairix-determine-original-group-from-path mid nnmairix-current-server)))
  1098. (unless groups
  1099. (error "Couldn't find original article"))
  1100. (dolist (cur groups)
  1101. (push `(,cur (,mid del (tick))) nnmairix-marks-cache))
  1102. (nnheader-message 5 "Will remove tick mark for %s upon closing." mid)))))
  1103. ;;; ==== Helper functions
  1104. (defun nnmairix-request-group-with-article-number-correction (folder qualgroup)
  1105. "Request FOLDER on back end for nnmairix QUALGROUP and article number correction."
  1106. (save-excursion
  1107. (nnmairix-call-backend "request-group" folder nnmairix-backend-server)
  1108. (set-buffer nnmairix-mairix-output-buffer)
  1109. (goto-char (point-min))
  1110. (re-search-forward "^Matched.*messages")
  1111. (nnheader-message 7 (match-string 0))
  1112. (set-buffer nntp-server-buffer)
  1113. (goto-char (point-min))
  1114. (let ((status (read (current-buffer)))
  1115. (total (read (current-buffer)))
  1116. (low (read (current-buffer)))
  1117. (high (read (current-buffer)))
  1118. (corr (gnus-group-get-parameter qualgroup 'numcorr t)))
  1119. (if (= status 211)
  1120. (progn
  1121. ;; Article number correction
  1122. (if (and corr
  1123. (> (+ (car (cddr corr)) high) 0))
  1124. (progn
  1125. (when (car corr) ;Group has changed
  1126. (setq corr
  1127. (list nil
  1128. (car (cddr corr))
  1129. (+ (car (cddr corr)) high)))
  1130. (gnus-group-set-parameter
  1131. qualgroup 'numcorr corr))
  1132. (setq low (+ low (cadr corr))
  1133. high (+ high (cadr corr))))
  1134. (when (member nnmairix-backend
  1135. nnmairix-delete-and-create-on-change)
  1136. (gnus-group-set-parameter
  1137. qualgroup 'numcorr (list nil 0 high))))
  1138. (erase-buffer)
  1139. (insert (format "%d %d %d %d %s" status total low high
  1140. (gnus-group-real-name qualgroup)))
  1141. t)
  1142. (progn
  1143. (nnheader-report
  1144. 'nnmairix "Error calling back end on group %s" folder)
  1145. nil)))))
  1146. (defun nnmairix-call-mairix-binary (command folder searchquery threads)
  1147. "Call mairix binary with COMMAND, using FOLDER and SEARCHQUERY.
  1148. If THREADS is non-nil, enable full threads."
  1149. (let ((args (cons (car command) '(nil t nil))))
  1150. (with-current-buffer
  1151. (get-buffer-create nnmairix-mairix-output-buffer)
  1152. (erase-buffer)
  1153. (when (> (length command) 1)
  1154. (setq args (append args (cdr command))))
  1155. (when nnmairix-mairix-search-options
  1156. (setq args (append args nnmairix-mairix-search-options)))
  1157. ;; If we have a patched mairix binary, call it with "-c"
  1158. (when (nnmairix-check-mairix-version "maildirpatch")
  1159. (setq args (append args '("-c"))))
  1160. (when threads
  1161. (setq args (append args '("-t"))))
  1162. (apply 'call-process
  1163. (append args (list "-o" folder) searchquery)))))
  1164. (defun nnmairix-call-mairix-binary-raw (command query)
  1165. "Call mairix binary with COMMAND and QUERY in raw mode."
  1166. (let ((args (cons (car command) '(nil t nil))))
  1167. (with-current-buffer
  1168. (get-buffer-create nnmairix-mairix-output-buffer)
  1169. (erase-buffer)
  1170. (when (> (length command) 1)
  1171. (setq args (append args (cdr command))))
  1172. (setq args (append args '("-r")))
  1173. (apply 'call-process
  1174. (append args query)))))
  1175. (defun nnmairix-get-server ()
  1176. "If there exists just one nnmairix server, return its value.
  1177. Otherwise, ask user for server."
  1178. (let ((openedserver (nnmairix-get-nnmairix-servers)))
  1179. (when (not openedserver)
  1180. (error "No opened nnmairix server found"))
  1181. (if (> (length openedserver) 1)
  1182. (progn
  1183. (while
  1184. (equal '("")
  1185. (setq nnmairix-last-server
  1186. (list (gnus-completing-read "Server" openedserver t
  1187. (or nnmairix-last-server
  1188. "nnmairix:"))))))
  1189. nnmairix-last-server)
  1190. (car openedserver))))
  1191. (defun nnmairix-get-nnmairix-servers (&optional all)
  1192. "Return available nnmairix servers.
  1193. If ALL is t, return also the unopened/failed ones."
  1194. (let ((alist gnus-opened-servers)
  1195. server openedserver)
  1196. (while alist
  1197. (setq server (pop alist))
  1198. (when (and server
  1199. (or all
  1200. (eq (cadr server) 'ok))
  1201. (eq (caar server) 'nnmairix)
  1202. (not (member (car server) gnus-ephemeral-servers)))
  1203. (setq server
  1204. (concat (symbol-name (caar server)) ":" (nth 1 (car server))))
  1205. (push (list server) openedserver)))
  1206. openedserver))
  1207. (defun nnmairix-get-valid-servers ()
  1208. "Return list of valid back end servers for nnmairix groups."
  1209. (let ((alist gnus-opened-servers)
  1210. (mairixservers (nnmairix-get-nnmairix-servers t))
  1211. server mserver openedserver occ cur)
  1212. ;; Get list of all nnmairix backends (i.e. backends which are
  1213. ;; already occupied)
  1214. (dolist (cur mairixservers)
  1215. (push
  1216. (concat
  1217. (symbol-name
  1218. (cadr (assoc 'nnmairix-backend
  1219. (gnus-server-to-method (car cur)))))
  1220. ":"
  1221. (cadr (assoc 'nnmairix-backend-server
  1222. (gnus-server-to-method (car cur)))))
  1223. occ))
  1224. (while alist
  1225. (setq server (pop alist))
  1226. (setq mserver (gnus-method-to-server (car server)))
  1227. ;; If this is the native server, convert it to the real server
  1228. ;; name to avoid confusion
  1229. (when (string= mserver "native")
  1230. (setq mserver (format "%s:%s"
  1231. (caar server)
  1232. (nth 1 (car server)))))
  1233. (when (and server
  1234. (eq (cadr server) 'ok)
  1235. (member (caar server) nnmairix-valid-backends)
  1236. (not (member (car server) gnus-ephemeral-servers))
  1237. (not (member (gnus-method-to-server (car server)) occ)))
  1238. (push
  1239. mserver
  1240. openedserver)))
  1241. openedserver))
  1242. (defun nnmairix-get-groups-from-server (servername)
  1243. "Return all groups for nnmairix server SERVERNAME."
  1244. (let ((searchstring (format "nnmairix\\+%s:" servername))
  1245. groups)
  1246. (dolist (cur gnus-newsrc-alist)
  1247. (when (string-match searchstring
  1248. (car cur))
  1249. (push (list (car cur)) groups)))
  1250. groups))
  1251. (defun nnmairix-call-backend (func &rest args)
  1252. "Call a function FUNC on backend with ARGS."
  1253. (apply (intern (format "%s-%s" (symbol-name nnmairix-backend) func)) args))
  1254. (defun nnmairix-get-backend-folder (group &optional server)
  1255. "Return back end GROUP from nnmairix group on SERVER."
  1256. (let* ((qualgroup (if server
  1257. (gnus-group-prefixed-name group (list 'nnmairix server))
  1258. group))
  1259. (folder (gnus-group-get-parameter qualgroup 'folder)))
  1260. folder))
  1261. (defun nnmairix-get-numcorr (group &optional server)
  1262. "Return values for article number correction nnmairix GROUP on SERVER."
  1263. (let* ((qualgroup (if server
  1264. (gnus-group-prefixed-name group (list 'nnmairix server))
  1265. group))
  1266. (corr (gnus-group-get-parameter qualgroup 'numcorr t)))
  1267. corr))
  1268. (defun nnmairix-rename-files-consecutively (path)
  1269. "Rename all nnml mail files in PATH so that they have consecutive numbers.
  1270. This should correct problems of wrong article counts when using
  1271. nnmairix with nnml backends."
  1272. (let* ((files
  1273. (sort
  1274. (mapcar 'string-to-number
  1275. (directory-files path nil "[0-9]+" t))
  1276. '<))
  1277. (lastplusone (car files))
  1278. (path (file-name-as-directory path)))
  1279. (dolist (cur files)
  1280. (when (not (= cur lastplusone))
  1281. (rename-file (concat path
  1282. (number-to-string cur))
  1283. (concat path
  1284. (number-to-string lastplusone)))
  1285. (setq cur lastplusone))
  1286. (setq lastplusone (1+ cur)))))
  1287. (defun nnmairix-replace-group-and-numbers (articles backendgroup mairixgroup numc type)
  1288. "Replace folder names in Xref header and correct article numbers.
  1289. Do this for all ARTICLES on BACKENDGROUP. Replace using
  1290. MAIRIXGROUP. NUMC contains values for article number correction.
  1291. TYPE is either 'nov or 'headers."
  1292. (nnheader-message 7 "nnmairix: Rewriting headers...")
  1293. (cond
  1294. ((eq type 'nov)
  1295. (let ((buf (get-buffer-create " *nnmairix buffer*"))
  1296. (corr (not (zerop numc)))
  1297. (name (buffer-name nntp-server-buffer))
  1298. header cur xref)
  1299. (with-current-buffer buf
  1300. (erase-buffer)
  1301. (set-buffer nntp-server-buffer)
  1302. (goto-char (point-min))
  1303. (mapc
  1304. (lambda (article)
  1305. (when (or (looking-at (number-to-string article))
  1306. (nnheader-find-nov-line article))
  1307. (setq cur (nnheader-parse-nov))
  1308. (when corr
  1309. (setq article (+ (mail-header-number cur) numc))
  1310. (mail-header-set-number cur article))
  1311. (setq xref (mail-header-xref cur))
  1312. (when (and (stringp xref)
  1313. (string-match (format "[ \t]%s:[0-9]+" backendgroup) xref))
  1314. (setq xref (replace-match (format " %s:%d" mairixgroup article) t nil xref))
  1315. (mail-header-set-xref cur xref))
  1316. (set-buffer buf)
  1317. (nnheader-insert-nov cur)
  1318. (set-buffer nntp-server-buffer)
  1319. (when (not (eobp))
  1320. (forward-line 1))))
  1321. articles)
  1322. (kill-buffer nntp-server-buffer)
  1323. (set-buffer buf)
  1324. (rename-buffer name)
  1325. (setq nntp-server-buffer buf))))
  1326. ((and (eq type 'headers)
  1327. (not (zerop numc)))
  1328. (with-current-buffer nntp-server-buffer
  1329. (save-excursion
  1330. (goto-char (point-min))
  1331. (while (re-search-forward "^[23][0-9]+ \\([0-9]+\\)" nil t)
  1332. (replace-match (number-to-string
  1333. (+ (string-to-number (match-string 1)) numc))
  1334. t t nil 1))))))
  1335. (nnheader-message 7 "nnmairix: Rewriting headers... done"))
  1336. (defun nnmairix-backend-to-server (server)
  1337. "Return nnmairix server most probably responsible for back end SERVER.
  1338. User will be asked if this cannot be determined. Result is saved in
  1339. parameter 'indexed-servers of corresponding default search
  1340. group."
  1341. (let ((allservers (nnmairix-get-nnmairix-servers))
  1342. mairixserver found defaultgroup)
  1343. (if (> (length allservers) 1)
  1344. (progn
  1345. ;; If there is more than one nnmairix server, we go through them
  1346. (while (and allservers (not found))
  1347. (setq mairixserver (gnus-server-to-method (car (pop allservers))))
  1348. ;; First we look if SERVER is the backend of current nnmairix server
  1349. (setq found (and (eq (cadr (assoc 'nnmairix-backend mairixserver))
  1350. (car server))
  1351. (string= (cadr (assoc 'nnmairix-backend-server mairixserver))
  1352. (nth 1 server))))
  1353. ;; If that's not the case, we look at 'indexed-servers
  1354. ;; variable in default search group
  1355. (when (not found)
  1356. (setq defaultgroup (cadr (assoc 'nnmairix-default-group mairixserver)))
  1357. (setq found (member (gnus-method-to-server server)
  1358. (gnus-group-get-parameter
  1359. (gnus-group-prefixed-name defaultgroup
  1360. mairixserver)
  1361. 'indexed-servers t)))))
  1362. ;; If still not found, we ask user
  1363. (when (not found)
  1364. (setq mairixserver
  1365. (gnus-server-to-method
  1366. (gnus-completing-read
  1367. (format "Cannot determine which nnmairix server indexes %s. Please specify"
  1368. (gnus-method-to-server server))
  1369. (nnmairix-get-nnmairix-servers) nil "nnmairix:")))
  1370. ;; Save result in parameter of default search group so that
  1371. ;; we don't have to ask again
  1372. (setq defaultgroup (gnus-group-prefixed-name
  1373. (cadr (assoc 'nnmairix-default-group mairixserver)) mairixserver))
  1374. (gnus-group-set-parameter
  1375. defaultgroup
  1376. 'indexed-servers
  1377. (append (gnus-group-get-parameter defaultgroup 'indexed-servers t)
  1378. (list (gnus-method-to-server server)))))
  1379. mairixserver)
  1380. ;; If there is just one (or none) nnmairix server:
  1381. (gnus-server-to-method (caar allservers)))))
  1382. (defun nnmairix-delete-recreate-group (group)
  1383. "Delete and recreate folder from GROUP on the back end."
  1384. (when (member nnmairix-backend nnmairix-delete-and-create-on-change)
  1385. (let ((folder (gnus-group-get-parameter group 'folder)))
  1386. (if (string-match nnmairix-group-regexp folder)
  1387. (progn
  1388. (nnmairix-call-backend "open-server"
  1389. nnmairix-backend-server)
  1390. (nnmairix-call-backend "request-delete-group"
  1391. folder t nnmairix-backend-server)
  1392. (nnmairix-call-backend "request-create-group"
  1393. folder nnmairix-backend-server))
  1394. (error "`nnmairix-delete-recreate-group' called on \
  1395. non-mairix group. Check folder parameter")))))
  1396. (defun nnmairix-update-and-clear-marks (group &optional method)
  1397. "Update group and clear all marks from GROUP using METHOD."
  1398. (let ((method (or method
  1399. (gnus-find-method-for-group group)))
  1400. (corr (gnus-group-get-parameter group 'numcorr t))
  1401. info)
  1402. (unless (or (gnus-group-prefixed-p group)
  1403. (not method))
  1404. (setq group (gnus-group-prefixed-name group method)))
  1405. (if (eq (nth 0 method) 'nnmairix)
  1406. (save-excursion
  1407. (nnmairix-open-server (nth 1 method))
  1408. (set-buffer gnus-group-buffer)
  1409. ;; (gnus-group-set-parameter group 'propmarks nil)
  1410. (setq info (gnus-get-info group))
  1411. ;; Clear active and info
  1412. (gnus-set-active group nil)
  1413. (gnus-info-clear-data info)
  1414. ;; Delete and re-create group if needed
  1415. (nnmairix-delete-recreate-group group)
  1416. ;; set flag that group has changed for article number correction
  1417. (when (member nnmairix-backend nnmairix-delete-and-create-on-change)
  1418. (when corr
  1419. (setcar corr t)
  1420. (gnus-group-set-parameter group 'numcorr corr)))
  1421. (gnus-group-jump-to-group group)
  1422. (gnus-group-get-new-news-this-group))
  1423. (error "`nnmairix-update-and-clear-marks' called with non-nnmairix group"))))
  1424. (defun nnmairix-sentinel-mairix-update-finished (proc status)
  1425. "Sentinel for mairix update process PROC with STATUS."
  1426. (if (equal status "finished\n")
  1427. (nnheader-message 7 "Updating mairix database for %s... done" proc)
  1428. (error "There was an error updating the mairix database for server %s. \
  1429. See %s for details" proc nnmairix-mairix-output-buffer)))
  1430. (defun nnmairix-create-message-line-for-search ()
  1431. "Create message line for interactive query in minibuffer."
  1432. (mapconcat
  1433. (function
  1434. (lambda (cur)
  1435. (format "%c=%s" (car cur) (nth 3 cur))))
  1436. nnmairix-interactive-query-parameters ","))
  1437. (defun nnmairix-replace-illegal-chars (header)
  1438. "Replace illegal characters in HEADER for mairix query."
  1439. (when header
  1440. (while (string-match "[^-.@/,& [:alnum:]]" header)
  1441. (setq header (replace-match "" t t header)))
  1442. (while (string-match "[-& ]" header)
  1443. (setq header (replace-match "," t t header)))
  1444. header))
  1445. (defun nnmairix-group-toggle-parameter (group parameter description &optional par)
  1446. "Toggle on GROUP a certain PARAMETER.
  1447. DESCRIPTION will be shown to the user with the activation
  1448. status. If PAR is a positive number, the group parameter will be
  1449. set to t and to nil otherwise."
  1450. (let* ((method (gnus-find-method-for-group group))
  1451. (par (or par
  1452. (not (gnus-group-get-parameter group parameter)))))
  1453. (if (eq (car method) 'nnmairix)
  1454. (progn
  1455. (when (numberp par)
  1456. (setq par (> par 0)))
  1457. (gnus-group-set-parameter group parameter par)
  1458. (if par
  1459. (message "%s activated for group %s" description group)
  1460. (message "%s deactivated for group %s" description group))
  1461. t)
  1462. (error "This is no nnmairix group")
  1463. nil)))
  1464. ;; Search for original article helper functions
  1465. (defun nnmairix-goto-original-article (&optional no-registry)
  1466. "Jump to the original group and display article.
  1467. The original group of the article is first determined with the
  1468. registry (if enabled). If the registry is not enabled or did not
  1469. find the article or the prefix NO-REGISTRY is non-nil, this
  1470. function will try to determine the original group form the path
  1471. of the mail file. The path is obtained through another mairix
  1472. search in raw mode."
  1473. (interactive "P")
  1474. (when (not (eq (car gnus-current-select-method) 'nnmairix))
  1475. (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
  1476. (if (eq (car method) 'nnmairix)
  1477. (nnmairix-open-server (nth 1 method))
  1478. (error "Not in a nnmairix group"))))
  1479. (when (not (gnus-buffer-live-p gnus-article-buffer))
  1480. (error "No article buffer available"))
  1481. (let ((server (nth 1 gnus-current-select-method))
  1482. mid rval group allgroups)
  1483. ;; get message id
  1484. (with-current-buffer gnus-article-buffer
  1485. (gnus-summary-toggle-header 1)
  1486. (setq mid (message-fetch-field "Message-ID"))
  1487. ;; first check the registry (if available)
  1488. (unless no-registry
  1489. (setq allgroups (nnmairix-determine-original-group-from-registry mid)))
  1490. (unless (or allgroups
  1491. nnmairix-only-use-registry)
  1492. ;; registry was not available or did not find article
  1493. ;; so we search again with mairix in raw mode to get filename
  1494. (setq allgroups
  1495. (nnmairix-determine-original-group-from-path mid server)))
  1496. (if (> (length allgroups) 1)
  1497. (setq group
  1498. (gnus-completing-read
  1499. "Message exists in more than one group. Choose"
  1500. allgroups t))
  1501. (setq group (car allgroups))))
  1502. (if group
  1503. ;; show article in summary buffer
  1504. (nnmairix-show-original-article group mid)
  1505. (nnheader-message 3 "Couldn't find original article"))))
  1506. (defun nnmairix-determine-original-group-from-registry (mid)
  1507. "Try to determine original group for message-id MID from the registry."
  1508. (when (gnus-bound-and-true-p 'gnus-registry-enabled)
  1509. (unless (string-match "^<" mid)
  1510. (set mid (concat "<" mid)))
  1511. (unless (string-match ">$" mid)
  1512. (set mid (concat mid ">")))
  1513. (gnus-registry-get-id-key mid 'group)))
  1514. (defun nnmairix-determine-original-group-from-path (mid server)
  1515. "Determine original group(s) for message-id MID from the file path.
  1516. The file path is obtained through a mairix search for the id on
  1517. SERVER."
  1518. (nnmairix-open-server server)
  1519. (while (string-match "[<>]" mid)
  1520. (setq mid (replace-match "" t t mid)))
  1521. ;; mairix somehow does not like '$' in message-id
  1522. (when (string-match "\\$" mid)
  1523. (setq mid (concat mid "=")))
  1524. (while (string-match "\\$" mid)
  1525. (setq mid (replace-match "=," t t mid)))
  1526. (let (allgroups)
  1527. (if (zerop (nnmairix-call-mairix-binary-raw
  1528. (split-string nnmairix-mairix-command)
  1529. (list (concat "m:" mid))))
  1530. (with-current-buffer nnmairix-mairix-output-buffer
  1531. (goto-char (point-min))
  1532. (while (re-search-forward "^/.*$" nil t)
  1533. (push (nnmairix-get-group-from-file-path (match-string 0))
  1534. allgroups)
  1535. (forward-line 1)))
  1536. (error "Mairix could not find original article. See buffer %s for details"
  1537. nnmairix-mairix-output-buffer))
  1538. allgroups))
  1539. (defun nnmairix-get-group-from-file-path (file)
  1540. "Get group by parsing the message location FILE."
  1541. (let (path filename serverbase group maildirflag allgroups)
  1542. (string-match "^\\(.*\\)/\\(.*?\\)$" file)
  1543. (setq path (expand-file-name (match-string 1 file)))
  1544. (setq filename (match-string 2 file))
  1545. ;; when we deal with maildir, remove cur/new/tmp from path
  1546. (setq maildirflag (string-match ".+\\..+\\..+" filename))
  1547. (when maildirflag
  1548. (setq path
  1549. (replace-regexp-in-string
  1550. ".*\\(/cur\\|/new\\|/tmp\\)$" "" path t t 1)))
  1551. ;; we first check nnml and nnmaildir servers
  1552. (setq
  1553. group
  1554. (catch 'found
  1555. (dolist (cur gnus-opened-servers)
  1556. (when (or (and (not maildirflag)
  1557. (eq (caar cur) 'nnml))
  1558. (and maildirflag
  1559. (eq (caar cur) 'nnmaildir)))
  1560. ;; get base path from server
  1561. (if maildirflag
  1562. (setq serverbase (cadr (assoc 'directory (car cur))))
  1563. (setq serverbase (cadr (assoc 'nnml-directory (car cur))))
  1564. (unless serverbase
  1565. (setq serverbase nnml-directory)))
  1566. (setq serverbase (file-name-as-directory
  1567. (expand-file-name serverbase)))
  1568. (when (string-match (concat serverbase "\\(.*\\)") path)
  1569. ;; looks good - rest of the path should be the group
  1570. (setq group (match-string 1 path))
  1571. (when (string-match "/$" group)
  1572. (setq group (replace-match "" t t group)))
  1573. (unless maildirflag
  1574. ;; for nnml: convert slashes to dots
  1575. (while (string-match "/" group)
  1576. (setq group (replace-match "." t t group))))
  1577. (setq group (gnus-group-prefixed-name group (car cur)))
  1578. ;; check whether this group actually exists
  1579. (when (gnus-group-entry group)
  1580. (throw 'found group)))))))
  1581. (unless group
  1582. ;; we haven't found it yet --> look for nnimap groups. Assume
  1583. ;; last element of the path is the group. This might fail since
  1584. ;; IMAP servers may present groups to the client in arbitrary
  1585. ;; ways...
  1586. (string-match "^.*/\\.?\\(.*\\)$" path)
  1587. (setq group (match-string 1 path))
  1588. ;; convert dots to slashes (nested group)
  1589. (while (string-match "\\." group)
  1590. (setq group (replace-match "/" t t group)))
  1591. (dolist (cur gnus-opened-servers)
  1592. (when (eq (caar cur) 'nnimap)
  1593. (when (gnus-group-entry
  1594. (gnus-group-prefixed-name group (car cur)))
  1595. (push
  1596. (gnus-group-prefixed-name group (car cur))
  1597. allgroups))))
  1598. (if (> (length allgroups) 1)
  1599. (setq group (gnus-completing-read
  1600. "Group %s exists on more than one IMAP server. Choose"
  1601. allgroups t))
  1602. (setq group (car allgroups))))
  1603. group))
  1604. (defun nnmairix-show-original-article (group mid)
  1605. "Switch to GROUP and display Article with message-id MID."
  1606. (unless (string-match "^<" mid)
  1607. (set mid (concat "<" mid)))
  1608. (unless (string-match ">$" mid)
  1609. (set mid (concat mid ">")))
  1610. (when (string-match "Summary" (buffer-name (current-buffer)))
  1611. (gnus-summary-exit))
  1612. (pop-to-buffer gnus-group-buffer)
  1613. (gnus-group-jump-to-group group)
  1614. (gnus-summary-read-group group 1 t)
  1615. (gnus-summary-refer-article mid)
  1616. (gnus-summary-limit-to-headers (format "message-id: %s" mid))
  1617. (gnus-summary-select-article)
  1618. ;; Force redisplay
  1619. (gnus-summary-show-article)
  1620. (nnheader-message 5 "Switched to group %s." group))
  1621. (defun nnmairix-map-range (func range)
  1622. "Map function FUNC on all members of RANGE."
  1623. (cond
  1624. ((numberp range)
  1625. (funcall func range))
  1626. (t
  1627. (mapcar (lambda (cur)
  1628. (cond
  1629. ((listp cur)
  1630. (cons
  1631. (funcall func (car cur))
  1632. (funcall func (cdr cur))))
  1633. ((numberp cur)
  1634. (funcall func cur))))
  1635. range))))
  1636. (defun nnmairix-check-mairix-version (version &optional server)
  1637. "Check mairix VERSION on SERVER.
  1638. If VERSION is a number: specifies the minimum version.
  1639. If VERSION is a string: must be contained in mairix version output."
  1640. (unless server
  1641. (setq server nnmairix-current-server))
  1642. (let ((versionstring (cadr (assoc server nnmairix-version-output))))
  1643. (unless versionstring
  1644. ;; call "mairix -V" to get the version string
  1645. (with-temp-buffer
  1646. (setq versionstring
  1647. (let* ((commandsplit (split-string nnmairix-mairix-command))
  1648. (args (append (list (car commandsplit))
  1649. `(nil t nil) (cdr commandsplit) '("-V"))))
  1650. (apply 'call-process args)
  1651. (goto-char (point-min))
  1652. (re-search-forward "mairix.*")
  1653. (match-string 0))))
  1654. ;; save version string for current session
  1655. (setq nnmairix-version-output
  1656. (append nnmairix-version-output
  1657. (list (list server versionstring)))))
  1658. (cond
  1659. ((stringp version)
  1660. (string-match version versionstring))
  1661. ((numberp version)
  1662. (<= version (string-to-number
  1663. (progn
  1664. (string-match "mairix \\([0-9\\.]+\\)" versionstring)
  1665. (match-string 1 versionstring))))))))
  1666. ;; ==== Widget stuff
  1667. (defvar nnmairix-widgets)
  1668. (defvar nnmairix-widgets-values nil)
  1669. (defun nnmairix-widget-search-from-this-article ()
  1670. "Create mairix query based on current article using graphical widgets."
  1671. (interactive)
  1672. (nnmairix-widget-search
  1673. (nnmairix-widget-get-values)))
  1674. (defun nnmairix-widget-get-values ()
  1675. "Create values for editable fields from current article."
  1676. (if (not (gnus-buffer-live-p gnus-article-buffer))
  1677. (error "No article buffer available")
  1678. (save-excursion
  1679. (gnus-summary-toggle-header 1)
  1680. (set-buffer gnus-article-buffer)
  1681. (mapcar
  1682. (function
  1683. (lambda (field)
  1684. (list (car (cddr field))
  1685. (if (car field)
  1686. (nnmairix-replace-illegal-chars
  1687. (gnus-fetch-field (car field)))
  1688. nil))))
  1689. nnmairix-widget-fields-list))))
  1690. (defun nnmairix-widget-search (&optional mvalues)
  1691. "Create mairix query interactively using graphical widgets.
  1692. MVALUES may contain values from current article."
  1693. (interactive)
  1694. ;; Select window for mairix customization
  1695. (funcall nnmairix-widget-select-window-function)
  1696. ;; generate widgets
  1697. (nnmairix-widget-create-query mvalues)
  1698. ;; generate Buttons
  1699. (widget-create 'push-button
  1700. :notify
  1701. (if mvalues
  1702. (lambda (&rest ignore)
  1703. (nnmairix-widget-send-query nnmairix-widgets
  1704. t))
  1705. (lambda (&rest ignore)
  1706. (nnmairix-widget-send-query nnmairix-widgets
  1707. nil)))
  1708. "Send Query")
  1709. (widget-insert " ")
  1710. (widget-create 'push-button
  1711. :notify
  1712. (if mvalues
  1713. (lambda (&rest ignore)
  1714. (nnmairix-widget-create-group nnmairix-widgets
  1715. t))
  1716. (lambda (&rest ignore)
  1717. (nnmairix-widget-create-group nnmairix-widgets
  1718. nil)))
  1719. "Create permanent group")
  1720. (widget-insert " ")
  1721. (widget-create 'push-button
  1722. :notify (lambda (&rest ignore)
  1723. (kill-buffer nnmairix-customize-query-buffer))
  1724. "Cancel")
  1725. (use-local-map widget-keymap)
  1726. (widget-setup)
  1727. (goto-char (point-min)))
  1728. (defun nnmairix-widget-send-query (widgets &optional withvalues)
  1729. "Send query from WIDGETS to mairix binary.
  1730. If WITHVALUES is t, query is based on current article."
  1731. (nnmairix-search
  1732. (nnmairix-widget-make-query-from-widgets widgets)
  1733. (if withvalues
  1734. (gnus-method-to-server
  1735. (nnmairix-backend-to-server gnus-current-select-method))
  1736. (car (nnmairix-get-server)))
  1737. (if (widget-value (cadr (assoc "Threads" widgets)))
  1738. t
  1739. -1))
  1740. (kill-buffer nnmairix-customize-query-buffer))
  1741. (defun nnmairix-widget-create-group (widgets &optional withvalues)
  1742. "Create nnmairix group based on current widget values WIDGETS.
  1743. If WITHVALUES is t, query is based on current article."
  1744. (let ((group (read-string "Name of the group: ")))
  1745. (when (not (zerop (length group)))
  1746. (nnmairix-create-search-group
  1747. (if withvalues
  1748. (gnus-method-to-server
  1749. (nnmairix-backend-to-server gnus-current-select-method))
  1750. (car (nnmairix-get-server)))
  1751. group
  1752. (nnmairix-widget-make-query-from-widgets widgets)
  1753. (widget-value (cadr (assoc "Threads" widgets))))))
  1754. (kill-buffer nnmairix-customize-query-buffer))
  1755. (defun nnmairix-widget-make-query-from-widgets (widgets)
  1756. "Create mairix query from widget values WIDGETS."
  1757. (let (query temp flag)
  1758. ;; first we do the editable fields
  1759. (dolist (cur nnmairix-widget-fields-list)
  1760. ;; See if checkbox is checked
  1761. (when (widget-value
  1762. (cadr (assoc (concat "c" (car (cddr cur))) widgets)))
  1763. ;; create query for the field
  1764. (push
  1765. (concat
  1766. (nth 1 cur)
  1767. ":"
  1768. (nnmairix-replace-illegal-chars
  1769. (widget-value
  1770. (cadr (assoc (concat "e" (car (cddr cur))) widgets)))))
  1771. query)))
  1772. ;; Flags
  1773. (when (member 'flags nnmairix-widget-other)
  1774. (setq flag
  1775. (mapconcat
  1776. (function
  1777. (lambda (flag)
  1778. (setq temp
  1779. (widget-value (cadr (assoc (car flag) nnmairix-widgets))))
  1780. (if (string= "yes" temp)
  1781. (cadr flag)
  1782. (if (string= "no" temp)
  1783. (concat "-" (cadr flag))))))
  1784. '(("seen" "s") ("replied" "r") ("flagged" "f")) ""))
  1785. (when (not (zerop (length flag)))
  1786. (push (concat "F:" flag) query)))
  1787. ;; return query string
  1788. (mapconcat 'identity query " ")))
  1789. (defun nnmairix-widget-create-query (&optional values)
  1790. "Create widgets for creating mairix queries.
  1791. Fill in VALUES if based on an article."
  1792. (let (allwidgets)
  1793. (when (get-buffer nnmairix-customize-query-buffer)
  1794. (kill-buffer nnmairix-customize-query-buffer))
  1795. (switch-to-buffer nnmairix-customize-query-buffer)
  1796. (kill-all-local-variables)
  1797. (erase-buffer)
  1798. (widget-insert "Specify your query for Mairix (check boxes for activating fields):\n\n")
  1799. (widget-insert "(Whitespaces will be converted to ',' (i.e. AND). Use '/' for OR.)\n\n")
  1800. ; (make-local-variable 'nnmairix-widgets)
  1801. (setq nnmairix-widgets (nnmairix-widget-build-editable-fields values))
  1802. (when (member 'flags nnmairix-widget-other)
  1803. (widget-insert "\nFlags:\n Seen: ")
  1804. (nnmairix-widget-add "seen"
  1805. 'menu-choice
  1806. :value "ignore"
  1807. '(item "yes") '(item "no") '(item "ignore"))
  1808. (widget-insert " Replied: ")
  1809. (nnmairix-widget-add "replied"
  1810. 'menu-choice
  1811. :value "ignore"
  1812. '(item "yes") '(item "no") '(item "ignore"))
  1813. (widget-insert " Ticked: ")
  1814. (nnmairix-widget-add "flagged"
  1815. 'menu-choice
  1816. :value "ignore"
  1817. '(item "yes") '(item "no") '(item "ignore")))
  1818. (when (member 'threads nnmairix-widget-other)
  1819. (widget-insert "\n")
  1820. (nnmairix-widget-add "Threads" 'checkbox nil))
  1821. (widget-insert " Show full threads\n\n")))
  1822. (defun nnmairix-widget-build-editable-fields (values)
  1823. "Build editable field widgets in `nnmairix-widget-fields-list'.
  1824. VALUES may contain values for editable fields from current article."
  1825. ;; how can this be done less ugly?
  1826. (let ((ret))
  1827. (mapc
  1828. (function
  1829. (lambda (field)
  1830. (setq field (car (cddr field)))
  1831. (setq ret
  1832. (nconc
  1833. (list
  1834. (list
  1835. (concat "c" field)
  1836. (widget-create 'checkbox
  1837. :tag field
  1838. :notify (lambda (widget &rest ignore)
  1839. (nnmairix-widget-toggle-activate widget))
  1840. nil)))
  1841. (list
  1842. (list
  1843. (concat "e" field)
  1844. (widget-create 'editable-field
  1845. :size 60
  1846. :format (concat " " field ":"
  1847. (make-string (- 11 (length field)) ?\ )
  1848. "%v")
  1849. :value (or (cadr (assoc field values)) ""))))
  1850. ret))
  1851. (widget-insert "\n")
  1852. ;; Deactivate editable field
  1853. (widget-apply (cadr (nth 1 ret)) :deactivate)))
  1854. nnmairix-widget-fields-list)
  1855. ret))
  1856. (defun nnmairix-widget-add (name &rest args)
  1857. "Add a widget NAME with optional ARGS."
  1858. (push
  1859. (list name
  1860. (apply 'widget-create args))
  1861. nnmairix-widgets))
  1862. (defun nnmairix-widget-toggle-activate (widget)
  1863. "Toggle activation status of WIDGET depending on corresponding checkbox value."
  1864. (let ((field (widget-get widget :tag)))
  1865. (if (widget-value widget)
  1866. (widget-apply
  1867. (cadr (assoc (concat "e" field) nnmairix-widgets))
  1868. :activate)
  1869. (widget-apply
  1870. (cadr (assoc (concat "e" field) nnmairix-widgets))
  1871. :deactivate)))
  1872. (widget-setup))
  1873. (provide 'nnmairix)
  1874. ;;; nnmairix.el ends here