X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnmairix.el;h=26d95b21eb3ce891602ccb91f491a015bea7c77c;hb=74a489ff1213794152d6e13f7a11e16c89f62602;hp=10a9660a2eaf12b8de3cb3f0ce98b85c853e5fa9;hpb=f813104ce6b79054bf355afce4b7929e79d49f6d;p=gnus diff --git a/lisp/nnmairix.el b/lisp/nnmairix.el index 10a9660a2..26d95b21e 100644 --- a/lisp/nnmairix.el +++ b/lisp/nnmairix.el @@ -1,6 +1,6 @@ ;;; nnmairix.el --- Mairix back end for Gnus, the Emacs newsreader -;; Copyright (C) 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: David Engster ;; Keywords: mail searching @@ -23,9 +23,6 @@ ;;; Commentary: -;; THIS IS BETA SOFTWARE! This back end should not mess up or -;; even delete your mails, but having a backup is always a good idea. - ;; This is a back end for using the mairix search engine with ;; Gnus. Mairix is a tool for searching words in locally stored ;; mail. Mairix is very fast which allows using it efficiently for @@ -35,32 +32,6 @@ ;; ;; Mairix is written by Richard Curnow. More information can be found at ;; http://www.rpcurnow.force9.co.uk/mairix/ -;; -;; For details about setting up mairix&Gnus&nnmairix.el, look at the -;; emacswiki: -;; -;; http://www.emacswiki.org/cgi-bin/wiki/GnusMairix -;; -;; The newest version of nnmairix.el can be found at -;; -;; http://www.emacswiki.org/cgi-bin/emacs/nnmairix.el - -;; For impatient people, here's the setup in a nutshell: -;; -;; This back end requires an installed mairix binary which is -;; configured to index your mail folder. You don't have to specify a -;; search folder (but it does no harm, either). Visit the man page of -;; mairix and mairixrc for details. -;; -;; Put nnmairix.el into your search path and "(require 'nnmarix)" into -;; your .gnus. Then call nnmairix-create-default-group (or 'G b -;; c'). This function will ask for all necessary information to create -;; a mairix server in Gnus with the default search folder. This -;; default search folder will be used for all temporary searches: call -;; nnmairix-search ('G b s') and enter a mairix query (like -;; f:test@example.com). To create a mairix group for one specific -;; search query, use 'G b g'. See the emacswiki or the source for more -;; information. ;; Commentary on the code: nnmairix sits between Gnus and the "real" ;; back end which handles the mail (currently nnml, nnimap and @@ -163,6 +134,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) ;For (pop (cdr ogroup)). + (require 'nnoo) (require 'gnus-group) (require 'gnus-sum) @@ -230,6 +203,14 @@ (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook) (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook) +;; ;;;###autoload +;; (defun nnmairix-initalize (&optional force) +;; (interactive "P") +;; (if (not (or (file-readable-p "~/.mairixrc") +;; force)) +;; (message "No file `~/.mairixrc', skipping nnmairix setup") +;; (add-hook 'gnus-group-mode-hook 'nnmairix-group-mode-hook) +;; (add-hook 'gnus-summary-mode-hook 'nnmairix-summary-mode-hook))) ;; Customizable stuff @@ -443,7 +424,7 @@ Other back ends might or might not work.") (setq nnmairix-current-server server) (nnoo-change-server 'nnmairix server definitions)) -(deffoo nnmairix-request-group (group &optional server fast) +(deffoo nnmairix-request-group (group &optional server fast info) ;; Call mairix and request group on back end server (when server (nnmairix-open-server server)) (let* ((qualgroup (if server @@ -464,8 +445,7 @@ Other back ends might or might not work.") nil) ((not query) ;; No query -> return empty group - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (erase-buffer) (insert (concat "211 0 1 0 " group)) t)) @@ -512,7 +492,7 @@ Other back ends might or might not work.") (when (eq nnmairix-backend 'nnml) (when nnmairix-rename-files-for-nnml (nnmairix-rename-files-consecutively mfolder)) - (nnml-generate-nov-databases-directory mfolder)) + (nnml-generate-nov-databases-directory mfolder nil t)) (nnmairix-call-backend "request-scan" folder nnmairix-backend-server) (if (and fast allowfast) @@ -520,9 +500,9 @@ Other back ends might or might not work.") (nnmairix-request-group-with-article-number-correction folder qualgroup))) ((and (= rval 1) - (save-excursion (set-buffer nnmairix-mairix-output-buffer) - (goto-char (point-min)) - (looking-at "^Matched 0 messages"))) + (with-current-buffer nnmairix-mairix-output-buffer + (goto-char (point-min)) + (looking-at "^Matched 0 messages"))) ;; No messages found -> return empty group (nnheader-message 5 "Mairix: No matches found.") (set-buffer nntp-server-buffer) @@ -575,8 +555,13 @@ Other back ends might or might not work.") (mapcar (lambda (arg) (- arg numcorr)) articles))) - (setq rval (nnmairix-call-backend - "retrieve-headers" articles folder nnmairix-backend-server fetch-old)) + (setq rval + (if (eq nnmairix-backend 'nnimap) + (let ((gnus-nov-is-evil t)) + (nnmairix-call-backend + "retrieve-headers" articles folder nnmairix-backend-server fetch-old)) + (nnmairix-call-backend + "retrieve-headers" articles folder nnmairix-backend-server fetch-old))) (when (eq rval 'nov) (nnmairix-replace-group-and-numbers articles folder group numcorr) rval))) @@ -598,8 +583,7 @@ Other back ends might or might not work.") (when server (nnmairix-open-server server)) (if (nnmairix-call-backend "request-list" nnmairix-backend-server) (let (cpoint cur qualgroup folder) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (goto-char (point-min)) (setq cpoint (point)) (while (re-search-forward nnmairix-group-regexp (point-max) t) @@ -619,6 +603,12 @@ Other back ends might or might not work.") t) nil)) +;; Silence byte-compiler. +(defvar gnus-registry-install) +(autoload 'gnus-registry-fetch-group "gnus-registry") +(autoload 'gnus-registry-fetch-groups "gnus-registry") +(autoload 'gnus-registry-add-group "gnus-registry") + (deffoo nnmairix-request-set-mark (group actions &optional server) (when server (nnmairix-open-server server)) @@ -707,13 +697,14 @@ Other back ends might or might not work.") (when (or (eq nnmairix-propagate-marks-upon-close t) (and (eq nnmairix-propagate-marks-upon-close 'ask) (y-or-n-p "Propagate marks to original articles? "))) - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (nnmairix-propagate-marks) ;; update mairix group (gnus-group-jump-to-group qualgroup) (gnus-group-get-new-news-this-group)))))) +(autoload 'nnimap-request-update-info-internal "nnimap") + (deffoo nnmairix-request-update-info (group info &optional server) ;; propagate info from underlying IMAP folder to nnmairix group ;; This is currently experimental and must be explicitly activated @@ -859,7 +850,7 @@ All necessary information will be queried from the user." (interactive) (let* ((name (read-string "Name of the mairix server: ")) (server (completing-read "Back end server (TAB for completion): " - (nnmairix-get-valid-servers))) + (nnmairix-get-valid-servers) nil 1)) (mairix (read-string "Command to call mairix: " "mairix")) (defaultgroup (read-string "Default search group: ")) (backend (symbol-name (car (gnus-server-to-method server)))) @@ -1004,8 +995,7 @@ with m:msgid of the current article and enabled threads." (if server (if (gnus-buffer-live-p gnus-article-buffer) (progn - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-summary-toggle-header 1) (setq mid (message-fetch-field "Message-ID"))) (while (string-match "[<>]" mid) @@ -1027,8 +1017,7 @@ f:current_from." (if server (if (gnus-buffer-live-p gnus-article-buffer) (progn - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-summary-toggle-header 1) (setq from (cadr (gnus-extract-address-components (gnus-fetch-field "From")))) @@ -1052,8 +1041,7 @@ before deleting a group on the back end. SERVER specifies nnmairix server." (when (nnmairix-call-backend "request-list" nnmairix-backend-server) (let (cur qualgroup folder) - (save-excursion - (set-buffer nntp-server-buffer) + (with-current-buffer nntp-server-buffer (goto-char (point-min)) (while (re-search-forward nnmairix-group-regexp (point-max) t) (setq cur (match-string 0) @@ -1108,13 +1096,9 @@ with `nnmairix-mairix-update-options'." (set-process-sentinel (apply 'start-process args) 'nnmairix-sentinel-mairix-update-finished)))))) -;; Silence byte-compiler. -(defvar gnus-registry-install) -(autoload 'gnus-registry-fetch-group "gnus-registry") - (defun nnmairix-group-delete-recreate-this-group () "Deletes and recreates group on the back end. -You can use this function on nnmairix groups which continously +You can use this function on nnmairix groups which continuously show wrong article counts." (interactive) (let* ((group (gnus-group-group-name)) @@ -1162,8 +1146,7 @@ nnmairix server. Only marks from current session will be set." (push (list (car ogroup) (list (list number) (nth 1 mid-marks) (nth 2 mid-marks))) number-cache))))) ;; now we set the marks - (save-excursion - (set-buffer gnus-group-buffer) + (with-current-buffer gnus-group-buffer (nnheader-message 5 "nnmairix: Propagating marks...") (dolist (cur number-cache) (setq method (gnus-find-method-for-group (car cur))) @@ -1209,7 +1192,8 @@ If UPDATEDB is t, database for SERVERNAME will be updated first." (unless (and skipdefault (string= (car cur) default)) (gnus-group-jump-to-group (car cur)) - (gnus-group-get-new-news-this-group))))))) + (gnus-group-mark-group 1))) + (gnus-group-get-new-news-this-group))))) (defun nnmairix-remove-tick-mark-original-article () "Remove tick mark from original article. @@ -1281,9 +1265,8 @@ Marks propagation has to be enabled for this to work." "Call mairix binary with COMMAND, using FOLDER and SEARCHQUERY. If THREADS is non-nil, enable full threads." (let ((args (cons (car command) '(nil t nil)))) - (save-excursion - (set-buffer - (get-buffer-create nnmairix-mairix-output-buffer)) + (with-current-buffer + (get-buffer-create nnmairix-mairix-output-buffer) (erase-buffer) (when (> (length command) 1) (setq args (append args (cdr command)))) @@ -1300,9 +1283,8 @@ If THREADS is non-nil, enable full threads." (defun nnmairix-call-mairix-binary-raw (command query) "Call mairix binary with COMMAND and QUERY in raw mode." (let ((args (cons (car command) '(nil t nil)))) - (save-excursion - (set-buffer - (get-buffer-create nnmairix-mairix-output-buffer)) + (with-current-buffer + (get-buffer-create nnmairix-mairix-output-buffer) (erase-buffer) (when (> (length command) 1) (setq args (append args (cdr command)))) @@ -1439,8 +1421,7 @@ MAIRIXGROUP. NUMC contains values for article number correction." (corr (not (zerop numc))) (name (buffer-name nntp-server-buffer)) header cur xref) - (save-excursion - (set-buffer buf) + (with-current-buffer buf (erase-buffer) (set-buffer nntp-server-buffer) (goto-char (point-min)) @@ -1530,8 +1511,8 @@ group." folder t nnmairix-backend-server) (nnmairix-call-backend "request-create-group" folder nnmairix-backend-server)) - (error "Nnmairix-delete-recreate with\ - non-mairix group!! - check folder parameter"))))) + (error "`nnmairix-delete-recreate-group' called on \ +non-mairix group. Check folder parameter"))))) (defun nnmairix-update-and-clear-marks (group &optional method) "Update group and clear all marks from GROUP using METHOD." @@ -1546,7 +1527,7 @@ group." (save-excursion (nnmairix-open-server (nth 1 method)) (set-buffer gnus-group-buffer) -;; (gnus-group-set-parameter group 'propmarks nil) + ;; (gnus-group-set-parameter group 'propmarks nil) (setq info (gnus-get-info group)) ;; Clear active and info (gnus-set-active group nil) @@ -1560,7 +1541,7 @@ group." (gnus-group-set-parameter group 'numcorr corr))) (gnus-group-jump-to-group group) (gnus-group-get-new-news-this-group)) - (error "Nnmairix-update-and-clear-marks - Called with non-nnmairix group")))) + (error "`nnmairix-update-and-clear-marks' called with non-nnmairix group")))) (defun nnmairix-sentinel-mairix-update-finished (proc status) "Sentinel for mairix update process PROC with STATUS." @@ -1594,9 +1575,9 @@ See %s for details" proc nnmairix-mairix-output-buffer))) DESCRIPTION will be shown to the user with the activation status. If PAR is a positive number, the group parameter will be set to t and to nil otherwise." - (let* ((method (gnus-find-method-for-group group)) - (par (or par - (not (gnus-group-get-parameter group parameter))))) + (let* ((method (gnus-find-method-for-group group)) + (par (or par + (not (gnus-group-get-parameter group parameter))))) (if (eq (car method) 'nnmairix) (progn (when (numberp par) @@ -1609,7 +1590,6 @@ set to t and to nil otherwise." (error "This is no nnmairix group") nil))) - ;; Search for original article helper functions (defun nnmairix-goto-original-article (&optional no-registry) @@ -1631,8 +1611,7 @@ search in raw mode." (let ((server (nth 1 gnus-current-select-method)) mid rval group allgroups) ;; get message id - (save-excursion - (set-buffer gnus-article-buffer) + (with-current-buffer gnus-article-buffer (gnus-summary-toggle-header 1) (setq mid (message-fetch-field "Message-ID")) ;; first check the registry (if available) @@ -1679,12 +1658,16 @@ SERVER." (nnmairix-open-server server) (while (string-match "[<>]" mid) (setq mid (replace-match "" t t mid))) + ;; mairix somehow does not like '$' in message-id + (when (string-match "\\$" mid) + (setq mid (concat mid "="))) + (while (string-match "\\$" mid) + (setq mid (replace-match "=," t t mid))) (let (allgroups) (if (zerop (nnmairix-call-mairix-binary-raw (split-string nnmairix-mairix-command) (list (concat "m:" mid)))) - (save-excursion - (set-buffer nnmairix-mairix-output-buffer) + (with-current-buffer nnmairix-mairix-output-buffer (goto-char (point-min)) (while (re-search-forward "^/.*$" nil t) (push (nnmairix-get-group-from-file-path (match-string 0)) @@ -1759,6 +1742,7 @@ SERVER." allgroups nil t)) (setq group (car allgroups)))) group)) + (defun nnmairix-show-original-article (group mid) "Switch to GROUP and display Article with message-id MID." (unless (string-match "^<" mid) @@ -1824,8 +1808,6 @@ If VERSION is a string: must be contained in mairix version output." (string-match "mairix \\([0-9\\.]+\\)" versionstring) (match-string 1 versionstring)))))))) - - ;; ==== Widget stuff (defvar nnmairix-widgets) @@ -1994,7 +1976,6 @@ Fill in VALUES if based on an article." (nnmairix-widget-add "Threads" 'checkbox nil)) (widget-insert " Show full threads\n\n"))) - (defun nnmairix-widget-build-editable-fields (values) "Build editable field widgets in `nnmairix-widget-fields-list'. VALUES may contain values for editable fields from current article." @@ -2051,5 +2032,4 @@ VALUES may contain values for editable fields from current article." (provide 'nnmairix) -;; arch-tag: bb187498-b229-4a55-8c07-6d3f80713e94 ;;; nnmairix.el ends here